version 1.29, 2004/08/22 12:52:34 |
version 1.32, 2004/08/31 04:45:42 |
|
|
% $OpenXM: OpenXM/src/kan96xx/Kan/dr.sm1,v 1.28 2004/05/13 05:33:10 takayama Exp $ |
% $OpenXM: OpenXM/src/kan96xx/Kan/dr.sm1,v 1.31 2004/08/27 08:33:27 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. |
|
|
|
|
/univ vars 0 get reverse |
/univ vars 0 get reverse |
vars 1 get reverse join |
vars 1 get reverse join |
def |
def |
|
w-vectors to_int /w-vectors set |
[ |
[ |
0 1 << w-vectors length 1 sub >> |
0 1 << w-vectors length 1 sub >> |
{ |
{ |
|
|
/arg2 set /arg1 set |
/arg2 set /arg1 set |
[/univ /www /k /vname /vweight /ans] pushVariables |
[/univ /www /k /vname /vweight /ans] pushVariables |
/univ arg1 def /www arg2 def |
/univ arg1 def /www arg2 def |
[ |
[ |
|
www to_int /www set |
/ans << univ length >> -1 0 evecw def |
/ans << univ length >> -1 0 evecw def |
0 2 << www length 2 sub >> |
0 2 << www length 2 sub >> |
{ |
{ |
|
|
[ |
[ |
/fff arg1 def |
/fff arg1 def |
/www arg2 def |
/www arg2 def |
|
www to_int /www set |
fff (0). eq { /ddd -intInfinity def /ord_w.LLL goto} { } ifelse |
fff (0). eq { /ddd -intInfinity def /ord_w.LLL goto} { } ifelse |
fff (ring) dc /rrr set |
fff (ring) dc /rrr set |
fff init /fff set |
fff init /fff set |
|
|
[ |
[ |
/fff arg1 def |
/fff arg1 def |
/www arg2 def |
/www arg2 def |
|
www to_int /www set |
fff (0). eq { /ddd -intInfinity def /ord_w_all.LLL goto} { } ifelse |
fff (0). eq { /ddd -intInfinity def /ord_w_all.LLL goto} { } ifelse |
/ddd -intInfinity def |
/ddd -intInfinity def |
fff (ring) dc /rrr set |
fff (ring) dc /rrr set |
Line 3954 $ [ff ff] fromVectors :: $ |
|
Line 3958 $ [ff ff] fromVectors :: $ |
|
[ ([a b c ...] denominator r) |
[ ([a b c ...] denominator r) |
( a denominator r ) |
( a denominator r ) |
(cf. dc, numerator) |
(cf. dc, numerator) |
|
(Output is Z or a polynomial.) |
] |
] |
] putUsages |
] putUsages |
% test data. |
% test data. |
Line 3964 $ [ff ff] fromVectors :: $ |
|
Line 3969 $ [ff ff] fromVectors :: $ |
|
[/pp /dd /ii /rr] pushVariables |
[/pp /dd /ii /rr] pushVariables |
[ |
[ |
/pp arg1 def |
/pp arg1 def |
|
pp to_univNum /pp set |
{ |
{ |
pp isArray { |
pp isArray { |
pp { denominator } map /dd set |
pp { denominator } map /dd set |
Line 3986 $ [ff ff] fromVectors :: $ |
|
Line 3992 $ [ff ff] fromVectors :: $ |
|
[ ([a b c ...] numerator r) |
[ ([a b c ...] numerator r) |
( a numerator r ) |
( a numerator r ) |
(cf. dc, denominator) |
(cf. dc, denominator) |
|
(Output is a list of Z or polynomials.) |
] |
] |
] putUsages |
] putUsages |
% test data. |
% test data. |
Line 3994 $ [ff ff] fromVectors :: $ |
|
Line 4001 $ [ff ff] fromVectors :: $ |
|
[/pp /dd /ii /rr] pushVariables |
[/pp /dd /ii /rr] pushVariables |
[ |
[ |
/pp arg1 def |
/pp arg1 def |
|
pp to_univNum /pp set |
{ |
{ |
pp isArray { |
pp isArray { |
pp denominator /dd set |
pp denominator /dd set |
pp dd mul /rr set |
pp dd mul /rr set |
rr reduce /rr set |
rr cancel /rr set |
exit |
exit |
} { } ifelse |
} { } ifelse |
|
|
Line 4012 $ [ff ff] fromVectors :: $ |
|
Line 4020 $ [ff ff] fromVectors :: $ |
|
arg1 |
arg1 |
} def |
} def |
|
|
/reduce.Q { |
/cancel.Q { |
/arg1 set |
/arg1 set |
[/aa /rr /nn /dd /gg] pushVariables |
[/aa /rr /nn /dd /gg] pushVariables |
[ |
[ |
Line 4039 $ [ff ff] fromVectors :: $ |
|
Line 4047 $ [ff ff] fromVectors :: $ |
|
arg1 |
arg1 |
} def |
} def |
|
|
/reduce.one { |
/cancel.one { |
/arg1 set |
/arg1 set |
[/aa /rr /nn /dd /gg] pushVariables |
[/aa /rr /nn /dd /gg] pushVariables |
[ |
[ |
Line 4049 $ [ff ff] fromVectors :: $ |
|
Line 4057 $ [ff ff] fromVectors :: $ |
|
aa (numerator) dc /nn set |
aa (numerator) dc /nn set |
aa (denominator) dc /dd set |
aa (denominator) dc /dd set |
nn isUniversalNumber dd isUniversalNumber and { |
nn isUniversalNumber dd isUniversalNumber and { |
/rr aa reduce.Q def |
/rr aa cancel.Q def |
exit |
exit |
} { (reduce: not implemented) error } ifelse |
} { (cancel: not implemented) error } ifelse |
} { } ifelse |
} { } ifelse |
|
|
/rr aa def |
/rr aa def |
Line 4063 $ [ff ff] fromVectors :: $ |
|
Line 4071 $ [ff ff] fromVectors :: $ |
|
arg1 |
arg1 |
} def |
} def |
|
|
[(reduce) |
[(cancel) |
[ (obj reduce r) |
[ (obj cancel r) |
(Cancel numerators and denominators) |
(Cancel numerators and denominators) |
(The implementation has not yet been completed. It works only for Q.) |
(The implementation has not yet been completed. It works only for Q.) |
]] putUsages |
]] putUsages |
/reduce { |
/cancel { |
/arg1 set |
/arg1 set |
[/aa /rr] pushVariables |
[/aa /rr] pushVariables |
[ |
[ |
/aa arg1 def |
/aa arg1 def |
aa isArray { |
aa isArray { |
aa {reduce} map /rr set |
aa {cancel} map /rr set |
} { |
} { |
aa reduce.one /rr set |
aa cancel.one /rr set |
} ifelse |
} ifelse |
/arg1 rr def |
/arg1 rr def |
] pop |
] pop |
popVariables |
popVariables |
arg1 |
arg1 |
} def |
} 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 |
|
|
|
/getNode { |
|
/arg2 set |
|
/arg1 set |
|
[/in-getNode /ob /key /rr /rr /ii] pushVariables |
|
[ |
|
/ob arg1 def |
|
/key arg2 def |
|
/rr null def |
|
{ |
|
ob isClass { |
|
ob (array) dc /ob set |
|
} { exit } ifelse |
|
ob 0 get key eq { |
|
/rr ob def |
|
exit |
|
} { } ifelse |
|
ob 2 get /ob set |
|
0 1 ob length 1 sub { |
|
/ii set |
|
ob ii get key getNode /rr set |
|
rr tag 0 eq { } { exit } ifelse |
|
} for |
|
exit |
|
} loop |
|
/arg1 rr def |
|
] pop |
|
popVariables |
|
arg1 |
|
} def |
|
[(getNode) |
|
[(ob key getNode) |
|
(ob is a class object.) |
|
(The operator getNode returns the node with the key in ob.) |
|
(The node is an array of the format [key attr-list node-list]) |
|
(Example:) |
|
( /dog [(dog) [[(legs) 4] ] [ ]] [(class) (tree)] dc def) |
|
( /man [(man) [[(legs) 2] ] [ ]] [(class) (tree)] dc def) |
|
( /ma [(mammal) [ ] [man dog]] [(class) (tree)] dc def) |
|
( ma (dog) getNode ) |
|
]] putUsages |
|
|
|
|
/usages { |
/usages { |
/arg1 set |
/arg1 set |