version 1.1, 2000/06/14 07:44:05 |
version 1.2, 2000/08/01 03:42:35 |
|
|
% $OpenXM$ |
% $OpenXM: OpenXM/src/k097/lib/minimal/new.sm1,v 1.1 2000/06/14 07:44:05 takayama Exp $ |
%% These functions should be moved to complex.sm1 |
%% These functions should be moved to complex.sm1 |
%% homogenize<m>, ord_w<m>, init<m>, ... |
%% homogenize<m>, ord_w<m>, init<m>, ... |
|
|
|
/.toSm1Integer { |
|
/arg1 set |
|
[/in-.toSm1Integer /ans /v] pushVariables |
|
[ |
|
/v arg1 def |
|
/ans v def |
|
v isArray { |
|
v { .toSm1Integer } map /ans set |
|
}{ } ifelse |
|
v isUniversalNumber { |
|
v (integer) dc /ans set |
|
}{ } ifelse |
|
/arg1 ans def |
|
] pop |
|
popVariables |
|
arg1 |
|
} def |
|
/.toUniversalNumber { |
|
/arg1 set |
|
[/in-.toUniversalNumber /ans /v] pushVariables |
|
[ |
|
/v arg1 def |
|
/ans v def |
|
v isArray { |
|
v { .toUniversalNumber } map /ans set |
|
}{ } ifelse |
|
v isInteger { |
|
v (universalNumber) dc /ans set |
|
}{ } ifelse |
|
/arg1 ans def |
|
] pop |
|
popVariables |
|
arg1 |
|
} def |
|
|
|
/ord_w<m> { |
|
/arg3 set /arg2 set /arg1 set |
|
[/in-ord_w<m> /f /weight /shift /www ] pushVariables |
|
[ |
|
/f arg1 def |
|
/weight arg2 def |
|
/shift arg3 def |
|
weight .toSm1Integer /weight set |
|
shift .toSm1Integer /shift set |
|
f isArray { |
|
f { weight ord_w } map /www set |
|
}{ |
|
[f weight ord_w ] /www set |
|
}ifelse |
|
www shift add /arg1 set |
|
] pop |
|
popVariables |
|
arg1 |
|
} def |
|
[(ord_w<m>) |
|
[(f weight shift ord_w<m> w) |
|
(It returns the ord_w with the shift vector shift.) |
|
(Example 1:) |
|
$ [(x) ring_of_differential_operators [[(x) -1 (Dx) 1]] weight_vector 0]$ |
|
$ define_ring $ |
|
$ [(x Dx + 1). (Dx^2+x).] [(x) -1 (Dx) 1] [2 0] ord_w<m> ::$ |
|
]] putUsages |
|
|
|
|
|
/init_w<m> { |
|
/arg3 set /arg2 set /arg1 set |
|
[/in-init_w<m> /f /fv /weight /shift /www |
|
/maxw /i /ans /tmp] pushVariables |
|
[ |
|
/f arg1 def |
|
/weight arg2 def |
|
/shift arg3 def |
|
weight .toSm1Integer /weight set |
|
shift .toSm1Integer /shift set |
|
f isArray { |
|
f { weight ord_w } map /www set |
|
/fv f def |
|
}{ |
|
[f weight ord_w ] /www set |
|
/fv [f] def |
|
}ifelse |
|
www shift add /www set |
|
/maxw www 0 get def |
|
0 1 www length 1 sub { |
|
/i set |
|
www i get maxw gt { |
|
/maxw www i get def |
|
} { } ifelse |
|
} for |
|
/ans [ 0 1 www length 1 sub { pop (0). } for ] def |
|
0 1 www length 1 sub { |
|
/i set |
|
www i get maxw eq { |
|
fv i get weight weightv init /tmp set |
|
ans i tmp put |
|
}{ } ifelse |
|
}for |
|
f isArray { |
|
/arg1 ans def |
|
}{ |
|
/arg1 ans 0 get def |
|
} ifelse |
|
] pop |
|
popVariables |
|
arg1 |
|
} def |
|
[(init_w<m>) |
|
[(f weight shift init_w<m> w) |
|
(It returns the initial with the shift vector shift and the weight) |
|
(Example 1:) |
|
$ [(x) ring_of_differential_operators [[(x) -1 (Dx) 1]] weight_vector 0]$ |
|
$ define_ring $ |
|
$ [(x Dx + 1). (Dx^2+x).] [(x) -1 (Dx) 1] [2 0] init_w<m> ::$ |
|
]] putUsages |