version 1.7, 2000/12/29 07:19:38 |
version 1.11, 2003/05/15 00:42:07 |
|
|
% $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.10 2002/11/08 14:18:01 takayama Exp $ |
%% dr.sm1 (Define Ring) 1994/9/25, 26 |
%% dr.sm1 (Define Ring) 1994/9/25, 26 |
%% This file is error clean. |
%% This file is error clean. |
|
|
|
|
/arg1 set |
/arg1 set |
[/vars /n /i /xList /dList /param] pushVariables |
[/vars /n /i /xList /dList /param] pushVariables |
[ |
[ |
|
(This is an obsolete macro. Use ring_of_differential_difference_operators) |
|
error |
(mmLarger) (matrix) switch_function |
(mmLarger) (matrix) switch_function |
(mpMult) (difference) switch_function |
(mpMult) (difference) switch_function |
(red@) (module1) switch_function |
(red@) (module1) switch_function |
|
|
} def |
} 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 { |
/reverse { |
/arg1 set |
/arg1 set |
arg1 length 1 lt |
arg1 length 1 lt |
|
|
|
|
/tolower.aux { |
/tolower.aux { |
/arg1 set |
/arg1 set |
arg1 64 gt arg1 96 lt and |
arg1 64 gt arg1 91 lt and |
{ arg1 32 add } |
{ arg1 32 add } |
{ arg1 } ifelse |
{ arg1 } ifelse |
} def |
} def |
|
|
[(ord_w) |
[(ord_w) |
[(ff [v1 w1 v2 w2 ... vm wm] ord_w d) |
[(ff [v1 w1 v2 w2 ... vm wm] ord_w d) |
(poly ff; string v1; integer w1; ...) |
(poly ff; string v1; integer w1; ...) |
(order of ff by the weight vector [w1 w2 ...]) |
(order of the initial of ff by the weight vector [w1 w2 ...]) |
(Example: [(x,y) ring_of_polynomials 0] define_ring ) |
(Example: [(x,y) ring_of_polynomials 0] define_ring ) |
( (x^2 y^3-x). [(x) 2 (y) 1] ord_w ::) |
( (x^2 y^3-x). [(x) 2 (y) 1] ord_w ::) |
] |
] |
Line 3606 $ [ff ff] fromVectors :: $ |
|
Line 3645 $ [ff ff] fromVectors :: $ |
|
(it returns 1 else it returns 0.) |
(it returns 1 else it returns 0.) |
$Example: (hoge) boundp ::$ |
$Example: (hoge) boundp ::$ |
]] putUsages |
]] 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 |
|
|
; |
; |
|
|