/* Copyright (c) 1997-2010
   Ewgenij Gawrilow, Michael Joswig (Technische Universitaet Darmstadt, Germany)
   http://www.polymake.de

   This program is free software; you can redistribute it and/or modify it
   under the terms of the GNU General Public License as published by the
   Free Software Foundation; either version 2, or (at your option) any
   later version: http://www.gnu.org/licenses/gpl.txt.

   This program is distributed in the hope that it will be useful,
   but WITHOUT ANY WARRANTY; without even the implied warranty of
   MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
   GNU General Public License for more details.
--------------------------------------------------------------------------------
   $Project: polymake $$Id: lattice_normalization.cc 10062 2011-03-16 14:48:01Z benmuell $
*/

#include "polymake/client.h"
#include "polymake/Integer.h"
#include "polymake/Rational.h"
#include "polymake/SparseMatrix.h"
#include "polymake/SparseVector.h"
#include "polymake/Matrix.h"
#include "polymake/Vector.h"
#include "polymake/Smith_normal_form.h"
#include "polymake/linalg.h"
#include "polymake/polytope/lattice_tools.h"

namespace polymake { namespace polytope {
namespace {

perl::Object apply_lattice_normalization(perl::Object p, bool ambient, bool store_transform)
{
  if (!p.give("LATTICE") || !p.give("BOUNDED"))     // only for lattice polytopes
    throw std::runtime_error("not a lattice polytope");
        
  const Matrix<Integer> V=p.give("VERTICES");
        
  SparseMatrix<Integer> M(V), L, R;
  std::list< std::pair<Integer,int> > torsion;
  int r = Smith_normal_form(M, torsion, L, R, pm::True());
        
  for (int i = 0; i < r; ++i) { // adjust orientation of the transformation
    if (M(i,i) < 0) {           // all entries of M >= 0
      M(i,i) *= -1;
      L.col(i) *= -1;
    }
  }
  if (det(R) < 0) {             // det(R) > 0
    L.col(r-1) *= -1;
    R.row(r-1) *= -1;
  }
        
  perl::Object q("LatticePolytope");
  Matrix<Rational> F;
  if (ambient) {
    q.set_description() << "transformation of " 
                        << p.name() 
                        << " in the lattice spanned by Z^n intersected with the affine hull of " 
                        << p.name()
                        << " to a full dimensional polytope in the lattice Z^n" << endl;
    q.take("VERTICES") <<  (L * M).minor(All,range(0,r-1));
    if (p.lookup("FACETS") >> F) {
      q.take("FACETS") << divide_by_gcd((divide_by_gcd(multiply_by_common_denominator(F)) * T(R)).minor(All,range(0,r-1)));
    }
    if ( store_transform ) {
      Matrix<Integer> RLP;
      if (q.get_attachment("REVERSE_LATTICE_PROJECTION") >> RLP)
        RLP =  R.minor(range(0,r-1),All) * RLP;
      else
        RLP =  R.minor(range(0,r-1),All);
      q.attach("REVERSE_LATTICE_PROJECTION") << RLP;
    }
  } else {
    q.set_description() << "transformation of " 
                        << p.name() 
                        << " in the lattice spanned by the vertices of " 
                        << p.name() 
                        << " to a full dimensional polytope in the lattice Z^n" << endl;
    q.take("VERTICES") <<  L.minor(All,range(0,r-1));
    if (p.lookup("FACETS") >> F) {
      q.take("FACETS") << divide_by_gcd((divide_by_gcd(multiply_by_common_denominator(F)) * T(R) * T(M)).minor(All,range(0,r-1)));
    }
    if ( store_transform ) {
      Matrix<Integer> RLP;
      if (q.get_attachment("REVERSE_LATTICE_PROJECTION") >> RLP)
        RLP =  (M * R).minor(range(0,r-1),All) * RLP;
      else
        RLP =  (M * R).minor(range(0,r-1),All);
      q.attach("REVERSE_LATTICE_PROJECTION") << RLP;
    }
  }
        
  Array<std::string> labels;
  if (p.lookup("VERTEX_LABELS") >> labels) q.take("VERTEX_LABELS") << labels;
  if (p.lookup("FACET_LABELS")  >> labels) q.take("FACET_LABELS")  << labels;
  return q;
}
}
    
perl::Object ambient_lattice_normalization(perl::Object p , perl::OptionSet options)
{
  const bool store_transform=options["store_transform"];
  return apply_lattice_normalization(p, true, store_transform);
}
    
perl::Object vertex_lattice_normalization(perl::Object p, perl::OptionSet options)
{
  const bool store_transform=options["store_transform"];
  return apply_lattice_normalization(p, false, store_transform);
}
    
Matrix<Integer> induced_lattice_basis(perl::Object p)
{
  if (!p.give("LATTICE") || !p.give("BOUNDED"))     // only for lattice polytopes
    throw std::runtime_error("not a lattice polytope");
      
  const Matrix<Integer> V=p.give("VERTICES");
  SparseMatrix<Integer> M(V), L, R;
  std::list< std::pair<Integer,int> > torsion;
  int r = Smith_normal_form(M, torsion, L, R, pm::True());
      
  return (M * R).minor(range(1,r-1),All);
}

UserFunction4perl("# @category Transforming a lattice polyhedron"
                  "# Transform to a full-dimensional polytope while preserving"
                  "# the ambient lattice Z^n"
                  "# @param Polytope p the input polytope,"
                  "# @option Bool store_transform store the reverse transformation as an attachement"
                  "# @return Polytope - the transformed polytope defined by its vertices."
                  "#  Facets are only written if available in //p//.",
                  &ambient_lattice_normalization, "ambient_lattice_normalization(Polytope<Rational> {store_transform => 0})");

UserFunction4perl("# @category Transforming a lattice polyhedron"
                  "# Transform to a full-dimensional polytope while preserving"
                  "# the lattice spanned by vertices"
                  "# induced lattice of new vertices = Z^dim"
                  "# @param Polytope p the input polytope,"
                  "# @option Bool store_transform store the reverse transformation as an attachement"
                  "# @return Polytope - the transformed polytope defined by its vertices."
                  "#  Facets are only written if available in //p//.",
                  &vertex_lattice_normalization, "vertex_lattice_normalization(Polytope<Rational> {store_transform => 0})");

UserFunction4perl("# @category Other"
                  "# Returns a basis of the affine lattice spanned by the vertices"
                  "# @param Polytope p the input polytope"
                  "# @return Matrix<Integer> - the lattice basis.",
                  &induced_lattice_basis, "induced_lattice_basis(Polytope<Rational>)");

UserFunctionTemplate4perl("# @category Other"
                          "# scales each row of the matrix to a primitive integral vector"
                          "# @param Matrix M"
                          "# @return Matrix<Integer>.",
                          "primitive(Matrix)");

UserFunctionTemplate4perl("# @category Other"
                          "# scales the affine part of each row of the matrix to a primitive integral vector"
                          "# @param Matrix M"
                          "# @return Matrix<Integer>.",
                          "primitive_affine(Matrix)");

UserFunctionTemplate4perl("# @category Other"
                          "# scales the vector to a primitive inegral vector"
                          "# @param Vector v"
                          "# "
                          "# @return Vector<Integer>",
                          "primitive(Vector)");

UserFunctionTemplate4perl("# @category Other"
                          "# scales the affine part of a vector to a primitive inegral vector"
                          "# @param Vector v"
                          "# @return Vector<Integer>",
                          "primitive_affine(Vector)");


} }

// Local Variables:
// mode:C++
// c-basic-offset:2
// indent-tabs-mode:nil
// End:
