===================================================================
RCS file: /home/cvs/OpenXM/src/kan96xx/Kan/dr.sm1,v
retrieving revision 1.28
retrieving revision 1.31
diff -u -p -r1.28 -r1.31
--- OpenXM/src/kan96xx/Kan/dr.sm1	2004/05/13 05:33:10	1.28
+++ OpenXM/src/kan96xx/Kan/dr.sm1	2004/08/27 08:33:27	1.31
@@ -1,4 +1,4 @@
-% $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.30 2004/08/23 08:33:55 takayama Exp $
 %% dr.sm1 (Define Ring) 1994/9/25, 26
 %% This file is error clean.
 
@@ -2767,6 +2767,7 @@ newline
   [/in-ngcd /nlist /g.ngcd /ans] pushVariables
   [
      /nlist arg1 def
+     nlist to_univNum /nlist set
      nlist length 2 lt
      { /ans nlist 0 get def /L.ngcd goto }
      {
@@ -3854,6 +3855,304 @@ $ [ff ff] fromVectors :: $ 
   popVariables
   arg1
 } 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
+
+/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 {
   /arg1 set