4ti2Interface.gi

#############################################################################
##
##                                                      4ti2Interface package
##
##  Copyright 2013-2017,                 Sebastian Gutsche, Siegen University
##
##  Reading the declaration part of the 4ti2Interface package.
##
#############################################################################

##
InstallGlobalFunction( 4ti2Interface_Cut_Vector,
                       
  function ( vec, l )
    local  d, new, i;
    
    if Length( vec ) = 0  then
        
        return [  ];
        
    fi;
    
    d := Length( vec ) / l;
    
    new := [  ];
    
    for i  in [ 1 .. l ]  do
        
        Add( new, vec{[ d * (i - 1) + 1 .. d * i ]} );
        
    od;
    
    return new;
    
end );

##
InstallGlobalFunction( 4ti2Interface_Read_Matrix_From_File,
                       
  function( filename )
    local filestream, matrix, string, nr_rows, nr_cols;
    
    if not IsExistingFile( filename ) then
        
        return [ ];
        
    fi;
    
    filestream := IO_File( filename, "r" );
    
    matrix := [ ];
    
    string := IO_ReadLine( filestream );
    
    while string <> "" do
        
        NormalizeWhitespace( string );
        
        string := SplitString( string, " ", " \n" );
        
        string := List( string, Int );
        
        matrix := Concatenation( matrix, string );
        
        string := IO_ReadLine( filestream );
        
    od;
    
    IO_Close( filestream );
    
    nr_rows := Remove( matrix, 1 );
    
    nr_cols := Remove( matrix, 1 );
    
    if not Length( matrix ) = nr_cols * nr_rows then
        
        Error( "wrong input matrix dimension" );
        
        return [ fail, [ nr_rows, nr_cols ], matrix ];
        
    fi;
    
    matrix := 4ti2Interface_Cut_Vector( matrix, nr_rows );
    
    return matrix;
    
end );

##
InstallGlobalFunction( 4ti2Interface_Write_Matrix_To_File,
                       
  function( matrix, string )
    local filestream, i, j;
    
    filestream := IO_File( string, "w" );
    
    i := Length( matrix );
    
    if i = 0 then
        
        return matrix;
        
    fi;
    
    j := Length( matrix[ 1 ] );
    
    if j = 0 then
        
        return matrix;
        
    fi;
    
    if not ForAll( matrix, k -> Length( k ) = j ) then
        
        Error( "Input is not a matrix" );
        
        return fail;
        
    fi;
    
    IO_Write( filestream, Concatenation( String( i ), " ", String( j ), "\n"  ) );
    
    for i in matrix do
        
        for j in i do
            
            IO_Write( filestream, Concatenation( String( j ), " " ) );
            
        od;
        
        IO_Write( filestream, "\n" );
        
    od;
    
    IO_Flush( filestream );
    
    IO_Close( filestream );
    
end );

##
InstallGlobalFunction( 4ti2Interface_groebner_matrix,
                       
  function( arg )
    local matrix, dir, filename, exec, filestream;
    
    if Length( arg ) < 1 then
        
        Error( "too few arguments" );
        
    fi;
    
    matrix := arg[ 1 ];
    
    dir := DirectoryTemporary();
    
    filename := Filename( dir, "gap_4ti2_temp_matrix" );
    
    ## 4ti2 works with right kernel.
    4ti2Interface_Write_Matrix_To_File( TransposedMat( matrix ), Concatenation( filename, ".mat" ) );
    
    if Length( arg ) > 1 then
        
        if not IsMatrix( arg[ 2 ] ) then
            arg[ 2 ] := [ arg[ 2 ] ];
        fi;
        
        4ti2Interface_Write_Matrix_To_File( arg[ 2 ], Concatenation( filename, ".cost" ) );
        
    fi;
    
    exec := IO_FindExecutable( "groebner" );
    
    filestream := IO_Popen2( exec, [ filename ]);
    
    while IO_ReadLine( filestream.stdout ) <> "" do od;
    
    IO_Close( filestream.stdin );
    
    IO_Close( filestream.stdout );
    
    matrix := 4ti2Interface_Read_Matrix_From_File( Concatenation( filename, ".gro" ) );
    
    return matrix;
    
end );

