| version 1.28, 2004/05/13 05:33:10 |
version 1.30, 2004/08/23 08:33:55 |
|
|
| % $OpenXM: OpenXM/src/kan96xx/Kan/dr.sm1,v 1.27 2004/04/29 11:20:37 takayama Exp $ |
% $OpenXM: OpenXM/src/kan96xx/Kan/dr.sm1,v 1.29 2004/08/22 12:52:34 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. |
| |
|
|
|
| [/in-ngcd /nlist /g.ngcd /ans] pushVariables |
[/in-ngcd /nlist /g.ngcd /ans] pushVariables |
| [ |
[ |
| /nlist arg1 def |
/nlist arg1 def |
| |
nlist to_univNum /nlist set |
| nlist length 2 lt |
nlist length 2 lt |
| { /ans nlist 0 get def /L.ngcd goto } |
{ /ans nlist 0 get def /L.ngcd goto } |
| { |
{ |
| Line 3854 $ [ff ff] fromVectors :: $ |
|
| Line 3855 $ [ff ff] fromVectors :: $ |
|
| popVariables |
popVariables |
| arg1 |
arg1 |
| } def |
} def |
| |
|
| |
/to_univNum { |
| |
/arg1 set |
| |
[/rr ] pushVariables |
| |
[ |
| |
/rr arg1 def |
| |
rr isArray { |
| |
rr { to_univNum } map /rr set |
| |
} { |
| |
} ifelse |
| |
rr isInteger { |
| |
rr (universalNumber) dc /rr set |
| |
} { |
| |
} ifelse |
| |
/arg1 rr def |
| |
] pop |
| |
popVariables |
| |
arg1 |
| |
} def |
| |
[(to_univNum) |
| |
[(obj to_univNum obj2) |
| |
(Example. [ 2 (3).. ] to_univNum) |
| |
(cf. to_int) |
| |
]] putUsages |
| |
|
| |
[(lcm) |
| |
[ ([a b c ...] lcm r) |
| |
(cf. polylcm, mpzext) |
| |
] |
| |
] putUsages |
| |
/lcm { |
| |
/arg1 set |
| |
[/aa /bb /rr /pp /i] pushVariables |
| |
[ |
| |
/aa arg1 def |
| |
/rr (1).. def |
| |
/pp 0 def % isPolynomial array? |
| |
0 1 aa length 1 sub { |
| |
/i set |
| |
aa i get isPolynomial { |
| |
/pp 1 def |
| |
exit |
| |
} { } ifelse |
| |
} for |
| |
|
| |
0 1 aa length 1 sub { |
| |
/i set |
| |
pp { |
| |
[rr aa i get] polylcm /rr set |
| |
} { |
| |
[(lcm) rr aa i get ] mpzext /rr set |
| |
} ifelse |
| |
} for |
| |
|
| |
/arg1 rr def |
| |
] pop |
| |
popVariables |
| |
arg1 |
| |
} def |
| |
[(gcd) |
| |
[ ([a b c ...] gcd r) |
| |
(cf. polygcd, mpzext) |
| |
] |
| |
] putUsages |
| |
/gcd { |
| |
/arg1 set |
| |
[/aa /bb /rr /pp /i] pushVariables |
| |
[ |
| |
/aa arg1 def |
| |
/rr (1).. def |
| |
/pp 0 def % isPolynomial array? |
| |
0 1 aa length 1 sub { |
| |
/i set |
| |
aa i get isPolynomial { |
| |
/pp 1 def |
| |
/rr aa i get def |
| |
exit |
| |
} { } ifelse |
| |
} for |
| |
|
| |
pp { |
| |
0 1 aa length 1 sub { |
| |
/i set |
| |
[rr aa i get] polygcd /rr set |
| |
} for |
| |
} { |
| |
aa ngcd /rr set |
| |
} ifelse |
| |
|
| |
/arg1 rr def |
| |
] pop |
| |
popVariables |
| |
arg1 |
| |
} def |
| |
|
| |
[(denominator) |
| |
[ ([a b c ...] denominator r) |
| |
( a denominator r ) |
| |
(cf. dc, numerator) |
| |
(Output is Z or a polynomial.) |
| |
] |
| |
] putUsages |
| |
% test data. |
| |
% [(1).. (2).. div (1).. (3).. div ] denominator |
| |
% [(2).. (3).. (4).. ] denominator |
| |
/denominator { |
| |
/arg1 set |
| |
[/pp /dd /ii /rr] pushVariables |
| |
[ |
| |
/pp arg1 def |
| |
pp to_univNum /pp set |
| |
{ |
| |
pp isArray { |
| |
pp { denominator } map /dd set |
| |
/rr dd lcm def % rr = lcm(dd[0], dd[1], ... ) |
| |
rr /dd set |
| |
exit |
| |
} { } ifelse |
| |
|
| |
pp (denominator) dc /dd set |
| |
exit |
| |
|
| |
} loop |
| |
/arg1 dd def |
| |
] pop |
| |
popVariables |
| |
arg1 |
| |
} def |
| |
|
| |
[(numerator) |
| |
[ ([a b c ...] numerator r) |
| |
( a numerator r ) |
| |
(cf. dc, denominator) |
| |
(Output is a list of Z or polynomials.) |
| |
] |
| |
] putUsages |
| |
% test data. |
| |
/numerator { |
| |
/arg1 set |
| |
[/pp /dd /ii /rr] pushVariables |
| |
[ |
| |
/pp arg1 def |
| |
pp to_univNum /pp set |
| |
{ |
| |
pp isArray { |
| |
pp denominator /dd set |
| |
pp dd mul /rr set |
| |
rr cancel /rr set |
| |
exit |
| |
} { } ifelse |
| |
|
| |
pp (numerator) dc /rr set |
| |
exit |
| |
|
| |
} loop |
| |
/arg1 rr def |
| |
] pop |
| |
popVariables |
| |
arg1 |
| |
} def |
| |
|
| |
/cancel.Q { |
| |
/arg1 set |
| |
[/aa /rr /nn /dd /gg] pushVariables |
| |
[ |
| |
/aa arg1 def |
| |
{ |
| |
aa isRational { |
| |
[(cancel) aa] mpzext /rr set |
| |
rr (denominator) dc (1).. eq { |
| |
/rr rr (numerator) dc def |
| |
exit |
| |
} { } ifelse |
| |
rr (denominator) dc (-1).. eq { |
| |
/rr rr (numerator) dc (-1).. mul def |
| |
} { } ifelse |
| |
exit |
| |
} { } ifelse |
| |
|
| |
/rr aa def |
| |
exit |
| |
} loop |
| |
/arg1 rr def |
| |
] pop |
| |
popVariables |
| |
arg1 |
| |
} def |
| |
|
| |
/cancel.one { |
| |
/arg1 set |
| |
[/aa /rr /nn /dd /gg] pushVariables |
| |
[ |
| |
/aa arg1 def |
| |
{ |
| |
aa isRational { |
| |
aa (numerator) dc /nn set |
| |
aa (denominator) dc /dd set |
| |
nn isUniversalNumber dd isUniversalNumber and { |
| |
/rr aa cancel.Q def |
| |
exit |
| |
} { (cancel: not implemented) error } ifelse |
| |
} { } ifelse |
| |
|
| |
/rr aa def |
| |
exit |
| |
} loop |
| |
/arg1 rr def |
| |
] pop |
| |
popVariables |
| |
arg1 |
| |
} def |
| |
|
| |
[(cancel) |
| |
[ (obj cancel r) |
| |
(Cancel numerators and denominators) |
| |
(The implementation has not yet been completed. It works only for Q.) |
| |
]] putUsages |
| |
/cancel { |
| |
/arg1 set |
| |
[/aa /rr] pushVariables |
| |
[ |
| |
/aa arg1 def |
| |
aa isArray { |
| |
aa {cancel} map /rr set |
| |
} { |
| |
aa cancel.one /rr set |
| |
} ifelse |
| |
/arg1 rr def |
| |
] pop |
| |
popVariables |
| |
arg1 |
| |
} def |
| |
|
| |
/nnormalize_vec { |
| |
/arg1 set |
| |
[/pp /rr /dd ] pushVariables |
| |
[ |
| |
/pp arg1 def |
| |
pp denominator /dd set |
| |
dd (0).. lt { (nnormalize_vec: internal error) error } { } ifelse |
| |
pp numerator dd mul cancel /pp set |
| |
/@@@.nnormalize_vec_c dd def |
| |
pp gcd /dd set |
| |
dd (0).. lt { (nnormalize_vec: internal error) error } { } ifelse |
| |
pp (1).. dd div mul cancel /rr set |
| |
@@@.nnormalize_vec_c dd div cancel /@@@.nnormalize_vec_c set |
| |
/arg1 rr def |
| |
] pop |
| |
popVariables |
| |
arg1 |
| |
} def |
| |
[(nnormalize_vec) |
| |
[(pp nnormalize_vec npp) |
| |
(It normalizes a given vector of Q into a vector of Z with relatively prime) |
| |
(entries by multiplying a postive number.) |
| |
]] putUsages |
| |
|
| /usages { |
/usages { |
| /arg1 set |
/arg1 set |