home *** CD-ROM | disk | FTP | other *** search
/ Math Solutions 1995 October / Math_Solutions_CD-ROM_Walnut_Creek_October_1995.iso / pc / mac / discrete / lib / abattoir.g next >
Encoding:
Text File  |  1993-05-05  |  10.6 KB  |  420 lines
  1. #############################################################################
  2. ##
  3. #A  abattoir.g                  GAP library                  Martin Schoenert
  4. ##
  5. #A  @(#)$Id: abattoir.g,v 3.11 1993/02/10 18:00:21 martin Rel $
  6. ##
  7. #Y  Copyright 1990-1992,  Lehrstuhl D fuer Mathematik,  RWTH Aachen,  Germany
  8. ##
  9. ##  This file is only there to catch some loose ends.
  10. ##
  11. #H  $Log: abattoir.g,v $
  12. #H  Revision 3.11  1993/02/10  18:00:21  martin
  13. #H  added nondestructive blist functions
  14. #H
  15. #H  Revision 3.10  1993/02/09  14:12:55  fceller
  16. #H  changed 'PKGNAME'
  17. #H
  18. #H  Revision 3.9  1993/02/04  11:22:41  martin
  19. #H  added 'LengthString', 'SubString', and 'ConcatenationString'
  20. #H
  21. #H  Revision 3.8  1992/12/07  07:42:58  fceller
  22. #H  added 'ExecPkg'
  23. #H
  24. #H  Revision 3.7  1992/12/04  13:41:12  fceller
  25. #H  changed 'ReadPkg' to allow variable number of args
  26. #H
  27. #H  Revision 3.6  1992/12/03  12:23:01  fceller
  28. #H  renamed 'IsEquivalent' to 'IsIdentical'
  29. #H
  30. #H  Revision 3.5  1992/11/19  14:34:43  fceller
  31. #H  added package functions
  32. #H
  33. #H  Revision 3.4  1992/08/19  10:00:24  fceller
  34. #H  added 'Save'
  35. #H
  36. #H  Revision 3.3  1992/08/18  09:30:20  fceller
  37. #H  added Juergen's lattice print functions
  38. #H
  39. #H  Revision 3.2  1992/08/14  16:09:31  fceller
  40. #H  added a primitive 'IsEquivalent' for lists
  41. #H
  42. #H  Revision 3.1  1992/04/07  20:07:51  martin
  43. #H  initial revision under RCS
  44. ##
  45.  
  46.  
  47. #############################################################################
  48. ##
  49. #F  LengthString(<string>)  . . . . . . . . . . . . . . .  length of a string
  50. ##
  51. ##  'LengthString' is obsolete since strings a lists.
  52. ##
  53. LengthString := Length;
  54.  
  55.  
  56. #############################################################################
  57. ##
  58. #F  SubString(<args>) . . . . . . . . . . . . . . . . . substring of a string
  59. ##
  60. ##  'SubString' is obsolete since strings are lists.
  61. ##
  62. SubString := function ( arg )
  63.     local    string, from, to;
  64.     string := arg[1];
  65.     if not IsString( string )  then
  66.         Error("usage: SubString( <string>, <from> [, <to>] )");
  67.     fi;
  68.     from := arg[2];
  69.     if not IsInt( from )  then
  70.         Error("usage: SubString( <string>, <from> [, <to>] )");
  71.     fi;
  72.     if Length(arg) = 3  then
  73.         to := arg[3];
  74.     else
  75.         to := Length(string);
  76.     fi;
  77.     if to < from  then return "";  fi;
  78.     if from <= 0  then  from := 1;  fi;
  79.     if Length(string) < from   then from := Length(string);  fi;
  80.     if to   <= 0  then  to   := 1;  fi;
  81.     if Length(string) < to     then to   := Length(string);  fi;
  82.     return string{[from..to]};
  83. end;
  84.  
  85.  
  86. #############################################################################
  87. ##
  88. #F  ConcatenationString(<string>,..)  . . . . . . .  concatenation of strings
  89. ##
  90. ##  'ConcatenationString' is obsolete since strings are lists.
  91. ##
  92. ConcatenationString := function ( arg )
  93.     local   res,  str;
  94.     res := "";
  95.     for str  in arg  do
  96.         Append( res, str );
  97.     od;
  98.     IsString( res );
  99.     return res;
  100. end;
  101.  
  102.  
  103. #############################################################################
  104. ##
  105. #F  FpGroup(<U>)  . . . . . . convert a group into a finitely presented group
  106. ##
  107. FpGroup := function( U )
  108.     return U.operations.FpGroup( U );
  109. end;
  110.  
  111.  
  112. #############################################################################
  113. ##
  114. #F  Edit(<name>)  . . . . . . . . . . . . . . . . . . . . . . . . edit a file
  115. ##
  116. if not IsBound( EDITOR )  then EDITOR := "vi";  fi;
  117.  
  118. Edit := function ( name )
  119.     Exec( ConcatenationString( EDITOR, " ", name ) );
  120.     Read( name );
  121. end;
  122.  
  123.  
  124. #############################################################################
  125. ##
  126. #F  ProductPol( <f>, <g> )  . . . . . . . . . . .  product of two polynomials
  127. ##
  128. ProductPol := function ( f, g )
  129.     local  prod,  q,  m,  n,  i,  k;
  130.     m := Length(f);  while 1 < m  and f[m] = 0  do m := m-1;  od;
  131.     n := Length(g);  while 1 < n  and g[n] = 0  do n := n-1;  od;
  132.     prod := [];
  133.     for i  in [ 2 .. m+n ]  do
  134.         q := 0;
  135.         for k  in [ Maximum(1,i-n) .. Minimum(m,i-1) ]  do
  136.             q := q + f[k] * g[i-k];
  137.         od;
  138.         prod[i-1] := q;
  139.     od;
  140.     return prod;
  141. end;
  142.  
  143.  
  144. #############################################################################
  145. ##
  146. #F  ValuePol( <f>, <x> )  . . . . . . . . . . . evaluate a polynom at a point
  147. ##
  148. ValuePol := function ( f, x )
  149.     local  value, i, id;
  150.     id := x ^ 0;
  151.     value := 0 * id;
  152.     i := Length(f);
  153.     while 0 < i  do
  154.         value := value * x + id * f[i];
  155.         i := i-1;
  156.     od;
  157.     return value;
  158. end;
  159.  
  160.  
  161. #############################################################################
  162. ##
  163. #F  MergedRecord(<rec1>,<rec2>...)  . . . . . . . merge the fields of records
  164. ##
  165. MergedRecord := function ( arg )
  166.     local   res,        # merged record, result
  167.             record,     # one of the arguments
  168.             name;       # name of one component of <record>
  169.     res := rec();
  170.     for record  in  arg do
  171.         for name  in RecFields( record )  do
  172.             if IsBound( res.(name) )  then
  173.                 Unbind( res.(name) );
  174.             else
  175.                 res.(name) := record.(name);
  176.             fi;
  177.         od;
  178.     od;
  179.     return res;
  180. end;
  181.  
  182.  
  183. #############################################################################
  184. ##
  185. #F  IsIdentical( <L>, <R> ) . . . . . . . . . are <L> and <R> the same object
  186. ##
  187. IsIdentical := function( L, R )
  188.     local   len,  erg;
  189.  
  190.     if Length(L) <> Length(R)  then
  191.         erg := false;
  192.     else
  193.         len := Length(L);
  194.         L[len+1] := "Dies ist ein wirklich bloeder Test";
  195.         erg := Length(L) = Length(R);
  196.         Unbind(L[len+1]);
  197.     fi;
  198.     return erg;
  199.  
  200. end;
  201.  
  202.  
  203. #############################################################################
  204. ##
  205. #F  UnionBlist( <blist1>, <blist2> )  . . . . . . . . . . . . union of blists
  206. ##
  207. UnionBlist := function ( arg )
  208.     local  U, i;
  209.     if Length( arg ) = 1  then
  210.         arg := arg[1];
  211.     fi;
  212.     U := Copy( arg[1] );
  213.     for i  in [2..Length(arg)]  do
  214.         UniteBlist( U, arg[i] );
  215.     od;
  216.     return U;
  217. end;
  218.  
  219.  
  220. #############################################################################
  221. ##
  222. #F  IntersectionBlist( <blist1>, <blist2> ) . . . . .  intersection of blists
  223. ##
  224. IntersectionBlist := function ( arg )
  225.     local  I, i;
  226.     if Length( arg ) = 1  then
  227.         arg := arg[1];
  228.     fi;
  229.     I := Copy( arg[1] );
  230.     for i  in [2..Length(arg)]  do
  231.         IntersectBlist( I, arg[i] );
  232.     od;
  233.     return I;
  234. end;
  235.  
  236.  
  237. #############################################################################
  238. ##
  239. #F  DifferenceBlist( <blist1>, <blist2> ) . . . . . . .  difference of blists
  240. ##
  241. DifferenceBlist := function ( blist1, blist2 )
  242.     local  D;
  243.     D := Copy( blist1 );
  244.     SubtractBlist( D, blist2 );
  245.     return D;
  246. end;
  247.  
  248.  
  249. #############################################################################
  250. ##
  251. #F  SetPrintLevel( <L>, <lev> ) . . . . . . . . . . .  set print level of <L>
  252. ##
  253. SetPrintLevel := function( L, lev )
  254.    L.operations.SetPrintLevel( L, lev );
  255. end;
  256.  
  257.  
  258. #############################################################################
  259. ##
  260. #F  Save( <file>, <obj>, <name> ) . . . . . . . . . save some strange objects
  261. ##
  262. Save := function( F, G, N )
  263.     if not IsRec(G) or not IsBound(G.operations.Save)  then
  264.         Error( "sorry, I do not know how to save <G>" );
  265.     fi;
  266.     G.operations.Save( F, G, N );
  267. end;
  268.  
  269.  
  270. #############################################################################
  271. ##
  272. #V  PKGNAME . . . . . . . . . . . . . . . . . . . location of share libraries
  273. ##
  274. SetPkgname := function( path )
  275.     local   i,  l,  p;
  276.  
  277.     # copy old path
  278.     path := Copy(path);
  279.  
  280.     # append final ';'
  281.     if path[Length(path)] <> ';'  then
  282.         Add( path, ';' );
  283.     fi;
  284.  
  285.     # replace "lib/;" by "pkg/;"
  286.     for i  in [ 1 .. Length(path)-4 ]  do
  287.         if path{[i..i+4]} = "lib/;"  then
  288.             path{[i..i+4]} := "pkg/;";
  289.         fi;
  290.     od;
  291.  
  292.     # now split paths
  293.     p := [];
  294.     l := 1;
  295.     for i  in [ 1 .. Length(path) ]  do
  296.         if path[i] = ';'  then
  297.             Add( p, path{[l..i-1]} );
  298.             IsString( p[Length(p)] );
  299.             l := i+1;
  300.         fi;
  301.     od;
  302.  
  303.     # and return
  304.     return p;
  305.  
  306. end;
  307.  
  308. PKGNAME := SetPkgname(LIBNAME);
  309.  
  310.  
  311. #############################################################################
  312. ##
  313. #F  ReadPkg( <lib>, <name> )  . . . . . . . . . .   read a share library file
  314. ##
  315. LOADED_PACKAGES := rec();
  316.  
  317. ReadPkg := function( arg )
  318.     local   ind,  fln,  i;
  319.  
  320.     # store old indent value, add two spaces
  321.     ind := ReadIndent;
  322.     ReadIndent := ConcatenationString( ReadIndent, "  " );
  323.  
  324.     # construct complete path
  325.     fln := Copy( LOADED_PACKAGES.(arg[1]) );
  326.     for i  in [ 2 .. Length(arg)-1 ]  do
  327.         Append( fln, arg[i] );
  328.         Add( fln, '/' );
  329.     od;
  330.     Append( fln, arg[Length(arg)] );
  331.     Append( fln, ".g" );
  332.     IsString(fln);
  333.     InfoRead1( "#I", ReadIndent, "ReadPkg( \"", fln, "\" )\n" );
  334.  
  335.     # read in file
  336.     if not READ(fln)  then
  337.     Error("share library file \"",fln,"\" must exist and be readable");
  338.     fi;
  339.  
  340.     # restore old indentation
  341.     ReadIndent := ind;
  342.  
  343. end;
  344.  
  345.  
  346. #############################################################################
  347. ##
  348. #F  ExecPkg( <lib>, <cmd>, <ags>, <dir> ) . . . . .  execute a package binary
  349. ##
  350. ##  Change to the directory <dir> and execute <cmd> with arguments <ags>.
  351. ##
  352. ExecPkg := function( lib, cmd, ags, dir )
  353.     local   del,  new,  i,  sub;
  354.  
  355.     # prefix <cmd> with path
  356.     new := Copy( LOADED_PACKAGES.(lib) );
  357.     Append( new, cmd );
  358.  
  359.     # construct the command line
  360.     cmd := ConcatenationString( "cd ", dir, "; ", new, " ", ags );
  361.     InfoRead1( "#I  ExecPkg: executing ", cmd, "\n" );
  362.     Exec(cmd);
  363.  
  364. end;
  365.  
  366.  
  367. #############################################################################
  368. ##
  369. #F  LoadPackage( <name> ) . . . . . . . . . . .  load a share library package
  370. ##
  371. LoadPackage := function( name )
  372.     local   path,  init,  ind;
  373.  
  374.     # store old indent value, add two spaces
  375.     ind := ReadIndent;
  376.     ReadIndent := ConcatenationString( ReadIndent, "  " );
  377.  
  378.     # find the share library <name>
  379.     for path  in PKGNAME  do
  380.  
  381.         # check next <path>
  382.         init := Copy(path);
  383.         Append( init, name );
  384.         Append( init, "/" );
  385.         IsString(init);
  386.         LOADED_PACKAGES.(name) := Copy(init);
  387.         Append( init, "init.g" );
  388.         IsString(init);
  389.  
  390.         # give read info
  391.         InfoRead1( "#I  LoadPackage tries \"", init, "\"\n" );
  392.  
  393.         # try to read the init file
  394.         if READ(init)  then
  395.             ReadIndent := ind;
  396.             return init;
  397.         fi;
  398.     od;
  399.  
  400.     # signal an error
  401.     Unbind( LOADED_PACKAGES.(name) );
  402.     ReadIndent := ind;
  403.     Error( "share library \"", name, "\" is not installed" );
  404.  
  405. end;
  406.  
  407.  
  408. #############################################################################
  409. ##
  410. #F  RequirePackage( <name> )  . . . . . . . . . .  make sure <name> is loaded
  411. ##
  412. RequirePackage := function( name )
  413.  
  414.     # check if <name> is already loaded
  415.     if not IsBound( LOADED_PACKAGES.(name) )  then
  416.     LoadPackage( name );
  417.     fi;
  418.  
  419. end;
  420.