##
InstallGlobalFunction( 4ti2Interface_groebner_basis,
                       
  function( arg )
    local matrix, dir, filename, exec, filestream;
    
    dir := DirectoryTemporary();
    
    if Length( arg ) < 1 then
        
        Error( "too few arguments" );
        
    fi;
    
    matrix := arg[ 1 ];
    
    filename := Filename( dir, "gap_4ti2_temp_lattice" );
    
    4ti2Interface_Write_Matrix_To_File( matrix, Concatenation( filename, ".lat" ) );
    
    if Length( arg ) > 1 then
        
        if not IsMatrix( arg[ 2 ] ) then
            arg[ 2 ] := [ arg[ 2 ] ];
        fi;
        
        4ti2Interface_Write_Matrix_To_File( [ arg[ 2 ] ], Concatenation( filename, ".cost" ) );
        
    fi;
    
    exec := IO_FindExecutable( "groebner" );
    
    filestream := IO_Popen2( exec, [ filename ]);
    
    while IO_ReadLine( filestream.stdout ) <> "" do od;
    
    IO_Close( filestream.stdin );
    
    IO_Close( filestream.stdout );
    
    matrix := 4ti2Interface_Read_Matrix_From_File( Concatenation( filename, ".gro" ) );
    
    return matrix;
    
end );

##
InstallGlobalFunction( 4ti2Interface_hilbert_inequalities,
                       
  function( matrix )
    local dir, filename, rel_list, sign_list, exec, filestream;
    
    if matrix = [ ] then
        
        return [ ];
        
    fi;
    
    dir := DirectoryTemporary();
    
    filename := Filename( dir, "gap_4ti2_temp_ineqs" );
    
    4ti2Interface_Write_Matrix_To_File( matrix, Concatenation( filename, ".mat" ) );
    
    rel_list := [ List( matrix, i -> ">" ) ];
    
    4ti2Interface_Write_Matrix_To_File( rel_list, Concatenation( filename, ".rel" ) );
    
    sign_list := [ List( matrix[ 1 ], i -> 0 ) ];
    
    4ti2Interface_Write_Matrix_To_File( sign_list, Concatenation( filename, ".sign" ) );
    
    exec := IO_FindExecutable( "hilbert" );
    
    filestream := IO_Popen2( exec, [ filename ]);
    
    while IO_ReadLine( filestream.stdout ) <> "" do od;
    
    IO_Close( filestream.stdin );
    
    IO_Close( filestream.stdout );
    
    matrix := 4ti2Interface_Read_Matrix_From_File( Concatenation( filename, ".hil" ) );
    
    return matrix;
    
end );

##
InstallGlobalFunction( 4ti2Interface_hilbert_inequalities_in_positive_orthant,
                       
  function( matrix )
    local dir, filename, rel_list, sign_list, exec, filestream;
    
    if matrix = [ ] then
        
        return [ ];
        
    fi;
    
    dir := DirectoryTemporary();
    
    filename := Filename( dir, "gap_4ti2_temp_ineqs" );
    
    4ti2Interface_Write_Matrix_To_File( matrix, Concatenation( filename, ".mat" ) );
    
    rel_list := [ List( matrix, i -> ">" ) ];
    
    4ti2Interface_Write_Matrix_To_File( rel_list, Concatenation( filename, ".rel" ) );
    
    exec := IO_FindExecutable( "hilbert" );
    
    filestream := IO_Popen2( exec, [ filename ]);
    
    while IO_ReadLine( filestream.stdout ) <> "" do od;
    
    IO_Close( filestream.stdin );
    
    IO_Close( filestream.stdout );
    
    matrix := 4ti2Interface_Read_Matrix_From_File( Concatenation( filename, ".hil" ) );
    
    return matrix;
    
end );

##
InstallGlobalFunction( 4ti2Interface_hilbert_equalities_in_positive_orthant,
                       
  function( matrix )
    local dir, filename, rel_list, sign_list, exec, filestream;
    
    if matrix = [ ] then
        
        return [ ];
        
    fi;
    
    dir := DirectoryTemporary();
    
    filename := Filename( dir, "gap_4ti2_temp_ineqs" );
    
    4ti2Interface_Write_Matrix_To_File( matrix, Concatenation( filename, ".mat" ) );
    
    rel_list := [ List( matrix, i -> "=" ) ];
    
    4ti2Interface_Write_Matrix_To_File( rel_list, Concatenation( filename, ".rel" ) );
    
    exec := IO_FindExecutable( "hilbert" );
    
    filestream := IO_Popen2( exec, [ filename ]);
    
    while IO_ReadLine( filestream.stdout ) <> "" do od;
    
    IO_Close( filestream.stdin );
    
    IO_Close( filestream.stdout );
    
    matrix := 4ti2Interface_Read_Matrix_From_File( Concatenation( filename, ".hil" ) );
    
    return matrix;
    
end );

