[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.22 and 1.34

version 1.22, 2003/08/26 12:46:04 version 1.34, 2004/09/01 05:06:09
Line 1 
Line 1 
 % $OpenXM: OpenXM/src/kan96xx/Kan/dr.sm1,v 1.21 2003/08/24 05:25:58 takayama Exp $  % $OpenXM: OpenXM/src/kan96xx/Kan/dr.sm1,v 1.33 2004/08/31 05:30:20 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 50 
Line 50 
           } for            } for
      ] /dList set       ] /dList set
   
      [(H)] xList join [@@@.esymbol] join /xList set       [@@@.Hsymbol] xList join [@@@.esymbol] join /xList set
      [(h)] dList join [@@@.Esymbol] join /dList set       [(h)] dList join [@@@.Esymbol] join /dList set
      [0 %% dummy characteristic       [0 %% dummy characteristic
       << xList length >> << xList length >> << xList length >>        << xList length >> << xList length >> << xList length >>
Line 167 
Line 167 
      vars reverse /xList set         %[z y x]       vars reverse /xList set         %[z y x]
      vars {@@@.Dsymbol 2 1 roll 2 cat_n} map       vars {@@@.Dsymbol 2 1 roll 2 cat_n} map
      reverse /dList set              %[Dz Dy Dx]       reverse /dList set              %[Dz Dy Dx]
      [(H)] xList join [@@@.esymbol] join /xList set       [@@@.Hsymbol] xList join [@@@.esymbol] join /xList set
      [(h)] dList join [@@@.Esymbol] join /dList set       [(h)] dList join [@@@.Esymbol] join /dList set
      [0 1 1 1 << xList length >>       [0 1 1 1 << xList length >>
         1 1 1 << xList length 1 sub >> ] /param set          1 1 1 << xList length 1 sub >> ] /param set
Line 269 
Line 269 
      vars reverse /xList set         %[z y x]       vars reverse /xList set         %[z y x]
      vars {@@@.diffEsymbol 2 1 roll 2 cat_n} map       vars {@@@.diffEsymbol 2 1 roll 2 cat_n} map
      reverse /dList set              %[Dz Dy Dx]       reverse /dList set              %[Dz Dy Dx]
      [(H)] xList join [@@@.esymbol] join /xList set       [@@@.Hsymbol] xList join [@@@.esymbol] join /xList set
      [(h)] dList join [@@@.Esymbol] join /dList set       [(h)] dList join [@@@.Esymbol] join /dList set
      [0 1 1 << xList length >> << xList length >>       [0 1 1 << xList length >> << xList length >>
         1 1 << xList length 1 sub >> << xList length >> ] /param set          1 1 << xList length 1 sub >> << xList length >> ] /param set
Line 308 
Line 308 
      vars2 reverse       vars2 reverse
      vars {@@@.Dsymbol 2 1 roll 2 cat_n} map       vars {@@@.Dsymbol 2 1 roll 2 cat_n} map
      reverse join /dList set              %[s2 s1 Dz Dy Dx]       reverse join /dList set              %[s2 s1 Dz Dy Dx]
      [(H)] xList join [@@@.esymbol] join /xList set       [@@@.Hsymbol] xList join [@@@.esymbol] join /xList set
      [(h)] dList join [@@@.Esymbol] join /dList set       [(h)] dList join [@@@.Esymbol] join /dList set
      [0 1 1 << vars2 length 1 add >>  << xList length >>       [0 1 1 << vars2 length 1 add >>  << xList length >>
         1 1 << vars2 length 1 add >> << xList length 1 sub >> ] /param set          1 1 << vars2 length 1 add >> << xList length 1 sub >> ] /param set
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 1766 
Line 1772 
   /arg1 set    /arg1 set
   [/f /k /i /ans] pushVariables    [/f /k /i /ans] pushVariables
   [    [
      /ans (1).. def     /ans (1).. def
      [(QuoteMode)] system_variable {
        /f arg1 def   /k arg2 def
        [(ooPower) f k] extension /ans set
      } {
      /f arg1 def   /k arg2 ..int def       /f arg1 def   /k arg2 ..int def
      k 0 lt {       k 0 lt {
        1 1 << 0 k sub >> {         1 1 << 0 k sub >> {
Line 1779 
Line 1789 
          /ans f ans {mul} sendmsg2 def           /ans f ans {mul} sendmsg2 def
        } for         } for
      } ifelse       } ifelse
      /arg1 ans def     } ifelse
      /arg1 ans def
   ] pop    ] pop
   popVariables    popVariables
   arg1    arg1
Line 2517  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 2548  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 2762  newline
Line 2775  newline
   [/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 3651  $ [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 3753  $ [ff ff] fromVectors :: $ 
Line 3795  $ [ff ff] fromVectors :: $ 
  ]   ]
 ] putUsages  ] putUsages
   
   /ecart.debug_reduction1 0 def
 /beginEcart {  /beginEcart {
   (red@) (ecart) switch_function    (red@) (ecart) switch_function
   [(Ecart) 1] system_variable    [(Ecart) 1] system_variable
Line 3760  $ [ff ff] fromVectors :: $ 
Line 3803  $ [ff ff] fromVectors :: $ 
   [(ReduceLowerTerms) 0] system_variable    [(ReduceLowerTerms) 0] system_variable
   [(AutoReduce) 0] system_variable    [(AutoReduce) 0] system_variable
   [(EcartAutomaticHomogenization) 0] system_variable    [(EcartAutomaticHomogenization) 0] system_variable
     ecart.debug_reduction1 {
       (red@) (debug) switch_function
     } {  } ifelse
 } def  } def
   
 [(endEcart)  [(endEcart)
Line 3824  $ [ff ff] fromVectors :: $ 
Line 3870  $ [ff ff] fromVectors :: $ 
   arg1    arg1
 } def  } def
   
   /addStdoutStderr {
     [(>) (stringOut://@@@stdout) (2>) (stringOut://@@@stderr)] join
   } def
   
   [(,,,)
   [(reparse a polynomial or polynomials)]
   ] putUsages
   /,,, {
     /arg1 set
     [/in-reparse /ff] pushVariables
     [
       /ff arg1 def
       ff tag 6 eq {
         ff { ,,, } map /arg1 set
       } {
         ff toString . /arg1 set
       } ifelse
     ] pop
     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_int32. (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
     [/name /flag /n /k /slist /m /i /sss] pushVariables
     [
       /name arg1 def
       /flag true def
   
    %BUG: should use regular expression in a future.
    name tag 1 eq {
      @.usages { 0 get } map shell { (, ) nl } map /sss set
    } {
   
       /sss [ ] def
      @.usages length /n set
      0 1 << n 1 sub >>
      {
         /k set
         name << @.usages k get 0 get >> eq
         {
           /slist @.usages k get 1 get def
           /m slist length def
           0 1 << m 1 sub >> {
             /i set
             sss slist i get append nl append /sss set
           } for
           /flag false def
         }
         { }
         ifelse
      } for
   
      %BUG:  cannot get usages of primitives.
      flag
      {name Usage  /sss [(Usage of ) name ( could not obtained.) nl ] def}
      { }
      ifelse
    } ifelse
      /arg1 sss cat def
      ] pop
      popVariables
      arg1
   } def
   [(usages)
    [(key usages usages-as-a-string)
     (num usages list-of-key-words)
   ]] putUsages
   
 ;  ;
   
Legend:
Removed from v.1.22  
changed lines
  Added in v.1.34
FreeBSD-CVSweb <freebsd-cvsweb@FreeBSD.org>