version 1.6, 2000/12/28 00:08:13 |
version 1.11, 2003/11/20 09:20:36 |
|
|
/* $OpenXM: OpenXM/src/k097/slib.k,v 1.5 2000/12/10 09:34:27 takayama Exp $ */ |
/* $OpenXM: OpenXM/src/k097/slib.k,v 1.10 2001/01/13 01:17:36 takayama Exp $ */ |
/* slib.sm1, standard library. */ |
/* slib.sm1, standard library. */ |
/* April 26-- , 1996 */ |
/* April 26-- , 1996 */ |
/* Don't use function names that is already used as a postscipt macro names*/ |
/* Don't use function names that is already used as a postscipt macro names*/ |
|
|
if (K00_verbose) |
if (K00_verbose) |
sm1(" ( slib.k (slib.ccc): 8/17,1996, 3/4 -- 3/10,1997 ) message "); |
sm1(" ( slib.k (slib.ccc): 8/17,1996, 3/4 -- 3/10,1997 ) message "); |
|
|
|
|
|
/* |
|
Each Helplist[i] has the format |
|
[ category, [ key, explanations, ( args ,) (refs ,) (short descriptions)]] |
|
category : null or string |
|
key : string |
|
explanations : string or array of string (Ex. and << >> are key words) |
|
args : null or list of strings |
|
refs : null or list of strings |
|
short descriptions : string |
|
*/ |
Helplist = [ ]; |
Helplist = [ ]; |
def void HelpAdd(s) { |
def void HelpAdd(s,category) { |
|
local n; |
|
n = Length(Arglist); |
|
if (n <= 1) { |
|
category = null; |
|
} |
|
if (true) { |
|
/* Assert the args */ |
|
/* You can use functions only defined before using HelpAdd */ |
|
if (!(n == 1 || n == 2)) { |
|
Println(s); |
|
Error("HelpAdd: wrong argument length."); |
|
} |
|
if (!(Tag(category) == 0 || Tag(category) == 5)) { |
|
Println(category); |
|
Error("HelpAdd: wrong category."); |
|
} |
|
if (!(Tag(s) == 6)) { |
|
Println(s); |
|
Error("HelpAdd: s must be an array."); |
|
} |
|
if (! (Tag(s[0]) == 5)) { |
|
Println(s); |
|
Error("HelpAdd: s[0] must be a string."); |
|
} |
|
if (! (Tag(s[1]) == 5 || Tag(s[1]) == 6)) { |
|
Println(s); |
|
Error("HelpAdd: s[1] must be a string or an array."); |
|
} |
|
/* End of assert */ |
|
} |
|
s = [category,s]; |
Helplist = Append(Helplist,s); |
Helplist = Append(Helplist,s); |
} |
} |
|
|
|
def Tag(f) { |
|
local ans; |
|
ans = sm1(f," etag (universalNumber) dc "); |
|
return(ans); |
|
} |
|
def Error(s) { |
|
sm1(" s error "); |
|
} |
|
|
def Print(a) { /* print object without new line */ |
def Print(a) { /* print object without new line */ |
sm1(a," messagen"); |
sm1(a," messagen"); |
} |
} |
Line 37 def Append(f,g) { return(Join(f,[g])); } |
|
Line 88 def Append(f,g) { return(Join(f,[g])); } |
|
|
|
def Length(f) { sm1(f," length (universalNumber) dc /FunctionValue set"); } |
def Length(f) { sm1(f," length (universalNumber) dc /FunctionValue set"); } |
|
|
def Indexed(name,i) { |
|
sm1(name,i," s.Indexed /FunctionValue set "); |
|
} |
|
/* Indexed2("a",2,3) ---> "a[2,3]" */ |
|
def Indexed2(name,i,j) { |
|
sm1(name,i,j," s.Indexed2 /FunctionValue set "); |
|
} |
|
def Transpose(mat) { |
def Transpose(mat) { |
sm1(mat," transpose /FunctionValue set "); |
sm1(mat," transpose /FunctionValue set "); |
} |
} |
Line 78 def LiftStd(F) { /* Print("Input is "); Println(F); */ |
|
Line 122 def LiftStd(F) { /* Print("Input is "); Println(F); */ |
|
[arg1 [(needBack)]] groebner |
[arg1 [(needBack)]] groebner |
/FunctionValue set "); } |
/FunctionValue set "); } |
|
|
|
/* |
def Reduction(f,G) { |
def Reduction(f,G) { |
sm1(f,G," reduction /FunctionValue set "); |
sm1(f,G," reduction /FunctionValue set "); |
} |
} |
|
*/ |
|
def Reduction(f,myset) { |
|
local n, indexTable, set2, i, j, tmp, t_syz,r,rng, |
|
vsize,tt; |
|
vsize = null; |
|
r = GetRing(Poly("1")); /* Save the current ring */ |
|
rng = GetRing(f); |
|
if (Tag(rng) == 0) { |
|
rng = GetRing(myset); |
|
} |
|
if (Tag(rng) != 0) {SetRing(rng);} |
|
|
|
if (IsArray(f)) { |
|
vsize = Length(f); |
|
sm1(" [f] fromVectors 0 get /f set "); |
|
} |
|
|
|
n = Length(myset); |
|
if (n > 0) { |
|
if (IsArray(myset[0])) { |
|
if (vsize != Length(myset[0])) { |
|
Error("Reduction: size mismatch."); |
|
} |
|
sm1(" myset fromVectors /myset set "); |
|
} |
|
} |
|
|
|
indexTable = NewArray(n); |
|
set2 = [ ]; |
|
j = 0; |
|
for (i=0; i<n; i++) { |
|
if (Tag(myset[i]) == 0) { |
|
indexTable[i] = -1; |
|
}else if (myset[i] == Poly("0")) { |
|
indexTable[i] = -1; |
|
}else{ |
|
set2 = Append(set2,myset[i]); |
|
indexTable[i] = j; |
|
j++; |
|
} |
|
} |
|
sm1(" f set2 (gradedPolySet) dc reduction /tmp set "); |
|
t_syz = NewArray(n); |
|
for (i=0; i<n; i++) { |
|
if (indexTable[i] != -1) { |
|
t_syz[i] = tmp[2, indexTable[i]]; |
|
}else{ |
|
t_syz[i] = Poly("0"); |
|
} |
|
} |
|
if (Tag(vsize) != 0) { |
|
tt = tmp[0]; |
|
sm1(" [vsize (integer) dc tt] toVectors /tt set "); |
|
tmp[0] = tt; |
|
} |
|
SetRing(r); |
|
return([tmp[0],tmp[1],t_syz]); |
|
} |
|
|
|
|
|
|
def IntegerToSm1Integer(f) { |
def IntegerToSm1Integer(f) { |
sm1(f, " (integer) dc /FunctionValue set "); |
sm1(f, " (integer) dc /FunctionValue set "); |
} |
} |
def RingD(vList,weightMatrix,pp) { |
def RingD(vList,weightMatrix,pp) { |
local new0,tmp,size,n,i,j,newtmp,ringpp,argsize; |
local new0,tmp,size,n,i,j,newtmp,ringpp,argsize; |
argsize = Length(Arglist); |
argsize = Length(Arglist); |
|
if (IsArray(vList)) { |
|
sm1(" vList {toString} map from_records /vList set "); |
|
} |
if (argsize == 1) { |
if (argsize == 1) { |
sm1("[", vList, |
sm1("[", vList, |
"ring_of_differential_operators ( ) elimination_order 0 ] define_ring |
"ring_of_differential_operators ( ) elimination_order 0 ] define_ring |
Line 162 def SetRingVariables() { |
|
Line 268 def SetRingVariables() { |
|
def k00AreThereLeftBrace(s) { |
def k00AreThereLeftBrace(s) { |
local leftBrace, jj, slist; |
local leftBrace, jj, slist; |
leftBrace = sm1(" $[$ (array) dc 0 get (universalNumber) dc "); |
leftBrace = sm1(" $[$ (array) dc 0 get (universalNumber) dc "); |
jj = Position(StringToIntegerArray(s),leftBrace); |
jj = Position(StringToAsciiArray(s),leftBrace); |
if (jj != -1) return(true); else return(false); |
if (jj != -1) return(true); else return(false); |
} |
} |
|
|
Line 265 def Replace(f,rule) { |
|
Line 371 def Replace(f,rule) { |
|
def Map(karg,func) { |
def Map(karg,func) { |
sm1(karg," { [ 2 -1 roll ] this 2 -1 roll [(parse) ",func," ] extension pop } map /FunctionValue set"); |
sm1(karg," { [ 2 -1 roll ] this 2 -1 roll [(parse) ",func," ] extension pop } map /FunctionValue set"); |
} |
} |
HelpAdd(["Map", |
|
["Map(karg,func) applies the function <<func>> to the <<karg>>(string func).", |
|
" Ex. Map([82,83,85],\"AsciiToString\"):"]]); |
|
/* test Map |
/* test Map |
def foo1(i) { return(i*2); } |
def foo1(i) { return(i*2); } |
def foo() { |
def foo() { |
Line 288 def Position(list,elem) { |
|
Line 391 def Position(list,elem) { |
|
sm1(" /k00.label0 "); |
sm1(" /k00.label0 "); |
return(pos); |
return(pos); |
} |
} |
HelpAdd(["Position", |
|
["Position(list,elem) returns the position p of the element <<elem>> in", |
|
" the array <<list>>. If <<elem>> is not in <<list>>, it return -1", |
|
" (array list).", |
|
"Ex. Position([1,34,2],34): "]]); |
|
|
|
def StringToIntegerArray(s) { |
def StringToAsciiArray(s) { |
sm1(s," (array) dc { (universalNumber) dc } map /FunctionValue set "); |
sm1(s," (array) dc { (universalNumber) dc } map /FunctionValue set "); |
} |
} |
HelpAdd(["StringToIntegerArray", |
|
["StringToIntegerArray(s) decomposes the string <<s>> into an array of", |
|
"ascii codes of <<s>> (string s).", |
|
"cf. AsciiToString."]]); |
|
def StringToAsciiArray(s) { return(StringToIntegerArray(s)); } |
|
HelpAdd(["StringToAsciiArray", |
|
["StringToAsciiArray(s) is StringToIntegerArray(s)."]]); |
|
|
|
|
|
def NewArray(n) { |
def NewArray(n) { |
return(NewVector(n)); |
return(NewVector(n)); |
} |
} |
HelpAdd(["NewArray", |
|
["NewArray(n) returns an array of size n (integer n)."]]); |
|
|
|
def GetEnv(s) { |
def GetEnv(s) { |
sm1(" [(getenv) s] extension /FunctionValue set "); |
sm1(" [(getenv) s] extension /FunctionValue set "); |
} |
} |
HelpAdd(["GetEnv", |
|
["GetEnv(s) returns the value of the environmental variable s (string s)."]]); |
|
def Boundp(a) { |
def Boundp(a) { |
local b; |
local b; |
sm1("[(parse) [(/) ",a," ( load tag 0 eq |
sm1("[(parse) [(/) ",a," ( load tag 0 eq |
{ /FunctionValue 0 def } |
{ /FunctionValue 0 def } |
{ /FunctionValue 1 def } ifelse )] cat ] extension"); |
{ /FunctionValue 1 def } ifelse )] cat ] extension"); |
} |
} |
HelpAdd(["Boundp", |
|
["Boundp(s) checks if the symbol s is bounded to a value or not (string s)."]]); |
|
def Rest(a) { |
def Rest(a) { |
sm1(a," rest /FunctionValue set "); |
sm1(a," rest /FunctionValue set "); |
} |
} |
HelpAdd(["Rest", |
|
["Rest(a) returns the rest (cdr) of a (list a)."]]); |
|
def GetPathName(s) { |
def GetPathName(s) { |
local t,sss; |
local t,sss; |
sss = s; |
sss = s; |
Line 346 def GetPathName(s) { |
|
Line 428 def GetPathName(s) { |
|
return(s); |
return(s); |
} |
} |
} |
} |
HelpAdd(["GetPathName", |
|
["GetPathName(s) checks if the file s exists in the current directory or", |
|
"in LOAD_K_PATH. If there exists, it returns the path name (string s)."]]); |
|
|
|
def Load_sm1(fnames,flag) { |
def Load_sm1(fnames,flag) { |
local ppp,n,i,cmd; |
local ppp,n,i,cmd; |
Line 367 def Load_sm1(fnames,flag) { |
|
Line 446 def Load_sm1(fnames,flag) { |
|
} |
} |
} |
} |
|
|
HelpAdd(["Load_sm1", |
|
["Load_sm1(s,flag) loads a sm1 program from s[0], s[1], ....", |
|
"If loading is succeeded, the already-loaded flag is set to true.", |
|
"(list s, string flag)."]]); |
|
|
|
def GetRing(f) { |
def GetRing(f) { |
sm1(" f getRing /FunctionValue set "); |
sm1(" f getRing /FunctionValue set "); |
Line 378 def GetRing(f) { |
|
Line 453 def GetRing(f) { |
|
|
|
def SetRing(r) { |
def SetRing(r) { |
sm1(" r ring_def "); |
sm1(" r ring_def "); |
} |
} |
|
|
|
def ReParse(a) { |
|
local c; |
|
if (IsArray(a)) { |
|
c = Map(a,"ReParse"); |
|
}else{ |
|
sm1(a," toString . /c set"); |
|
} |
|
return(c); |
|
} |
|
|
|
def void Pmat(a) { |
|
sm1(" a pmat "); |
|
} |
|
|
|
def void QuoteMode(a) { |
|
if ( a == 0) { |
|
sm1("[(QuoteMode) 0] system_variable "); |
|
}else{ |
|
sm1("[(QuoteMode) 1] system_variable "); |
|
} |
|
} |
|
|