##
InstallGlobalFunction( 4ti2Interface_hilbert_equalities_and_inequalities,
                       
  function( eqs, ineqs )
    local concat_list, dir, filename, rel_list, sign_list,
          return_matrix, exec, filestream;
    
    if eqs = [ ] and ineqs = [ ] then
        
        return [ ];
        
    fi;
    
    dir := DirectoryTemporary();
    
    filename := Filename( dir, "gap_4ti2_temp_ineqs" );
    
    concat_list := Concatenation( eqs, ineqs );
    
    4ti2Interface_Write_Matrix_To_File( concat_list, Concatenation( filename, ".mat" ) );
    
    rel_list := [ Concatenation( List( eqs, i -> "=" ), List( ineqs, i -> ">" ) ) ];
    
    4ti2Interface_Write_Matrix_To_File( rel_list, Concatenation( filename, ".rel" ) );
    
    sign_list := [ List( concat_list[ 1 ] , i -> 0 ) ];
    
    4ti2Interface_Write_Matrix_To_File( sign_list, Concatenation( filename, ".sign" ) );
    
    exec := IO_FindExecutable( "hilbert" );
    
    filestream := IO_Popen2( exec, [ filename ]);
    
    while IO_ReadLine( filestream.stdout ) <> "" do od;
    
    IO_Close( filestream.stdin );
    
    IO_Close( filestream.stdout );
    
    return_matrix := 4ti2Interface_Read_Matrix_From_File( Concatenation( filename, ".hil" ) );
    
    return return_matrix;
    
end );

##
InstallGlobalFunction( 4ti2Interface_hilbert_equalities_and_inequalities_in_positive_orthant,
                       
  function( eqs, ineqs )
    local concat_list, dir, filename, rel_list, sign_list,
          exec, filestream, return_matrix;
    
    if eqs = [ ] and ineqs = [ ] then
        
        return [ ];
        
    fi;
    
    dir := DirectoryTemporary();
    
    filename := Filename( dir, "gap_4ti2_temp_ineqs" );
    
    concat_list := Concatenation( eqs, ineqs );
    
    4ti2Interface_Write_Matrix_To_File( concat_list, Concatenation( filename, ".mat" ) );
    
    rel_list := [ Concatenation( List( eqs, i -> "=" ), List( ineqs, i -> ">" ) ) ];
    
    4ti2Interface_Write_Matrix_To_File( rel_list, Concatenation( filename, ".rel" ) );
    
    sign_list := [ List( concat_list[ 1 ] , i -> 0 ) ];
    
    4ti2Interface_Write_Matrix_To_File( sign_list, Concatenation( filename, ".sign" ) );
    
    exec := IO_FindExecutable( "hilbert" );
    
    filestream := IO_Popen2( exec, [ filename ]);
    
    while IO_ReadLine( filestream.stdout ) <> "" do od;
    
    IO_Close( filestream.stdin );
    
    IO_Close( filestream.stdout );
    
    return_matrix := 4ti2Interface_Read_Matrix_From_File( Concatenation( filename, ".hil" ) );
    
    return return_matrix;
    
end );

##
InstallGlobalFunction( 4ti2Interface_zsolve_equalities_and_inequalities,
                       
  function( arg )
    local eqs, eqs_rhs, ineqs, ineqs_rhs, signs,
          concat_list, dir, filename, rel_list, concat_rhs,
          return_matrix, exec, filestream, precision, std_err_out;
    
    if Length( arg ) < 4 then
        
        Error( "too few arguments" );
        
        return [ ];
        
    fi;
    
    eqs := arg[ 1 ];
    
    eqs_rhs := arg[ 2 ];
    
    ineqs := arg[ 3 ];
    
    ineqs_rhs := arg[ 4 ];
    
    if eqs = [ ] and ineqs = [ ] then
        
        return [ ];
        
    fi;
    
    if Length( arg ) > 4 then
        
        signs := [ arg[ 5 ] ];
        
    else
        
        if Length( eqs ) > 0 then
            
            signs := [ ListWithIdenticalEntries( Length( eqs[ 1 ] ), 0 ) ];
            
        else
            
            signs := [ ListWithIdenticalEntries( Length( ineqs[ 1 ] ), 0 ) ];
            
        fi;
        
    fi;
    
    precision := ValueOption( "precision" );
    
    if IsInt( precision ) then
        
        precision := String( precision );
        
    elif precision = fail then
        
        precision := "32";
        
    fi;
    
    dir := DirectoryTemporary();
    
    filename := Filename( dir, "gap_4ti2_zsolve" );
    
    concat_list := Concatenation( eqs, ineqs );
    
    4ti2Interface_Write_Matrix_To_File( concat_list, Concatenation( filename, ".mat" ) );
    
    rel_list := [ Concatenation( List( eqs, i -> "=" ), List( ineqs, i -> ">" ) ) ];
    
    4ti2Interface_Write_Matrix_To_File( rel_list, Concatenation( filename, ".rel" ) );
    
    4ti2Interface_Write_Matrix_To_File( signs, Concatenation( filename, ".sign" ) );
    
    concat_rhs := [ Concatenation( eqs_rhs, ineqs_rhs ) ];
    
    4ti2Interface_Write_Matrix_To_File( concat_rhs, Concatenation( filename, ".rhs" ) );
    
    exec := IO_FindExecutable( "zsolve" );
    
    filestream := IO_Popen3( exec, [ Concatenation( "-p=", precision ), filename ] );
    
    while IO_ReadLine( filestream.stdout ) <> "" do od;
    
    std_err_out := Concatenation( IO_ReadLines( filestream.stderr ) );
    
    IO_Close( filestream.stdin );
    
    IO_Close( filestream.stdout );
    
    IO_Close( filestream.stderr );
    
    if std_err_out <> "" then
        
        Error( Concatenation( "4ti2 Error:\n", std_err_out, "If you continue, your results might be wrong" ) );
        
    fi;
    
    return_matrix := [ 1, 2, 3 ];
    
    return_matrix[ 1 ] := 4ti2Interface_Read_Matrix_From_File( Concatenation( filename, ".zinhom" ) );
    
    return_matrix[ 2 ] := 4ti2Interface_Read_Matrix_From_File( Concatenation( filename, ".zhom" ) );
    
    return_matrix[ 3 ] := 4ti2Interface_Read_Matrix_From_File( Concatenation( filename, ".zfree" ) );
    
    return return_matrix;
    
end );

