Quelle general.gi
Sprache: unbekannt
|
|
#############################################################################
##
#W general.gi GAP4 Package `ResClasses' Stefan Kohl
##
## This file contains a couple of functions and methods which are not
## directly related to computations with residue classes, and which might
## perhaps later be moved into the GAP Library or elsewhere.
##
#############################################################################
#############################################################################
##
#S Multiplication with infinity. ///////////////////////////////////////////
##
#############################################################################
#############################################################################
##
#M \*( <n>, infinity ) . . . . . . . . . for positive rational and infinity
#M \*( infinity, <n> ) . . . . . . . . . for infinity and positive rational
#M \*( infinity, infinity ) . . . . . . . . . . . for infinity and infinity
##
InstallMethod( \*, "for positive rational and infinity (RCWA)",
ReturnTrue, [ IsPosRat, IsInfinity ], 0,
function ( n, infty ) return infinity; end );
InstallMethod( \*, "for infinity and positive rational (RCWA)",
ReturnTrue, [ IsInfinity, IsPosRat ], 0,
function ( infty, n ) return infinity; end );
InstallMethod( \*, "for infinity and infinity (RCWA)",
ReturnTrue, [ IsInfinity, IsInfinity ], 0,
function ( infty1, infty2 ) return infinity; end );
#############################################################################
##
#S List operations. ////////////////////////////////////////////////////////
##
#############################################################################
#############################################################################
##
#M PositionsSublist( <list>, <sub> )
##
InstallMethod( PositionsSublist, "default method",
ReturnTrue, [ IsList, IsList ],
function ( list, sub )
local positions, pos;
pos := 0; positions := [];
repeat
pos := PositionSublist(list,sub,pos);
if pos <> fail then Add(positions,pos); fi;
until pos = fail;
return positions;
end );
#############################################################################
##
#M EquivalenceClasses( <list>, <relation> )
#M EquivalenceClasses( <list>, <classinvariant> )
##
## Returns a list of equivalence classes on <list> under <relation>
## or a list of equivalence classes on <list> given by <classinvariant>,
## respectively.
##
## The argument <relation> must be a function which takes as arguments
## two entries of <list> and returns either true or false, and which
## describes an equivalence relation on <list>.
## The argument <classinvariant> must be a function which takes as argument
## an element of <list> and returns a class invariant.
##
InstallOtherMethod( EquivalenceClasses,
"for a list and a relation or a class invariant (RCWA)",
ReturnTrue, [ IsList, IsFunction ], 0,
function ( list, relation )
local classes, invs, longestfirst, byinvs, elm, pos, inserted, count;
if IsEmpty(list) then return []; fi;
longestfirst := function(c1,c2) return Length(c1) > Length(c2); end;
byinvs := function(c1,c2) return relation(c1[1]) < relation(c2[1]); end;
if NumberArgumentsFunction(relation) = 1 then
invs := List(list,relation);
classes := List(Set(invs),inv->list{Positions(invs,inv)});
Sort(classes,byinvs);
elif NumberArgumentsFunction(relation) = 2 then
classes := [[list[1]]]; count := 0;
for elm in list{[2..Length(list)]} do
inserted := false; count := count + 1;
for pos in [1..Length(classes)] do
if relation(elm,classes[pos][1]) then
Add(classes[pos],elm);
inserted := true;
break;
fi;
od;
if not inserted
then classes := Concatenation(classes,[[elm]]); fi;
if count mod 100 = 0 # rough performance heuristics ...
then Sort(classes,longestfirst); fi;
od;
Sort(classes,longestfirst);
else TryNextMethod(); fi;
return classes;
end );
#############################################################################
##
#S Utility functions for groups and their elements. ////////////////////////
##
#############################################################################
#############################################################################
##
#F LaTeXStringWord( <w> ) . . . . . . . . . . LaTeX string for a group word
##
InstallGlobalFunction( "LaTeXStringWord",
function ( w )
local s, i;
s := String(w);
s := ReplacedString(s,"^","^{");
for i in [0..9] do
s := ReplacedString(s,Concatenation(String(i),"*"),
Concatenation(String(i),"}*"));
s := ReplacedString(s,Concatenation(String(i),")"),
Concatenation(String(i),"})"));
od;
s := ReplacedString(s,"*","");
if Last(s) in DIGITS then Append(s,"}"); fi;
for i in [2..9] do
s := ReplacedString(s,Concatenation("{",String(i),"}"),String(i));
od;
return s;
end );
#############################################################################
##
#S Functions to generate small graphs. /////////////////////////////////////
##
#############################################################################
#############################################################################
##
#F AllGraphs( <n> ) . . . . all graphs with <n> vertices, up to isomorphism
##
InstallMethod( AllGraphs,
"for given number of vertices", true, [ IsPosInt ], 0,
n -> List( GraphClasses( n ), Representative ) );
#############################################################################
##
#F GraphClasses( <n> ) isomorphism classes of graphs with vertices 1,2,..,n
##
InstallMethod( GraphClasses,
"for given number of vertices", true, [ IsPosInt ], 0,
function ( n )
local classes;
classes := ShallowCopy(Orbits(SymmetricGroup(n),
Combinations(Combinations([1..n],2)),
function(Gamma,g)
return Set(Gamma,k->OnSets(k,g));
end));
SortParallel(List(classes,cl->Length(cl[1])),classes);
return classes;
end );
#############################################################################
##
#F IdGraphNC( <graph>, <classes> ) . . identify isomorphism class of <graph>
##
InstallMethod( IdGraphNC,
"for a graph and a list of classes of graphs", ReturnTrue,
[ IsList, IsList ], 0,
function ( graph, classes )
local vertexnums, i;
vertexnums := Set(Flat(graph));
graph := Set(graph,edge->List(edge,v->Position(vertexnums,v)));
return First([1..Length(classes)],
i -> Length(graph) = Length(classes[i][1])
and graph in classes[i]);
end );
#############################################################################
##
#S Creating timestamped logfiles. //////////////////////////////////////////
##
#############################################################################
#############################################################################
##
#F LogToDatedFile( <directory> )
##
InstallGlobalFunction( LogToDatedFile,
function ( arg )
local name, directory, gettimeofday, dmy;
if IsBoundGlobal("IO_gettimeofday") then
gettimeofday := ValueGlobal("IO_gettimeofday");
else
Error("the function `LogToDatedFile' is available only if the ",
"IO package\nis installed and compiled.");
return fail;
fi;
if Length(arg) >= 1 and IsString(arg[1])
then directory := arg[1];
else directory := "/user/GAP/log/"; fi;
dmy := DMYhmsSeconds(gettimeofday().tv_sec);
name := Concatenation(directory,
String(dmy[3]),"-",
String(dmy[2]+100){[2..3]},"-",
String(dmy[1]+100){[2..3]}," ",
String(dmy[4]+100){[2..3]},"-",
String(dmy[5]+100){[2..3]},"-",
String(dmy[6]+100){[2..3]},".log");
if IN_LOGGING_MODE <> false then LogTo(); fi;
LogTo(name);
return name;
end );
#############################################################################
##
#S SendEmail, EmailLogFile and DownloadFile ////////////////////////////////
##
#############################################################################
#############################################################################
##
#F SendEmail( <sendto>, <copyto>, <subject>, <text> ) . . . . send an e-mail
##
InstallGlobalFunction( SendEmail,
function ( sendto, copyto, subject, text )
local sendmail, inp;
sendto := JoinStringsWithSeparator( sendto, "," );
copyto := JoinStringsWithSeparator( copyto, "," );
sendmail := Filename( DirectoriesSystemPrograms( ), "mail" );
inp := InputTextString( text );
return Process( DirectoryCurrent( ), sendmail, inp, OutputTextNone( ),
[ "-s", subject, "-c", copyto, sendto ] );
end );
#############################################################################
##
#F EmailLogFile( <addresses> ) . . . send log file by e-mail to <addresses>
##
InstallGlobalFunction( EmailLogFile,
function ( addresses )
local filename, logfile, selection, pos1, pos2;
if ARCH_IS_UNIX() and IN_LOGGING_MODE <> false then
if IsString(addresses) then addresses := [addresses]; fi;
filename := UserHomeExpand(IN_LOGGING_MODE);
logfile := ReadAll(InputTextFile(filename));
if Length(logfile) > 2^16 then # Abbreviate output in long logfiles.
selection := ""; pos1 := 1;
repeat
pos2 := PositionSublist(logfile,"gap> ",pos1);
if pos2 = fail then pos2 := Length(logfile) + 1; fi;
Append(selection,logfile{[pos1..Minimum(pos1+1024,pos2-1)]});
if pos1 + 1024 < pos2 - 1 then
Append(selection,
logfile{[pos1+1025..Position(logfile,'\n',pos1+1024)]});
Append(selection," ");
Append(selection,"[ ... ]\n");
fi;
pos1 := pos2;
until pos2 >= Length(logfile);
logfile := selection;
if Length(logfile) > 2^16 then logfile := logfile{[1..2^16]}; fi;
fi;
return SendEmail(addresses,[],Concatenation("GAP logfile ",filename),
logfile);
fi;
end );
#############################################################################
##
#F DownloadFile( <url> ) . . . . . . . . . download a file from the internet
##
InstallGlobalFunction( DownloadFile,
function ( url )
local Download, host, path, slashpos, r;
if IsBoundGlobal("SingleHTTPRequest")
then Download := ValueGlobal("SingleHTTPRequest");
else Info(InfoWarning,1,"DownloadFile: the IO package is not loaded.");
return fail;
fi;
url := ReplacedString(url,"http://","");
slashpos := Position(url,'/');
host := url{[1..slashpos-1]};
path := url{[slashpos..Length(url)]};
r := Download(host,80,"GET",path,rec(),false,false);
if r.statuscode = 0 then
Info(InfoWarning,1,"Downloading ",url," failed: ",r.status);
return fail;
fi;
return r.body;
end );
#############################################################################
##
#S Routines for bitmap pictures. ///////////////////////////////////////////
##
#############################################################################
#############################################################################
##
#F SaveAsBitmapPicture( <picture>, <filename> ) . . . . save bitmap picture
##
InstallGlobalFunction( SaveAsBitmapPicture,
function ( picture, filename )
local AppendHex, Append16Bit, Append32Bit, str, colored,
height, width, fullwidth, length, offset, vec8, pix,
chunk, fill, x, y, n, i;
Append16Bit := function ( n )
Add(str,CHAR_INT(n mod 256)); Add(str,CHAR_INT(Int(n/256)));
end;
Append32Bit := function ( n )
Add(str,CHAR_INT(n mod 256)); n := Int(n/256);
Add(str,CHAR_INT(n mod 256)); n := Int(n/256);
Add(str,CHAR_INT(n mod 256)); n := Int(n/256);
Add(str,CHAR_INT(n));
end;
if not IsMatrix(picture) or not IsString(filename)
or (not IsInt(picture[1][1]) and not picture[1][1] in GF(2))
then Error("usage: SaveAsBitmapPicture( <picture>, <filename> )\n"); fi;
colored := IsInt(picture[1][1]);
height := Length(picture);
width := Length(picture[1]);
if colored then fullwidth := width + (width mod 4)/3;
elif width mod 32 <> 0 then
fullwidth := width + 32 - width mod 32;
fill := List([1..fullwidth-width],i->Zero(GF(2)));
ConvertToGF2VectorRep(fill);
picture := List(picture,line->Concatenation(line,fill));
else fullwidth := width; fi;
str := "BM";
if colored then offset := 54; length := 3 * fullwidth * height + offset;
else offset := 62; length := (fullwidth * height)/8 + offset;
fi;
for n in [length,0,offset,40,width,height] do Append32Bit(n); od;
Append16Bit(1);
if colored then
Append16Bit(24);
for i in [1..6] do Append32Bit(0); od;
for y in [1..height] do
for x in [1..width] do
pix := picture[y][x];
Add(str,CHAR_INT(pix mod 256)); pix := Int(pix/256);
Add(str,CHAR_INT(pix mod 256)); pix := Int(pix/256);
Add(str,CHAR_INT(pix));
od;
for i in [1..width mod 4] do Add(str,CHAR_INT(0)); od;
od;
else # monochrome picture
Append16Bit(1);
for i in [1..6] do Append32Bit(0); od;
Append32Bit(0); Append32Bit(2^24-1);
vec8 := List([0..255],i->CoefficientsQadic(i+256,2){[8,7..1]})*Z(2)^0;
for i in [1..256] do ConvertToGF2VectorRep(vec8[i]); od;
for y in [1..height] do
for x in [1,9..fullwidth-7] do
Add(str,CHAR_INT(PositionSorted(vec8,picture[y]{[x..x+7]})-1));
od;
od;
fi;
FileString(filename,str);
end );
#############################################################################
##
#F LoadBitmapPicture( <filename> ) . . . . . . . . . . . load bitmap picture
##
InstallGlobalFunction( LoadBitmapPicture,
function ( filename )
local str, picture, height, width, fullwidth, vec8, chunk, x, y, i;
if not IsString(filename)
then Error("usage: LoadBitmapPicture( <filename> )\n"); fi;
str := StringFile(filename);
if str = fail then Error("file not found"); return fail; fi;
width := List(str{[19..22]},INT_CHAR) * List([0..3],i->256^i);
height := List(str{[23..26]},INT_CHAR) * List([0..3],i->256^i);
if INT_CHAR(str[29]) = 24 then # 24-bit RGB picture
fullwidth := width + (width mod 4)/3;
picture := List([1..height],
y->List([1..Int(fullwidth)],
x->List(str{[55+3*(fullwidth*(y-1)+x-1)..
55+3*(fullwidth*(y-1)+x-1)+2]},
INT_CHAR)
*[1,256,65536]));
else # monochrome picture
if width mod 32 = 0 then fullwidth := width;
else fullwidth := width + 32 - width mod 32; fi;
vec8 := List([0..255],i->CoefficientsQadic(i+256,2){[8,7..1]})*Z(2)^0;
for i in [1..256] do ConvertToGF2VectorRep(vec8[i]); od;
picture := List([1..height],y->Concatenation(List([1,9..fullwidth-7],
x->vec8[INT_CHAR(str[63+(fullwidth*(y-1)+x-1)/8])+1])));
fi;
if width = fullwidth then return picture;
else return picture{[1..height]}{[1..width]}; fi;
end );
#############################################################################
##
#F DrawLineNC( <pic>, <x1>, <y1>, <x2>, <y2>, <color>, <width> )
##
InstallGlobalFunction( DrawLineNC,
function ( pic, x1, y1, x2, y2, color, width )
local w, h, x, y, ym, d, c, b1, b2, switched, tmp, i, j;
w := Length(pic[1]); h := Length(pic);
if AbsInt(x2-x1) < AbsInt(y2-y1) then
tmp := x1; x1 := y1; y1 := tmp;
tmp := x2; x2 := y2; y2 := tmp;
switched := true;
else switched := false; fi;
d := (y2-y1)/(x2-x1);
c := Sqrt(Float(((x2-x1)^2+(y2-y1)^2)/(x2-x1)^2))/2;
for x in [Minimum(x1,x2)..Maximum(x1,x2)] do
ym := y1+(x-x1)*d;
b1 := ym-c*width;
b2 := ym+c*width;
for y in [Int(b1)..Int(b2+0.5)] do
if switched then
if x < 1 or x > h or y < 1 or y > w then continue; fi;
else
if y < 1 or y > h or x < 1 or x > w then continue; fi;
fi;
if 1.0*y > b1 and 1.0*y < b2 then
if switched then pic[x][y] := color; else pic[y][x] := color; fi;
else
if Random([1..100]) < Int(Minimum(100*(b1-y),100*(y-b2))) then
if switched then pic[x][y] := color; else pic[y][x] := color; fi;
fi;
fi;
od;
od;
end );
#############################################################################
##
#F DrawGrid( <U>, <range_y>, <range_x>, <filename> )
##
InstallGlobalFunction( DrawGrid,
function ( U, range_y, range_x, filename )
local grid, x, y, one, offset_x, offset_y, colors, color, pos;
if not ( IsResidueClassUnionOfZxZ(U)
or IsList(U) and ForAll(U,IsResidueClassUnionOfZxZ))
or not IsRange(range_y) or not IsRange(range_x)
or not IsString(filename)
then
Error("usage: DrawGrid( <U>, <range_y>, <range_x>, <filename> )\n");
return fail;
fi;
offset_x := -Minimum(range_x) + 1;
offset_y := -Minimum(range_y) + 1;
if IsResidueClassUnionOfZxZ(U) then
grid := NullMat(Length(range_y),Length(range_x),GF(2));
one := One(GF(2));
for y in range_y do for x in range_x do
if not [y,x] in U then grid[y+offset_y][x+offset_x] := one; fi;
od; od;
else
colors := [[255,0,0],[0,255,0],[0,0,255],[255,255,0],[255,0,255],
[0,255,255],[255,128,128],[128,255,128],[128,128,255]]
* [65536,256,1];
grid := NullMat(Length(range_y),Length(range_x));
for y in range_y do
for x in range_x do
pos := First([1..Length(U)],k->[y,x] in U[k]);
if pos = fail then color := 0;
elif pos > Length(colors) then color := 2^24-1;
else color := colors[pos]; fi;
grid[y+offset_y][x+offset_x] := color;
od;
od;
fi;
SaveAsBitmapPicture( grid, filename );
end );
#############################################################################
##
#S A simple caching facility. //////////////////////////////////////////////
##
#############################################################################
#############################################################################
##
#F SetupCache( <name>, <size> )
##
InstallGlobalFunction( SetupCache,
function ( name, size )
BindGlobal(name,[[size,-1,fail]]);
end );
#############################################################################
##
#F PutIntoCache( <name>, <key>, <value> )
##
InstallGlobalFunction( PutIntoCache,
function ( name, key, value )
local cache, pos, i;
cache := ValueGlobal(name);
pos := Position(List(cache,t->t[1]),key,1);
if pos = fail then Add(cache,[key,0,value]);
else cache[pos][2] := 0; fi;
for i in [2..Length(cache)] do
cache[i][2] := cache[i][2] + 1;
od;
Sort(cache,function(t1,t2) return t1[2]<t2[2]; end);
while Length(cache) > cache[1][1]+1 do
Remove(cache);
od;
end );
#############################################################################
##
#F FetchFromCache( <name>, <key> )
##
InstallGlobalFunction( "FetchFromCache",
function ( name, key )
local cache, pos, i;
cache := ValueGlobal(name);
pos := Position(List(cache,t->t[1]),key,1);
if IsInt(pos) then
cache[pos][2] := 0;
for i in [2..Length(cache)] do
cache[i][2] := cache[i][2] + 1;
od;
return cache[pos][3];
fi;
return fail;
end );
#############################################################################
##
#S Other utilities. ////////////////////////////////////////////////////////
##
#############################################################################
#############################################################################
##
#F AssignGlobalNC( <name>, <value> ) . forced assignment to global variable
##
InstallGlobalFunction( AssignGlobalNC,
function ( name, value )
if IsReadOnlyGlobal(name) then MakeReadWriteGlobal(name); fi;
if IsBoundGlobal(name) then UnbindGlobal(name); fi;
BindGlobal(name,value);
end );
#############################################################################
##
#F GetOption( <option>, <default> [, <filter> ] )
##
InstallGlobalFunction( GetOption,
function ( arg )
local value, option, filter, default;
if not Length(arg) in [2,3] or not IsString(arg[1]) then return fail; fi;
option := arg[1];
default := arg[2];
if Length(arg) = 2 then
filter := IsObject;
else
filter := arg[3];
if not IsFunction(filter) then return fail; fi;
fi;
value := ValueOption(option);
if value <> fail and filter(value) = true
then return value;
else return default; fi;
end );
#############################################################################
##
#S Package-specific customizations. ////////////////////////////////////////
##
#############################################################################
#############################################################################
##
#M ViewString( <P> ) . . . . for a univariate polynomial over a finite field
##
InstallMethod( ViewString,
"for univariate polynomial over finite field (ResClasses)",
true, [ IsUnivariatePolynomial ], 0,
function ( P )
local str, R, F, coeffs, coeffstrings, coeffintstrings, i;
if ValueGlobal("GF_Q_X_RESIDUE_CLASS_UNIONS_FAMILIES") = []
then TryNextMethod(); fi;
str := String(P);
R := DefaultRing(P);
F := LeftActingDomain(R);
if not IsFinite(F) then TryNextMethod(); fi;
if not IsPrimeField(F) then return str; fi;
coeffs := CoefficientsOfUnivariateLaurentPolynomial(P)[1];
coeffs := Concatenation([Zero(F),One(F)],coeffs);
SortParallel(List(coeffs,c->-Length(String(c))),coeffs);
coeffstrings := List(coeffs,String);
coeffintstrings := List(List(coeffs,Int),String);
for i in [1..Length(coeffstrings)] do
str := ReplacedString(str,coeffstrings[i],coeffintstrings[i]);
od;
return str;
end );
#############################################################################
##
#E general.gi . . . . . . . . . . . . . . . . . . . . . . . . . . ends here
[ Dauer der Verarbeitung: 0.39 Sekunden
(vorverarbeitet)
]
|
2026-03-28
|
