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

Diff for /OpenXM/src/kan96xx/Doc/gfan.sm1 between version 1.2 and 1.3

version 1.2, 2004/09/09 08:50:12 version 1.3, 2004/09/14 08:30:47
Line 1 
Line 1 
 %  $OpenXM: OpenXM/src/kan96xx/Doc/gfan.sm1,v 1.1 2004/09/05 10:19:29 takayama Exp $  %  $OpenXM: OpenXM/src/kan96xx/Doc/gfan.sm1,v 1.2 2004/09/09 08:50:12 takayama Exp $
 % cp cone.sm1 $OpenXM_HOME/src/kan96xx/Doc/gfan.sm1  % cp cone.sm1 $OpenXM_HOME/src/kan96xx/Doc/gfan.sm1
 % $Id$  % $Id$
 % iso-2022-jp  % iso-2022-jp
Line 10 
Line 10 
  [(parse) (ox.sm1) pushfile] extension   [(parse) (ox.sm1) pushfile] extension
 } ifelse  } ifelse
   
   %
   % cone.fan, cone.gblist $B$K(B fan $B$N%G!<%?$,$O$$$k(B.
   %
   
 %%%%<<<<  $B=i4|%G!<%?$N@_DjNc(B  data/test13 $B$h$j(B.  <<<<<<<<<<<<<<  %%%%<<<<  $B=i4|%G!<%?$N@_DjNc(B  data/test13 $B$h$j(B.  <<<<<<<<<<<<<<
 /cone.sample.test13 {  /cone.sample.test13 {
  /cone.loaded boundp { }   /cone.loaded boundp { }
Line 164  cone.comment message
Line 168  cone.comment message
     ww to_int32 /ww set % univNum $B$,$"$l$P(B int32 $B$KD>$7$F$*$/(B.      ww to_int32 /ww set % univNum $B$,$"$l$P(B int32 $B$KD>$7$F$*$/(B.
     /ww2 ww weightv def  % v-w $B7A<0$r(B $B?t;z$N%Y%/%H%k$K(B. (init $BMQ(B)      /ww2 ww weightv def  % v-w $B7A<0$r(B $B?t;z$N%Y%/%H%k$K(B. (init $BMQ(B)
   
     /eqs [ ] def % $BITEy<07O$N78?t(B      /eqs null def % $BITEy<07O$N78?t(B
     /gsize g length def      /gsize g length def
     0 1 gsize 1 sub {      0 1 gsize 1 sub {
       /i set        /i set
Line 177  cone.comment message
Line 181  cone.comment message
         % in_ww(f) > f_j $B$H$J$k9`$N=hM}(B.          % in_ww(f) > f_j $B$H$J$k9`$N=hM}(B.
         iterms 1 exps length 1 sub {          iterms 1 exps length 1 sub {
            /j set             /j set
            eqs [expsTop exps j get  sub] join /eqs set             expsTop exps j get sub    eqs cons /eqs set
            % exps[0]-exps[j] $B$r(B eqs $B$X3JG<$7$F$$$/(B.             % exps[0]-exps[j] $B$r(B eqs $B$X3JG<$7$F$$$/(B.
         } for          } for
         % in_ww(f) = f_j $B$H$J$k9`$N=hM}(B.          % in_ww(f) = f_j $B$H$J$k9`$N=hM}(B.
         [(exponents) f ww2 init cone.type] gbext /exps set % exps $B$O(B in(f)          [(exponents) f ww2 init cone.type] gbext /exps set % exps $B$O(B in(f)
         1 1 iterms 1 sub {          1 1 iterms 1 sub {
           /j set            /j set
           eqs [exps j get expsTop sub] join /eqs set            exps j get expsTop sub   eqs cons /eqs set
           eqs [expsTop exps j get sub] join /eqs set            expsTop exps j get sub   eqs cons /eqs set
           % exps[j]-exps[0], exps[0]-exps[j] $B$r3JG<(B.            % exps[j]-exps[0], exps[0]-exps[j] $B$r3JG<(B.
           % $B7k2LE*$K(B (exps[j]-exps[0]).w = 0 $B$H$J$k(B.            % $B7k2LE*$K(B (exps[j]-exps[0]).w = 0 $B$H$J$k(B.
         }  for          }  for
       } { } ifelse        } { } ifelse
     } for      } for
       eqs listToArray reverse /eqs set
     /arg1 eqs def      /arg1 eqs def
   ] pop    ] pop
   popVariables    popVariables
Line 2323  def   
Line 2328  def   
       (cone.incidence)        (cone.incidence)
   
     ] { inputForm.value  nl } map /rr set      ] { inputForm.value  nl } map /rr set
     rr cat /arg1 set      rr cat /rr set
   % ring $B$r(B save $B$7$F$J$$$N$GEv:B$NBP=h(B.
       [ ([) cone.vv inputForm ( ring_of_differential_operators 0 ] define_ring )
         nl nl rr] cat /arg1 set
   ] pop    ] pop
   popVariables    popVariables
   arg1    arg1
Line 2412  def   
Line 2420  def   
   popVariables    popVariables
   arg1    arg1
 } def  } def
   
   %<
   % Usages: [vlist vw_vector] getGrRing [vlist vGlobal sublist]
   %      example:  [(x,y,z) [(x) -1 (Dx) 1 (y) 1 (Dy) 2]] getGrRing
   %                [(x,y,z,y') [(x)] [[(Dy) (y')]]]
   %  h[0,1](D_0) $B@lMQ$N(B getGrRing.
   %     u_i + v_i > 0 $B$J$i(B  Dx_i ==> x_i' ($B2D49$JJQ?t(B). sublist $B$X(B.
   %     u_i < 0 $B$J$i(B x_i $B$O(B vGlobal $B$X(B.
   %  ii [vlist vGlobal sublist] toGrRing /ii set
   %  [ii jj vlist [(partialEcartGlobalVarX) vGlobal]] ecart.isSameIdeal $B$H;H$&(B.
   %>
   /getGrRing {
     /arg1 set
     [/vlist /vw_vector /ans /vGlobal /sublist /newvlist
      /dlist /tt /i /u /v /k
      ] pushVariables
     [
       /vlist arg1 0 get def
       /vw_vector arg1 1 get def
   
       vlist isString { [vlist to_records pop] /vlist set } { } ifelse
       vlist { toString } map /vlist set
   % dlist $B$O(B [(Dx) (Dy) (Dz)] $B$N%j%9%H(B.
       vlist { /tt set [@@@.Dsymbol tt] cat } map /dlist set
   
       /newvlist [ ] def /sublist [ ] def /vGlobal [ ] def
   % $B2D49$J?7$7$$JQ?t$r(B newvlist $B$X(B. $BCV49I=$r(B sublist $B$X(B.
       0 1 vlist length 1 sub {
         /i set
   %  (u,v) $B$O(B (x_i, Dx_i) $B$KBP$9$k(B weight vector
         /u vlist i get , vw_vector getGrRing.find  def
         u -1 gt {
           vw_vector , u 1 add , get /u set
         }  { /u 0 def } ifelse
   
         /v dlist i get , vw_vector getGrRing.find  def
         v -1 gt {
           vw_vector , v 1 add , get /v set
         }  { /v 0 def } ifelse
         u to_int32 /u set , v to_int32 /v set
   
         u v add , 0  gt {
           newvlist [vlist i get]  join /newvlist set
         } {  } ifelse
         u 0 lt {
           vGlobal [vlist i get] join /vGlobal set
         } {  } ifelse
       } for
   
       newvlist { /tt set [ [@@@.Dsymbol tt] cat [tt (')] cat ] } map
       /sublist set
   
       /ans [ vlist , newvlist { /tt set [tt (')] cat } map , join  from_records
              vGlobal sublist] def
       /arg1 ans def
     ] pop
     popVariables
     arg1
   } def
   
   %<
   % Usages: a uset getGrRing.find index
   %>
   /getGrRing.find {
      /arg2 set /arg1 set
      [/a /uset /ans /i]  pushVariables
      [
        /a arg1 def /uset arg2 def
        /ans -1 def
        { /ans -1 def
          0 1 , uset length 1 sub {
            /i set
            a tag , uset i get tag eq {
              a , uset i get eq {
                /ans i def  exit
              } { } ifelse
            } { } ifelse
          } for
          exit
        } loop
        /arg1 ans def
      ] pop
      popVariables
      arg1
   } def
   
   %<
   % Usages: g1 g2 isSameGrRing bool
   %  g1, g2 $B$O(B getGrRing $B$NLa$jCM(B.
   %>
   /isSameGrRing {
     /arg2 set /arg1 set
     [/g1 /g2 /ans] pushVariables
     [
       /g1 arg1 def /g2 arg2 def
       {
          /ans 1 def
          g1 0 get , g2 0 get eq { } { /ans 0 def exit } ifelse
          exit
          g1 1 get , g2 1 get eq { } { /ans 0 def exit } ifelse
       } loop
       /arg1 ans def
     ] pop
     popVariables
     arg1
   } def
   
   %<
   % Usages:  [[ii i_vw_vector] [jj j_vw_vector] vlist] isSameInGrRing_h
   %>
   /isSameInGrRing_h {
     /arg1 set
     [/ii /i_vw_vector /jj /j_vw_vector /vlist
      /i_gr /j_gr /rrule /ans] pushVariables
     [
       /ii arg1 [0 0] get def
       /i_vw_vector arg1 [0 1] get def
       /jj arg1 [1 0] get def
       /j_vw_vector arg1 [1 1] get def
       /vlist arg1 2 get def
       {
         [vlist i_vw_vector] getGrRing /i_gr set
         [vlist j_vw_vector] getGrRing /j_gr set
         i_gr j_gr isSameGrRing {  } { /ans [0 [i_gr j_gr]] def exit} ifelse
   
   % bug: in case of module
         [i_gr 0 get , ring_of_differential_operators 0] define_ring
   
   % H $B$r(B 1 $B$K(B.
         /rrule [ [@@@.Hsymbol . (1).] ] def
   
         i_gr 2 get length 0 eq {
         } {
           rrule i_gr 2 get  { { . } map } map join /rrule set
         } ifelse
         ii { toString . rrule replace toString } map /ii set
         jj { toString . rrule replace toString } map /jj set
   
         [ii jj i_gr 0 get , i_gr 1 get] ecartd.isSameIdeal_h /ans set
         [ans [i_gr] rrule ecartd.isSameIdeal_h.failed]  /ans set
   
         exit
       } loop
       /arg1 ans def
     ] pop
     popVariables
     arg1
   } def
   
   /test1.isSameInGrRing_h {
     [(parse) (data/test8-data.sm1) pushfile] extension
   
     cone.gblist 0 get (initial) getNode 2 get /ii set
     cone.gblist 0 get (weight) getNode [2 0 2] get    /iiw set
   
     cone.gblist 1 get (initial) getNode 2 get /jj set
     cone.gblist 1 get (weight) getNode [2 0 2] get    /jjw set
   
     (Doing   [ [ii iiw] [jj jjw] cone.vv ] isSameInGrRing_h /ff set) message
     [ [ii iiw] [jj jjw] cone.vv ] isSameInGrRing_h /ff set
   
     ff pmat
   
   } def
   
   
   %<
   % Usages: i j IsSameCone_h  [bool, ...]
   % $B%F%9%HJ}K!(B.  (data/test8.sm1) run  (data/test8-data.sm1) run 0 1 IsSameCone_h
   %>
   /IsSameCone_h {
     /arg2 set /arg1 set
     [/i /j /ans /ii /iiw /jj /jjw] pushVariables
     [
       /i arg1 def /j arg2 def
       cone.debug { (Comparing ) messagen [i j]  message } { } ifelse
   
       cone.gblist i get (initial) getNode 2 get /ii set
       cone.gblist i get (weight) getNode [2 0 2] get    /iiw set
   
       cone.gblist j get (initial) getNode 2 get /jj set
       cone.gblist j get (weight) getNode [2 0 2] get    /jjw set
   
       [ [ii iiw] [jj jjw] cone.vv ] isSameInGrRing_h /ans set
   
       ans /arg1 set
     ] pop
     popVariables
     arg1
   } def
   
Legend:
Removed from v.1.2  
changed lines
  Added in v.1.3
FreeBSD-CVSweb <freebsd-cvsweb@FreeBSD.org>