|
#############################################################################
##
## This file is part of GAP, a system for computational discrete algebra.
## This file's authors include Frank Celler.
##
## Copyright of GAP belongs to its developers, whose names are too numerous
## to list here. Please refer to the COPYRIGHT file for details.
##
## SPDX-License-Identifier: GPL-2.0-or-later
##
## This file contains functions for strings.
##
#############################################################################
##
#F IsDigitChar(<c>)
##
InstallGlobalFunction(IsDigitChar,x->x in CHARS_DIGITS);
#############################################################################
##
#F IsUpperAlphaChar(<c>)
##
InstallGlobalFunction(IsUpperAlphaChar,x->x in CHARS_UALPHA);
#############################################################################
##
#F IsLowerAlphaChar(<c>)
##
InstallGlobalFunction(IsLowerAlphaChar,x->x in CHARS_LALPHA);
#############################################################################
##
#F IsAlphaChar(<c>)
##
InstallGlobalFunction(IsAlphaChar,x->x in CHARS_ALPHA);
#############################################################################
##
#F DaysInYear( <year> ) . . . . . . . . . days in a year, knows leap-years
##
InstallGlobalFunction(DaysInYear , function ( year )
if year mod 4 in [1,2,3] or year mod 400 in [100,200,300] then
return 365;
else
return 366;
fi;
end);
#############################################################################
##
#F DaysInMonth( <month>, <year> ) . . . . days in a month, knows leap-years
##
InstallGlobalFunction(DaysInMonth , function ( month, year )
if month in [ 1, 3, 5, 7, 8, 10, 12 ] then
return 31;
elif month in [ 4, 6, 9, 11 ] then
return 30;
elif month = 2 and
(year mod 4 in [1,2,3] or year mod 400 in [100,200,300]) then
return 28;
elif month = 2 then
return 29;
else
return fail;
fi;
end);
#############################################################################
##
#F DMYDay( <day> ) . . . convert days since 01-Jan-1970 into day-month-year
##
InstallGlobalFunction(DMYDay , function ( day )
local year, month;
year := 1970;
while DaysInYear(year) <= day do
day := day - DaysInYear(year);
year := year + 1;
od;
while day < 0 do
year := year - 1;
day := day + DaysInYear(year);
od;
month := 1;
while DaysInMonth(month,year) <= day do
day := day - DaysInMonth(month,year);
month := month + 1;
od;
return [ day+1, month, year ];
end);
#############################################################################
##
#F DayDMY( <dmy> ) . . . convert day-month-year into days since 01-Jan-1970
##
InstallGlobalFunction(DayDMY , function ( dmy )
local year, month, day;
day := dmy[1]-1;
month := dmy[2];
year := dmy[3];
if DaysInMonth(month, year) = fail or day < 0 or
day > DaysInMonth(month, year) - 1 then
return fail;
fi;
while 1 < month do
month := month - 1;
day := day + DaysInMonth( month, year );
od;
while 1970 < year do
year := year - 1;
day := day + DaysInYear( year );
od;
while year < 1970 do
day := day - DaysInYear( year );
year := year + 1;
od;
return day;
end);
#############################################################################
##
#F WeekDay( <date> ) . . . . . . . . . . . . . . . . . . . weekday of a date
##
InstallGlobalFunction(WeekDay , function ( date )
if IsList( date ) then date := DayDMY( date ); fi;
return NameWeekDay[ (date + 3) mod 7 + 1 ];
end);
#############################################################################
##
#F SecondsDMYhms( <DMYhms> ) . . . . . . . . . seconds since 1/1/1970/0/0/0
##
InstallGlobalFunction(SecondsDMYhms, function(DMYhms)
local d, res, s;
d := DayDMY(DMYhms{[1..3]});
if d = fail then
return fail;
fi;
res := d * 24 * 60^2;
s := DMYhms{[4..6]};
if not (s[1] in [0..23] and s[2] in [0..59] and s[3] in [0..59]) then
return fail;
fi;
Add(s, 0);
return res + SecHMSM(s) / 1000;
end);
#############################################################################
##
#F DMYhmsSeconds( <DMYhms> ) . . . . . . . . . inverse of SecondsDMYhms
##
InstallGlobalFunction(DMYhmsSeconds, function(sec)
local d, DMY;
d := sec mod (24 * 60^2);
DMY := DMYDay((sec - d) / (24 * 60^2));
return Concatenation(DMY, HMSMSec(d * 1000){[1..3]});
end);
#############################################################################
##
#F StringDate( <date> ) . . . . . . . . convert date into a readable string
##
InstallGlobalFunction(StringDate , function ( date )
if IsInt( date ) then date := DMYDay( date ); fi;
return Concatenation(
String(date[1],2), "-",
NameMonth[date[2]], "-",
String(date[3],4) );
end);
#############################################################################
##
#F HMSMSec( <sec> ) . . . . . . convert milliseconds into hour-min-sec-mill
##
InstallGlobalFunction(HMSMSec , function ( sec )
local hour, minute, second, milli;
hour := QuoInt( sec, 3600000 );
minute := QuoInt( sec, 60000 ) mod 60;
second := QuoInt( sec, 1000 ) mod 60;
milli := sec mod 1000;
return [ hour, minute, second, milli ];
end);
#############################################################################
##
#F SecHMSM( <hmsm> ) . . . . . . convert hour-min-sec-milli into milliseconds
##
InstallGlobalFunction(SecHMSM , function ( hmsm )
return [3600000, 60000, 1000, 1] * hmsm;
end);
#############################################################################
##
#F StringTime( <time> ) . convert hour-min-sec-milli into a readable string
##
InstallGlobalFunction(StringTime , function ( time )
local string;
if IsInt( time ) then time := HMSMSec( time ); fi;
string := "";
if time[1] < 10 then Append( string, " " ); fi;
Append( string, String(time[1]) );
Append( string, ":" );
if time[2] < 10 then Append( string, "0" ); fi;
Append( string, String(time[2]) );
Append( string, ":" );
if time[3] < 10 then Append( string, "0" ); fi;
Append( string, String(time[3]) );
Append( string, "." );
if time[4] < 100 then Append( string, "0" ); fi;
if time[4] < 10 then Append( string, "0" ); fi;
Append( string, String(time[4]) );
return string;
end);
#############################################################################
##
#F StringPP( <int> ) . . . . . . . . . . . . . . . . . . . . P1^E1 ... Pn^En
##
InstallGlobalFunction(StringPP, function( n )
local str, facs, i;
# hand special cases (in particular 0, 1, -1)
if n in [-3..3] then
return String( n );
fi;
if n < 0 then
n := -n;
str := "-";
else
str := "";
fi;
facs := Collected( Factors(Integers, n ) );
for i in [ 1 .. Length( facs ) ] do
if i > 1 then Append( str, "*" ); fi;
Append( str, String( facs[ i ][ 1 ] ) );
if facs[ i ][ 2 ] > 1 then
Append( str, "^" );
Append( str, String( facs[ i ][ 2 ] ) );
fi;
od;
return str;
end);
############################################################################
##
#F WordAlp( <alpha>, <nr> ) . . . . . . <nr>-th word over alphabet <alpha>
##
## returns a string that is the <nr>-th word over the alphabet <alpha>,
## w.r. to word length and lexicographical order. The empty word is
## 'WordAlp( <alpha>, 0 )'.
##
InstallGlobalFunction(WordAlp , function( alpha, nr )
local lalpha, # length of the alphabet
word, # the result
nrmod; # position of letter
lalpha:= Length( alpha );
word:= "";
while nr <> 0 do
nrmod:= nr mod lalpha;
if nrmod = 0 then nrmod:= lalpha; fi;
Add( word, alpha[ nrmod ] );
nr:= ( nr - nrmod ) / lalpha;
od;
return Reversed( word );
end);
BindGlobal("LOWERCASETRANSTABLE", (function()
local l;
l := List([0..255], CHAR_INT);
l{1+[65..90]} := l{1+[97..122]};
l{1+[192..214]} := l{33+[192..214]};
l{1+[216..221]} := l{33+[216..221]};
ConvertToStringRep(l);
return Immutable(l);
end)());
BindGlobal("UPPERCASETRANSTABLE", (function()
local l;
l := List([0..255], CHAR_INT);
l{1+[97..122]} := l{1+[65..90]};
l{33+[192..214]} := l{1+[192..214]};
l{33+[216..221]} := l{1+[216..221]};
ConvertToStringRep(l);
return Immutable(l);
end)());
#############################################################################
##
#F LowercaseString( <string> ) . . . string consisting of lower case letters
##
InstallGlobalFunction(LowercaseString , function( str )
local res;
# delegate to kernels TranslateString
res := ShallowCopy(str);
TranslateString(res, LOWERCASETRANSTABLE);
return res;
end);
InstallGlobalFunction(LowercaseChar , function( c )
return LOWERCASETRANSTABLE[IntChar(c)+1];
end);
#############################################################################
##
#F UppercaseString( <string> ) . . . string consisting of upper case letters
##
InstallGlobalFunction(UppercaseString , function( str )
local res;
# delegate to kernels TranslateString
res := ShallowCopy(str);
TranslateString(res, UPPERCASETRANSTABLE);
return res;
end);
InstallGlobalFunction(UppercaseChar , function( c )
return UPPERCASETRANSTABLE[IntChar(c)+1];
end);
#############################################################################
##
#M Int( <str> ) . . . . . . . . . . . . . . . . integer described by <str>
##
InstallMethod( Int,
"for strings",
true,
[ IsString ],
0,
INT_STRING );
#############################################################################
##
#M Rat( <str> ) . . . . . . . . . . . . . . . . rational described by <str>
##
InstallOtherMethod( Rat,
"for strings",
true,
[ IsString ],
0,
function( string )
local z, m, i, s, n, p, d;
z := 0;
m := 1;
p := 1;
d := false;
for i in [ 1 .. Length(string) ] do
if i = p and string[i] = '-' then
m := -1;
if Length(string) = 1 then
return fail;
fi;
elif string[i] = '/' and IsBound(n) then
return fail;
elif string[i] = '/' and not IsBound(n) then
if IsRat(d) then
z := d * z;
fi;
d := false;
n := m * z;
m := 1;
p := i+1;
z := 0;
elif string[i] = '.' and IsRat(d) then
return fail;
elif string[i] = '.' and not IsRat(d) then
d := 1;
else
s := Position( CHARS_DIGITS, string[i] );
if s <> fail then
z := 10 * z + (s-1);
else
return fail;
fi;
if IsRat(d) then
d := d / 10;
fi;
fi;
od;
if IsRat(d) then
z := d * z;
fi;
if IsBound(n) then
return m * n / z;
else
return m * z;
fi;
end );
#############################################################################
##
#M ViewObj(<string>)
#M ViewObj(<char>)
##
## The difference to PrintObj is that printable non-ASCII characters are
## output directly. Use PrintObj to get a result which can be safely reread
## by GAP or used for cut and paste.
##
# The first list is sorted and contains special characters. The second list
# contains characters that should instead be printed after a `\'.
BindGlobal("SPECIAL_CHARS_VIEW_STRING", MakeImmutable(
[ List(Concatenation([0..31],[34,92],[127..255]), CHAR_INT), [
"\\000", "\\>", "\\<", "\\c", "\\004", "\\005", "\\006", "\\007", "\\b", "\\t",
"\\n", "\\013", "\\014", "\\r", "\\016", "\\017", "\\020", "\\021", "\\022",
"\\023", "\\024", "\\025", "\\026", "\\027", "\\030", "\\031", "\\032", "\\033",
"\\034", "\\035", "\\036", "\\037", "\\\"", "\\\\",
"\\177","\\200","\\201","\\202","\\203","\\204","\\205","\\206","\\207",
"\\210","\\211","\\212","\\213","\\214","\\215","\\216","\\217","\\220",
"\\221","\\222","\\223","\\224","\\225","\\226","\\227","\\230","\\231",
"\\232","\\233","\\234","\\235","\\236","\\237","\\240","\\241","\\242",
"\\243","\\244","\\245","\\246","\\247","\\250","\\251","\\252","\\253",
"\\254","\\255","\\256","\\257","\\260","\\261","\\262","\\263","\\264",
"\\265","\\266","\\267","\\270","\\271","\\272","\\273","\\274","\\275",
"\\276","\\277","\\300","\\301","\\302","\\303","\\304","\\305","\\306",
"\\307","\\310","\\311","\\312","\\313","\\314","\\315","\\316","\\317",
"\\320","\\321","\\322","\\323","\\324","\\325","\\326","\\327","\\330",
"\\331","\\332","\\333","\\334","\\335","\\336","\\337","\\340","\\341",
"\\342","\\343","\\344","\\345","\\346","\\347","\\350","\\351","\\352",
"\\353","\\354","\\355","\\356","\\357","\\360","\\361","\\362","\\363",
"\\364","\\365","\\366","\\367","\\370","\\371","\\372","\\373","\\374",
"\\375","\\376","\\377" ]]));
InstallMethod(ViewObj, "IsChar", true, [IsChar], 0,
function(x)
local pos;
Print("'");
pos := Position(SPECIAL_CHARS_VIEW_STRING[1], x);
if pos <> fail then
Print( SPECIAL_CHARS_VIEW_STRING[2][pos] );
else
Print( [ x ] );
fi;
Print("\'");
end);
# we overwrite this in GAPDoc such that Unicode can be used depending on string
# and terminal encoding
InstallMethod(ViewObj, "IsString", true, [IsString and IsFinite],0,
function(s)
local x, pos;
Print("\"");
for x in s do
pos := Position(SPECIAL_CHARS_VIEW_STRING[1], x);
if pos <> fail then
Print( SPECIAL_CHARS_VIEW_STRING[2][pos] );
else
Print( [ x ] );
fi;
od;
Print("\"");
end);
InstallMethod(ViewObj,"empty strings",true,[IsString and IsEmpty],0,
function(e)
if IsStringRep(e) then
Print("\"\"");
else
Print("[ ]");
fi;
end);
#############################################################################
##
#M ViewString(<char>)
##
InstallMethod(ViewString, "IsChar", true, [IsChar], 0,
function(s)
local r;
r:=[ ''', s, ''' ];
ConvertToStringRep(r);
return r;
end);
#############################################################################
##
#M DisplayString(<char>)
##
InstallMethod(DisplayString, "IsChar", true, [IsChar], 0,
function(s)
local r;
r:=[ ''', s, ''', '\n' ];
ConvertToStringRep(r);
return r;
end);
#############################################################################
##
#M DisplayString(<list>)
##
InstallMethod(DisplayString, "IsList", true, [IsList and IsFinite], 0,
function( list )
if Length(list) = 0 then
if IsEmptyString( list ) then
return "\n";
else
return "[ ]\n";
fi;
elif IsString( list ) then
return Concatenation( list, "\n");
else
TryNextMethod();
fi;
end);
#############################################################################
##
#M SplitString( <string>, <seps>, <wspace> ) . . . . . . . . split a string
##
InstallMethod( SplitString,
"for three strings",
true,
[ IsString, IsString, IsString ], 0,
SplitStringInternal );
InstallMethod( SplitString,
"for a string and two characters",
true,
[ IsString, IsChar, IsChar ], 0,
function( string, d1, d2 )
return SplitString( string, [d1], [d2] );
end );
InstallMethod( SplitString,
"for two strings and a character",
true,
[ IsString, IsString, IsChar ], 0,
function( string, seps, d )
return SplitString( string, seps, [d] );
end );
InstallMethod( SplitString,
"for a string, a character and a string",
true,
[ IsString, IsChar, IsString ], 0,
function( string, d, wspace )
return SplitString( string, [d], wspace );
end );
InstallOtherMethod( SplitString,
"for two strings",
true,
[ IsString, IsString ], 0,
function( string, seps )
return SplitString( string, seps, "" );
end );
InstallOtherMethod( SplitString,
"for a string and a character",
true,
[ IsString, IsChar ], 0,
function( string, d )
return SplitString( string, [d], "" );
end );
InstallOtherMethod(PositionSublist, "for two args in IsStringRep", true,
[IS_STRING_REP, IS_STRING_REP], 0,
function( string, sub )
return POSITION_SUBSTRING(string, sub, 0);
end );
InstallOtherMethod(PositionSublist, "for two args in IsStringRep and offset",
true, [IS_STRING_REP, IS_STRING_REP, IsInt], 0,
function( string, sub, off )
if off<0 then
off := 0;
fi;
return POSITION_SUBSTRING(string, sub, off);
end );
#############################################################################
##
#F NormalizedWhitespace( <str> ) . . . . . . . copy of string with normalized
#F white space
##
## doesn't work in place like the kernel function `NormalizeWhitespace'
##
InstallGlobalFunction("NormalizedWhitespace", function ( str )
local res;
res := ShallowCopy( str );
NormalizeWhitespace( res );
return res;
end);
#############################################################################
##
#F RemoveCharacters( <string>, <todelete> )
##
# moved into kernels string.c
## InstallGlobalFunction( "RemoveCharacters", function( string, todelete )
## local len, posto, posfrom, i;
##
## len:= Length( string );
## posto:= 0;
## posfrom:= 1;
## while posfrom <= len do
## if not string[ posfrom ] in todelete then
## posto:= posto + 1;
## string[ posto ]:= string[ posfrom ];
## fi;
## posfrom:= posfrom + 1;
## od;
## for i in [ len, len-1 .. posto + 1 ] do
## Unbind( string[i] );
## od;
## end );
InstallGlobalFunction("RemoveCharacters", REMOVE_CHARACTERS);
#############################################################################
##
#F EvalString( <expr> ) . . . . . . . . . . . . evaluate a string expression
##
_EVALSTRINGTMP := 0;
InstallGlobalFunction("EvalString", function( s )
local a, f, res;
a := "_EVALSTRINGTMP:=";
Append(a, s);
# The code handling syntax error messages breaks if the semicolon is the
# last character in the input stream. We thus add a line break just as one
# would by pressing the <RETURN> key while in the REPL.
Append(a, ";\n");
Unbind(_EVALSTRINGTMP);
f := InputTextString(a);
Read(f);
if not IsBound(_EVALSTRINGTMP) then
Error("Could not evaluate string.\n");
fi;
res := _EVALSTRINGTMP;
Unbind(_EVALSTRINGTMP);
return res;
end);
Unbind(_EVALSTRINGTMP);
#############################################################################
##
#F JoinStringsWithSeparator( <list>[, <sep>] )
##
InstallGlobalFunction("JoinStringsWithSeparator", function( arg )
local str, sep, res, i;
str := List(arg[1], String);
if Length(str) = 0 then return ""; fi;
if Length(arg) > 1 then sep := arg[2]; else sep := ","; fi;
res := ShallowCopy(str[1]);
for i in [2 .. Length(str)] do
Append(res, sep);
Append(res, str[i]);
od;
return res;
end );
#############################################################################
##
#F Chomp( <str> ) . . remove trailing '\n' or "\r\n" from string if present
##
InstallGlobalFunction(Chomp, function(str)
if IsString(str) and str <> "" and Last(str) = '\n' then
if 1 < Length(str) and str[Length(str) - 1] = '\r' then
return str{[1 .. Length(str) - 2]};
fi;
return str{[1 .. Length(str) - 1]};
else
return str;
fi;
end);
InstallGlobalFunction(StartsWith, function(string, prefix)
return Length(prefix) <= Length(string) and
string{[1..Length(prefix)]} = prefix;
end);
InstallGlobalFunction(EndsWith, function(string, suffix)
return Length(suffix) <= Length(string) and
string{[Length(string)-Length(suffix)+1..Length(string)]} = suffix;
end);
#############################################################################
##
#F StringFile( <name> ) . . . . . . return content of file <name> as string
#F FileString( <name>, <string>[, <append> ] ) . . write <string> to <name>
##
## <#GAPDoc Label="StringFile">
## <ManSection >
## <Func Arg="filename" Name="StringFile" />
## <Func Arg="filename, str[, append]" Name="FileString" />
## <Description>
## The function <Ref Func="StringFile" /> returns the content of
## file <A>filename</A> as a string. This works efficiently with
## arbitrary (binary or text) files. If something went wrong, this
## function returns <K>fail</K>.
## <P/>
##
## Conversely the function <Ref Func="FileString" /> writes the
## content of a string <A>str</A> into the file <A>filename</A>. If
## the optional third argument <A>append</A> is given and equals
## <K>true</K> then the content of <A>str</A> is appended to the
## file. Otherwise previous content of the file is deleted. This
## function returns the number of bytes written or <K>fail</K> if
## something went wrong.<P/>
##
## Both functions are quite efficient, even with large files.
## </Description>
## </ManSection>
## <#/GAPDoc>
##
InstallGlobalFunction(StringFile, function(name)
local f, str;
f := InputTextFile(name);
if f=fail then
return fail;
fi;
str := READ_STRING_FILE(f![1]);
if str = fail then
CloseStream(f);
Error("in StringFile: ", LastSystemError().message,
" (", LastSystemError().number, ")\n");
return fail;
fi;
CloseStream(f);
return str;
end);
# arg: filename, string[, append] (default for append is false)
InstallGlobalFunction(FileString, function(arg)
local name, str, append, out;
name := arg[1];
str := arg[2];
if Length(arg)>2 then
append := arg[3];
else
append := false;
fi;
if not (IsString(name) and IsString(str) and IsBool(append)) then
Error("Usage: FileString(<name>, <str> [, <append> ])");
fi;
out := OutputTextFile(name, append);
if out=fail then
return fail;
fi;
IS_STRING_CONV(str);
if WRITE_STRING_FILE_NC(out![1], str) = fail then
CloseStream(out);
Error("in FileString: ", LastSystemError().message,
" (", LastSystemError().number, ")\n");
return fail;
fi;
CloseStream(out);
return Length(str);
end);
BindGlobal("RCSVSplitString",function(s,sep)
local l, i, start,nodob,str;
l:=[];
i:=1;
while i<=Length(s) do
if s[i]=sep then
Add(l,"");
i:=i+1;
elif s[i]='"' then
# find next ", treating "" special
str:="";
start:=i+1;
repeat
while (i+1<=Length(s) and s[i+1]<>'"') or
(i+2=Length(s) and s[i+2]<>sep) do
i:=i+1;
od;
if Length(s)>=i+2 and s[i+2]='"' then
str:=Concatenation(str,s{[start..i+1]});
i:=i+2;
start:=i+1;
nodob:=false;
else
nodob:=true;
fi;
until nodob;
# not closed "..." ?
if start<i and i=Length(s) and str="" then
return fail;
fi;
if Length(str)>0 then
Add(l,Concatenation(str,s{[start..i]}));
else
Add(l,s{[start..i]});
fi;
i:=i+3; # skip ",
else
start:=i;
while i<Length(s) and s[i+1]<>sep do
i:=i+1;
od;
Add(l,s{[start..i]});
i:=i+2; # skip comma
fi;
od;
return l;
end);
BindGlobal("RCSVReadLine",function(f)
local l, b;
l:="";
while not IsEndOfStream(f) do
b:=ReadByte(f);
if b<>fail then
if b<0 then
b:=b+256;
fi;
if b=10 or b=13 then
return l;
fi;
Add(l,CHAR_INT(b));
fi;
od;
return l;
end);
InstallGlobalFunction(ReadCSV,function(arg)
local nohead,file,sep,f, line, fields, l, r, i,s,t,add,dir;
file:=arg[1];
if not IsReadableFile(file) then
i:=file;
file:=Concatenation(i,".csv");
if not IsReadableFile(file) then
file:=Concatenation(i,".xls");
if not IsReadableFile(file) then
Error("file ",i," does not exist or is not readable");
fi;
fi;
fi;
if LowercaseString(file{[Length(file)-3..Length(file)]})=".xls" or
LowercaseString(file{[Length(file)-4..Length(file)]})=".xlsx" then
dir:=DirectoryTemporary();
i:=file;
file:=Filename(dir,"temp.csv");
Exec(Concatenation("xls2csv -x \"",i,"\" -c \"",file,"\""));
else
dir:=fail;
fi;
nohead:=false;
if Length(arg)>1 then
if IsBool(arg[2]) then
nohead:=arg[2];
fi;
sep:=Last(arg);
if IsString(sep) then
sep:=sep[1];
elif not IsChar(sep) then
sep:=',';
fi;
else
sep:=',';
fi;
f:=InputTextFile(file);
if f=fail then return f;fi; # wrong file
if nohead<>true then
line:=RCSVReadLine(f);
line:=Chomp(line);
if '"' in line and sep=',' then
fields:=RCSVSplitString(line,sep);
else
fields:=SplitString(line,sep);
fi;
# field names with blank or empty are awkward
for i in [1..Length(fields)] do
if ' ' in fields[i] then
fields[i]:=ReplacedString(fields[i]," ","_");
elif Length(fields[i])=0 then
fields[i]:=Concatenation("field",String(i));
fi;
od;
else
fields:=List([1..10000],i->Concatenation("field",String(i)));
fi;
l:=[];
while not IsEndOfStream(f) do
line:=RCSVReadLine(f);
if line<>fail then
line:=Chomp(line);
if '"' in line and sep=',' then
r:=RCSVSplitString(line,sep);
while r=fail do
r:=RCSVReadLine(f);
line:=Concatenation(line," ",r);
r:=RCSVSplitString(line,sep);
od;
line:=r;
else
line:=SplitString(line,sep);
fi;
r:=rec();
add:=false;
for i in [1..Length(fields)] do
if IsBound(line[i]) and Length(line[i])>0 then
s:=line[i];
# openoffice and Excel translate booleans differently.
if s="TRUE" then s:="1";
elif s="FALSE" then s:="0";
else
t:=Rat(s);
if not IsBool(t) and not '.' in s then
s:=t;
fi;
fi;
r.(fields[i]):=s;
add:=true;
fi;
od;
if add then
Add(l,r);
fi;
fi;
od;
CloseStream(f);
if dir<>fail then
RemoveFile(file);
fi;
return l;
end);
InstallGlobalFunction(PrintCSV,function(arg)
local stream,l,printEntry, rf, r, i, j, oldStreamFormattingStatus, close;
if IsString(arg[1]) then
stream:=OutputTextFile(arg[1],false);
close:=true;
elif IsOutputStream(arg[1]) then
stream:=arg[1];
close:=false;
else
Error("PrintCSV: filename must be a string or an output stream");
fi;
l:=arg[2];
printEntry:=function(s)
local p,q;
q:=false;
if not IsString(s) then
s:=String(s);
elif IsString(s) and ForAll(s,x->x in CHARS_DIGITS or x in "+-") and Int(s)<>fail and AbsInt(Int(s))>10^9 then
q:=true;
fi;
p:=Position(s,'\n');
while p<>fail do
s:=Concatenation(s{[1..p-1]},s{[p+1..Length(s)]});
p:=Position(s,'\n');
od;
p:=PositionSublist(s," ");
while p<>fail do
s:=Concatenation(s{[1..p-1]},s{[p+1..Length(s)]});
p:=PositionSublist(s," ");
od;
if '"' in s then
p:=1;
while p<=Length(s) do
if s[p]='"' then
s:=Concatenation(s{[1..p]},s{[p..Length(s)]});
p:=p+1;
fi;
p:=p+1;
od;
fi;
if ',' in s or '"' in s then
s:=Concatenation("\"",s,"\"");
elif q=true then
# integers as string
s:=Concatenation("\"_",s,"\"");
fi;
AppendTo(stream,s,"\c");
end;
oldStreamFormattingStatus:=PrintFormattingStatus(stream);
SetPrintFormattingStatus(stream,false);
if Length(arg)>2 then
rf:=arg[3];
else
rf:=[];
for i in l do
r:=RecNames(i);
for j in r do
if not j in rf then
Add(rf,j);
fi;
od;
od;
# sort record fields
Sort(rf,function(a,b)
local ap;
# check trailing numbers
ap:=Length(a);
while ap>0 and a[ap] in CHARS_DIGITS do
ap:=ap-1;
od;
if Length(b)>=ap and ForAll([ap+1..Length(b)],j->b[j] in CHARS_DIGITS) then
return Int(a{[ap+1..Length(a)]})<Int(b{[ap+1..Length(b)]});
fi;
return a<b;
end);
fi;
PrintTo(stream);
if ValueOption("noheader")<>true then
printEntry(rf[1]);
for j in [2..Length(rf)] do
AppendTo(stream,",");
printEntry(ReplacedString(rf[j],"_"," "));
od;
AppendTo(stream,"\n");
fi;
for i in l do
for j in [1..Length(rf)] do
if j>1 then
AppendTo(stream,",");
fi;
if IsBound(i.(rf[j])) then
printEntry(i.(rf[j]));
fi;
od;
AppendTo(stream,"\n");
od;
SetPrintFormattingStatus(stream,oldStreamFormattingStatus);
if close then
CloseStream(stream);
fi;
end);
# Format commands
# RLC: alignment
# M: Math mode
# MN: Math mode but names, characters are put into mbox
# F: Number displayed in factored form
# P: Minipage environment (25mm per default)
# B: Background color
# option `rows' colors alternating rows
InstallGlobalFunction(LaTeXTable,function(file,l)
local f,i,j,format,cold,a,e,z,str,new,box,lc,mini,color,alt,renum;
alt:=ValueOption("rows")<>fail;
color:=fail;
# row 1 indicates which columns are relevant and their formatting
cold:=ShallowCopy(l[1]);
f:=RecNames(cold);
renum:=[];
for i in ShallowCopy(f) do
a:=Filtered(cold.(i),x->x in CHARS_DIGITS);
if LENGTH(a)>0 then
cold.(i):=Filtered(cold.(i),x->not x in CHARS_DIGITS);
Add(renum,Int(a));
fi;
if cold.(i)="B" then
# color indicator
color:=i;
Unbind(cold.(i));
f:=Difference(f,[i]);
else
cold.(i):=UppercaseString(cold.(i));
fi;
od;
# resort columns if numbers are given
if Length(renum)=Length(f) then
a:=ShallowCopy(renum);
a:=Sortex(a);
f:=Permuted(f,a);
fi;
PrintTo(file);
# header
format:="";
for i in [1..Length(f)] do
if i>1 then Append(format,"|");fi;
if 'R' in cold.(f[i]) then
Add(format,'r');
elif 'C' in cold.(f[i]) then
Add(format,'c');
else
Add(format,'l');
fi;
od;
# header
AppendTo(file,"\\begin{tabular}{",format,"}\n");
for i in [1..Length(f)] do
if i>1 then AppendTo(file,"&");fi;
AppendTo(file,l[2].(f[i]),"\n");
od;
AppendTo(file,"\\\\\n");
AppendTo(file,"\\hline\n");
#entries
for j in [3..Length(l)] do
if color<>fail and IsBound(l[j].(color)) then
AppendTo(file,"\\rowcolor{",l[j].(color),"}%\n");
elif alt and IsEvenInt(j) then
# light grey color
AppendTo(file,"\\rowcolor{lgrey}%\n");
fi;
for i in [1..Length(f)] do
if i>1 then AppendTo(file,"&");fi;
if IsBound(l[j].(f[i])) then
str:=l[j].(f[i]);
# fix _integer to keep long integers from Excel
if IsList(str) and Length(str)>0 and str[1]='_' and
Int(str{[2..Length(str)]})<>fail then
str:=str{[2..Length(str)]};
fi;
if 'P' in cold.(f[i]) then
mini:=true;
AppendTo(file,"\\begin{minipage}{25mm}%\n");
else
mini:=false;
fi;
if 'F' in cold.(f[i]) then
if IsInt(str) then
a:=str;
else
# transform str in normal format
str:=Filtered(str,x->x<>',');
z:=0;
a:=Position(str,'E');
if a<>fail then
z:=Int(Filtered(str{[a+1..Length(str)]},x->x<>'+'));
str:=str{[1..a-1]};
fi;
a:=Position(str,'.');
if a<>fail then
z:=z-(Length(str)-a);
str:=Filtered(str,x->x<>'.');
fi;
a:=Int(str)*10^z;
fi;
a:=Collected(Factors(a));
AppendTo(file,"$");
for z in [1..Length(a)] do
if z>1 and e=false then
AppendTo(file,"\n{\\cdot}");
fi;
AppendTo(file,a[z][1]);
if a[z][2]>1 then
AppendTo(file,"^{",a[z][2],"}");
e:=true;
else
e:=false;
fi;
od;
AppendTo(file,"$\n");
elif 'M' in cold.(f[i]) and 'N' in cold.(f[i]) then
# make strings ``names'' in mbox
new:="";
box:=false;
lc:=false;
for a in str do
z:=a in CHARS_UALPHA or a in CHARS_LALPHA;
if z and box=false then
if lc='\\' then # actual command
box:=fail;
else
Append(new,"\\mbox{");
box:=true;
fi;
elif box=true and not z then
Append(new,"}");
box:=false;
elif box=fail and not z then
box:=false; # command over
fi;
Add(new,a);
lc:=a; # last character
od;
if box=true then
Append(new,"}");
fi;
AppendTo(file,"$",new,"$\n");
elif 'M' in cold.(f[i]) then
AppendTo(file,"$",str,"$\n");
else
AppendTo(file,str,"\n");
fi;
if mini then
AppendTo(file,"\\end{minipage}%\n");
fi;
fi;
od;
AppendTo(file,"\\\\\n");
od;
AppendTo(file,"\\end{tabular}\n");
end);
#############################################################################
##
#F Convenience method to inform users how to concatenate strings.
##
## Note that we could also have this method do the following
## return Concatenation(a,b);
## instead of raising an error. But this leads to inefficient code when
## concatenating many strings. So in order to not encourage such bad code,
## we instead tell the user the proper way to do this.
##
InstallOtherMethod(\+, [IsString,IsString],
function(a,b)
Error("concatenating strings via + is not supported, use Concatenation(<a>,<b>) instead");
end);
#############################################################################
##
#F StringOfMemoryAmount( <m> ) returns an appropriate human-readable string
## representation of <m> bytes
##
InstallGlobalFunction(StringOfMemoryAmount, function(m)
local whole, frac, shift, s, units;
if not IsInt(m) or m < 0 then
Error("StringOfMemoryAmount: amount must be a non-negative integer number of bytes");
fi;
whole := m;
frac := 0;
shift := 0;
while whole >= 1024 do
frac := whole mod 1024;
whole := Int(whole / 1024);
shift := shift+1;
od;
s := ShallowCopy(String(whole));
if whole < 100 then
Append(s,".");
Append(s,String(Int(frac*10/1024)));
if whole < 10 then
Append(s, String(Int(frac*100/1024) mod 10));
fi;
fi;
units := ["B","KB","MB","GB","TB","PB","EB","YB","ZB"];
Append(s, units[shift+1]);
return s;
end);
InstallGlobalFunction(PrintToFormatted, function(stream, s, data...)
local pos, len, nextbrace, endbrace,
argcounter, var,
splitReplacementField, toprint, namedIdUsed;
# Set to true if we ever use a named id in a replacement field
namedIdUsed := false;
# Split a replacement field {..} at [startpos..endpos]
splitReplacementField := function(startpos, endpos)
local posbang, format;
posbang := Position(s, '!', startpos-1);
if posbang = fail or posbang > endpos then
posbang := endpos + 1;
fi;
format := s{[posbang + 1 .. endpos]};
# If no format, default to "s"
if format = "" then
format := "s";
fi;
return rec(id := s{[startpos..posbang-1]}, format := format);
end;
argcounter := 1;
len := Length(s);
pos := 0;
if not (IsOutputStream(stream) or IsString(stream)) or not IsString(s) then
ErrorNoReturn("Usage: PrintToFormatted(<stream>, <string>, <data>...)");
fi;
while pos < len do
nextbrace := Position(s, '{', pos);
endbrace := Position(s, '}', pos);
# Scan until we find an '{'.
# Produce an error if we find '}', unless it is part of '}}'.
while IsInt(endbrace) and (nextbrace = fail or endbrace < nextbrace) do
if endbrace + 1 <= len and s[endbrace + 1] = '}' then
# Found }} with no { before it, insert everything up to
# including the first }, skipping the second.
AppendTo(stream, s{[pos+1..endbrace]});
pos := endbrace + 1;
endbrace := Position(s, '}', pos);
else
ErrorNoReturn("Mismatched '}' at position ",endbrace);
fi;
od;
if nextbrace = fail then
# In this case, endbrace = fail, or we would not have left
# previous while loop
AppendTo(stream, s{[pos+1..len]});
return;
fi;
AppendTo(stream, s{[pos+1..nextbrace-1]});
# If this is {{, then print a { and call 'continue'
if nextbrace+1 <= len and s[nextbrace+1] = '{' then
AppendTo(stream, "{");
pos := nextbrace + 1;
continue;
fi;
if endbrace = fail then
ErrorNoReturn("Invalid format string, no matching '}' at position ", nextbrace);
fi;
toprint := splitReplacementField(nextbrace+1,endbrace-1);
# Check if we are mixing giving id, and not giving id.
if (argcounter > 1 and toprint.id <> "") or (namedIdUsed and toprint.id = "") then
ErrorNoReturn("replacement field must either all have an id, or all have no id");
fi;
if toprint.id = "" then
if Length(data) < argcounter then
ErrorNoReturn("out of bounds -- used ",argcounter," replacement fields without id when there are only ",Length(data), " arguments");
fi;
var := data[argcounter];
argcounter := argcounter + 1;
elif Int(toprint.id) <> fail then
namedIdUsed := true;
if Int(toprint.id) < 1 or Int(toprint.id) > Length(data) then
ErrorNoReturn("out of bounds -- asked for {",Int(toprint.id),"} when there are only ",Length(data), " arguments");
fi;
var := data[Int(toprint.id)];
else
namedIdUsed := true;
if not IsRecord(data[1]) then
ErrorNoReturn("first data argument must be a record when using {",toprint.id,"}");
fi;
if not IsBound(data[1].(toprint.id)) then
ErrorNoReturn("no record member '",toprint.id,"'");
fi;
var := data[1].(toprint.id);
fi;
pos := endbrace;
if toprint.format = "s" then
if not IsString(var) then
var := String(var);
fi;
AppendTo(stream, var);
elif toprint.format = "v" then
AppendTo(stream, ViewString(var));
elif toprint.format = "d" then
AppendTo(stream, DisplayString(var));
else ErrorNoReturn("Invalid format: '", toprint.format, "'");
fi;
od;
end);
InstallGlobalFunction(StringFormatted, function(s, data...)
local str, stream;
if not IsString(s) then
ErrorNoReturn("Usage: StringFormatted(<string>, <data>...)");
fi;
str := "";
stream := OutputTextString(str, false);
SetPrintFormattingStatus(stream, false);
CallFuncList(PrintToFormatted, Concatenation([stream, s], data));
return str;
end);
InstallGlobalFunction(PrintFormatted, function(args...)
# Do some very baic argument checking
if not (Length(args) > 1 and IsString(args[1])) then
ErrorNoReturn("Usage: PrintFormatted(<string>, <data>...)");
fi;
# We can't use PrintTo, as we do not know where Print is currently
# directed
Print(CallFuncList(StringFormatted, args));
end);
InstallGlobalFunction(Pluralize,
function(args...)
local nargs, i, count, include_num, str, len, out;
#Int and one string
#Int and two strings
#One string
#Two strings
nargs := Length(args);
if nargs >= 1 and IsInt(args[1]) and args[1] >= 0 then
i := 2;
count := args[1];
include_num := true;
else
i := 1;
include_num := false; # if not given, assume pluralization is wanted.
fi;
if not (nargs in [i, i + 1] and
IsString(args[i]) and
(nargs = i or IsString(args[i + 1]))) then
ErrorNoReturn("Usage: Pluralize([<count>, ]<string>[, <plural>])");
fi;
str := args[i];
len := Length(str);
if len = 0 then
ErrorNoReturn("the argument <str> must be a non-empty string");
elif include_num and count = 1 then # no pluralization needed
return Concatenation("\>1\< ", str);
elif nargs = i + 1 then # pluralization given
out := args[i + 1];
elif len <= 2 then
out := Concatenation(str, "s");
# Guess and return the plural form of <str>.
# Inspired by the "Ruby on Rails" inflection rules.
# Uncountable nouns
elif str in ["equipment", "information"] then
out := str;
# Irregular plurals
elif str = "axis" then
out := "axes";
elif str = "child" then
out := "children";
elif str = "person" then
out := "people";
# Peculiar endings
elif EndsWith(str, "ix") or EndsWith(str, "ex") then
out := Concatenation(str{[1 .. len - 2]}, "ices");
elif EndsWith(str, "x") then
out := Concatenation(str, "es");
elif EndsWith(str, "tum") or EndsWith(str, "ium") then
out := Concatenation(str{[1 .. len - 2]}, "a");
elif EndsWith(str, "sis") then
out := Concatenation(str{[1 .. len - 3]}, "ses");
elif EndsWith(str, "fe") and not EndsWith(str, "ffe") then
out := Concatenation(str{[1 .. len - 2]}, "ves");
elif EndsWith(str, "lf") or EndsWith(str, "rf") or EndsWith(str, "loaf") then
out := Concatenation(str{[1 .. len - 1]}, "ves");
elif EndsWith(str, "y") and not str[len - 1] in "aeiouy" then
out := Concatenation(str{[1 .. len - 1]}, "ies");
elif str{[len - 1, len]} in ["ch", "ss", "sh"] then
out := Concatenation(str, "es");
elif EndsWith(str, "s") then
out := str;
# Default to appending 's'
else
out := Concatenation(str, "s");
fi;
if include_num then
return Concatenation("\>", String(args[1]), "\< ", out);
fi;
return out;
end);
[ Dauer der Verarbeitung: 0.38 Sekunden
(vorverarbeitet)
]
|
