[BACK]Return to dr.sm1 CVS log [TXT][DIR] Up to [local] / OpenXM / src / kan96xx / Kan

Diff for /OpenXM/src/kan96xx/Kan/dr.sm1 between version 1.29 and 1.36

version 1.29, 2004/08/22 12:52:34 version 1.36, 2004/09/09 11:42:22
Line 1 
Line 1 
 % $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.35 2004/09/09 03:14:46 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.
   
Line 361 
Line 361 
   [    [
     /mat arg1 def      /mat arg1 def
     /m mat length def      /m mat length def
     {
       m 0 eq { /ans [ ] def exit } { } ifelse
     mat 0 get isArray      mat 0 get isArray
     {   }      {   }
     { (transpose: Argument must be an array of arrays.) error }      { (transpose: Argument must be an array of arrays.) error }
Line 374 
Line 376 
          ans [ j i ]  <<  mat i get j get >> put           ans [ j i ]  <<  mat i get j get >> put
       } for        } for
     } for      } for
       exit
      } loop
    /arg1 ans def     /arg1 ans def
   ] pop    ] pop
   popVariables    popVariables
Line 1328 
Line 1332 
     /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_int32 /w-vectors set
     [      [
     0 1 << w-vectors length 1 sub >>      0 1 << w-vectors length 1 sub >>
     {      {
Line 1350 
Line 1355 
   /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_int32 /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 >>
     {      {
Line 1923  newline
Line 1929  newline
 } def  } def
 %%end of function  %%end of function
   
 /rest { % returns remainder of a given list  /rest {
   [ 2 1 roll  aload length -1 roll pop ]    /arg1 set [(Krest) arg1] extension
 } def  } def
 [(rest)  [(rest)
  [(array rest the-rest-of-the-array)   [(array rest the-rest-of-the-array)
Line 2522  newline
Line 2528  newline
   [    [
     /fff arg1 def      /fff arg1 def
     /www arg2 def      /www arg2 def
       www to_int32 /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
Line 2553  newline
Line 2560  newline
   [    [
     /fff arg1 def      /fff arg1 def
     /www arg2 def      /www arg2 def
       www to_int32 /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 3657  $ [ff ff] fromVectors :: $ 
Line 3665  $ [ff ff] fromVectors :: $ 
  (         ff to_int { tag } map :: )   (         ff to_int { tag } map :: )
 ]] putUsages  ]] putUsages
   
   /to_int32 {
     /arg1 set
     [/to-int32 /ob /ans] pushVariables
     [
       /ob arg1 def
       /ans ob def
       ob isArray {
         ob {to_int32} map /ans set
         /LLL.to_int32 goto
       } {  } ifelse
       ob isUniversalNumber {
         ob (integer) dc /ans set
         /LLL.to_int32 goto
       } {  } ifelse
       /LLL.to_int32
       /arg1 ans def
     ] pop
     popVariables
     arg1
   } def
   [(to_int32)
   [(obj to_int32 obj2)
    $All universalNumber in obj are changed to integer (int32).$
    (Example: /ff [1 (2).. [(hello) (0).]] def  ff { tag } map ::)
    (         ff to_int32 { tag } map :: )
    (cf. to_int, to_univNum )
   ]] putUsages
   
 /define_ring_variables {  /define_ring_variables {
   [/in-define_ring_variables /drv._v /drv._p /drv._v0] pushVariables    [/in-define_ring_variables /drv._v /drv._p /drv._v0] pushVariables
 %% You cannot use these names for names for polynomials.  %% You cannot use these names for names for polynomials.
Line 3877  $ [ff ff] fromVectors :: $ 
Line 3913  $ [ff ff] fromVectors :: $ 
 [(to_univNum)  [(to_univNum)
 [(obj to_univNum obj2)  [(obj to_univNum obj2)
  (Example. [ 2 (3).. ] to_univNum)   (Example. [ 2 (3).. ] to_univNum)
  (cf. to_int)   $cf. to_int32. (to_int)$
 ]] putUsages  ]] putUsages
   
 [(lcm)  [(lcm)
Line 3954  $ [ff ff] fromVectors :: $ 
Line 3990  $ [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 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 } map /dd set          pp { denominator } map /dd set
Line 3986  $ [ff ff] fromVectors :: $ 
Line 4024  $ [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 4033  $ [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 4052  $ [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 4079  $ [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 4089  $ [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 4103  $ [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
   
   /cons {
     /arg2 set /arg1 set
     [/aa /bb] pushVariables
     [
       /aa arg1 def /bb arg2 def
       [aa] (list) dc bb join /arg1 set
     ] pop
     popVariables
     arg1
   } def
   [(cons)
   [(obj list cons list)
   ]] putUsages
   
 /usages {  /usages {
   /arg1 set    /arg1 set
Legend:
Removed from v.1.29  
changed lines
  Added in v.1.36
FreeBSD-CVSweb <freebsd-cvsweb@FreeBSD.org>