=================================================================== RCS file: /home/cvs/OpenXM/src/kan96xx/Kan/dr.sm1,v retrieving revision 1.7 retrieving revision 1.10 diff -u -p -r1.7 -r1.10 --- OpenXM/src/kan96xx/Kan/dr.sm1 2000/12/29 07:19:38 1.7 +++ OpenXM/src/kan96xx/Kan/dr.sm1 2002/11/08 14:18:01 1.10 @@ -1,4 +1,4 @@ -% $OpenXM: OpenXM/src/kan96xx/Kan/dr.sm1,v 1.6 2000/12/10 07:48:42 takayama Exp $ +% $OpenXM: OpenXM/src/kan96xx/Kan/dr.sm1,v 1.9 2002/02/12 08:54:55 takayama Exp $ %% dr.sm1 (Define Ring) 1994/9/25, 26 %% This file is error clean. @@ -257,6 +257,8 @@ /arg1 set [/vars /n /i /xList /dList /param] pushVariables [ + (This is an obsolete macro. Use ring_of_differential_difference_operators) + error (mmLarger) (matrix) switch_function (mpMult) (difference) switch_function (red@) (module1) switch_function @@ -278,7 +280,44 @@ } def +/ring_of_differential_difference_operators { + /arg1 set + [/vars /n /i /xList /dList /param /dvar /evar /vars2 ] pushVariables + [ + /vars arg1 def + vars tag 6 eq not { + ( List is expected as the argument for ring_of_differential_difference_operators ) error + } { } ifelse + vars 0 get /dvar set + vars 1 get /evar set + (mmLarger) (matrix) switch_function + (mpMult) (difference) switch_function + (red@) (module1) switch_function + (groebner) (standard) switch_function + (isSameComponent) (x) switch_function + [dvar to_records pop] /vars set %[x y z] + vars reverse /xList set %[z y x] + + [evar to_records pop] /vars2 set %[s1 s2] + + vars2 reverse {@@@.Esymbol 2 1 roll 2 cat_n} map + xList + join /xList set %[Es2 Es1 z y x] + + vars2 reverse + vars {@@@.Dsymbol 2 1 roll 2 cat_n} map + reverse join /dList set %[s2 s1 Dz Dy Dx] + [(H)] xList join [@@@.esymbol] join /xList set + [(h)] dList join [@@@.Esymbol] join /dList set + [0 1 1 << vars2 length 1 add >> << xList length >> + 1 1 << vars2 length 1 add >> << xList length 1 sub >> ] /param set + [ xList dList param ] /arg1 set + ] pop + popVariables + arg1 +} def + /reverse { /arg1 set arg1 length 1 lt @@ -2283,7 +2322,7 @@ newline /tolower.aux { /arg1 set - arg1 64 gt arg1 96 lt and + arg1 64 gt arg1 91 lt and { arg1 32 add } { arg1 } ifelse } def @@ -3606,6 +3645,48 @@ $ [ff ff] fromVectors :: $ (it returns 1 else it returns 0.) $Example: (hoge) boundp ::$ ]] putUsages +[(isSubstr) + [ + (s1 s2 isSubstr pos) + (If s1 is a substring of s2, isSubstr returns the position in s2 from which) + (s1 is contained in s2.) + (If s1 is not a substring of s2, then isSubstr returns -1.) + ] +] putUsages +/isSubstr { + /arg2 set /arg1 set + [/in-isSubstr /s1 /s2 /i1 /i2 /n1 /n2 + /ans /flg + ] pushVariables + [ + /s1 arg1 def + /s2 arg2 def + s1 (array) dc /s1 set + s2 (array) dc /s2 set + /n1 s1 length def + /n2 s2 length def + /ans -1 def + 0 1 n2 n1 sub { + /i2 set + /flg 1 def + 0 1 n1 1 sub { + /i1 set + s1 i1 get s2 i2 i1 add get eq { + } { + /flg 0 def exit + } ifelse + } for + flg { + /ans i2 def + /isSubstr.L2 goto + } { /ans -1 def } ifelse + } for + /isSubstr.L2 + /arg1 ans def + ] pop + popVariables + arg1 +} def ;