##
InstallGlobalFunction( 4ti2Interface_zsolve_equalities_and_inequalities_in_positive_orthant,
                       
  function( eqs, eqs_rhs, ineqs, ineqs_rhs )
    local signs, call_list;
    
    call_list := [ eqs, eqs_rhs, ineqs, ineqs_rhs ];
    
    if Length( eqs ) = 0 and Length( ineqs ) = 0 then
        
        return [ ];
        
    fi;
    
    if Length( eqs ) > 0 then
        
        signs := ListWithIdenticalEntries( Length( eqs[ 1 ] ), 1 );
        
    else
        
        signs := ListWithIdenticalEntries( Length( ineqs[ 1 ] ), 1 );
        
    fi;
    
    Add( call_list, signs );
    
    return CallFuncList( 4ti2Interface_zsolve_equalities_and_inequalities, call_list );
    
end );

##
InstallGlobalFunction( 4ti2Interface_graver_equalities,
                       
  function( arg )
    local eqs, signs,
          dir, filename,
          return_matrix, exec, filestream;
    
    if Length( arg ) < 1 then
        
        Error( "too few arguments" );
        
        return [ ];
        
    fi;
    
    eqs := arg[ 1 ];
    
    if eqs = [ ] then
        
        return [ ];
        
    fi;
    
    if Length( arg ) > 1 then
        
        signs := [ arg[ 2 ] ];
        
    else
        
        signs := [ ListWithIdenticalEntries( Length( eqs[ 1 ] ), 0 ) ];
        
    fi;
    
    dir := DirectoryTemporary();
    
    filename := Filename( dir, "gap_4ti2_graver" );
    
    4ti2Interface_Write_Matrix_To_File( eqs, Concatenation( filename, ".mat" ) );
    
    4ti2Interface_Write_Matrix_To_File( signs, Concatenation( filename, ".sign" ) );
    
    exec := IO_FindExecutable( "graver" );
    
    filestream := IO_Popen2( exec, [ filename ]);
    
    while IO_ReadLine( filestream.stdout ) <> "" do od;
    
    IO_Close( filestream.stdin );
    
    IO_Close( filestream.stdout );
    
    return_matrix := 4ti2Interface_Read_Matrix_From_File( Concatenation( filename, ".gra" ) );
    
    return return_matrix;
    
end );

##
InstallGlobalFunction( 4ti2Interface_graver_equalities_in_positive_orthant,
                       
  function( eqs )
    local dir, filename,
          return_matrix, exec, filestream;
    
    dir := DirectoryTemporary();
    
    filename := Filename( dir, "gap_4ti2_graver" );
    
    4ti2Interface_Write_Matrix_To_File( eqs, Concatenation( filename, ".mat" ) );
    
    exec := IO_FindExecutable( "graver" );
    
    filestream := IO_Popen2( exec, [ filename ]);
    
    while IO_ReadLine( filestream.stdout ) <> "" do od;
    
    IO_Close( filestream.stdin );
    
    IO_Close( filestream.stdout );
    
    return_matrix := 4ti2Interface_Read_Matrix_From_File( Concatenation( filename, ".gra" ) );
    
    return return_matrix;
    
end );