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

Annotation of OpenXM/src/kan96xx/Doc/Old/bf.sm1, Revision 1.1.1.1

1.1       maekawa     1: (bf.sm1  Version Sep 26, 1995) message
                      2: ( Computing b-function by the algorithm by Oaku. Type in demo1 to see a demo.)
                      3:  message
                      4:
                      5: %%%% demo1 can be used as a template to compute the b-function of your own
                      6: %%%% polynomial.
                      7: /demo1 {
                      8:   %%% Give your variables. s is used for FW-filtration.
                      9:    [(s,t,x,y) ring_of_differential_operators
                     10:   %%% Give the weight vector here.
                     11:     [[(s) 1] [(Dx) 1 (Dy) 1 (x) 1 (y) 1]] weight_vector 0 ] define_ring
                     12:   %%% Give the generators.  t - s f(x), Dx + s Df/Dx Dt
                     13:    [( t- s x^2 + s y^3).
                     14:     (  Dx + 2 s x Dt).
                     15:     (  Dy - 3 s y^2 Dt).
                     16:    ] /ff set
                     17:
                     18:   %%%%%%%%%%% Don't touch. %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
                     19:    ff print
                     20:    (  are generators.) message (   ) message
                     21:    ff {[[(h). (1).]] replace} map {homogenize} map /ff set
                     22:    (Computing groebner basis) message
                     23:    {[ff] groebner 0 get /ans set } timer
                     24:    (     ) message
                     25:    ans fw_principal /ans0 set
                     26:   %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
                     27:
                     28:   %%% Give variables to eliminate
                     29:   ans0 [(Dx)  (Dy) (x)  (y) ] eliminatev
                     30:   /ans1 set
                     31:
                     32:
                     33:   (The answer [ans1] is ) message
                     34:   ans1 print (  ) message
                     35: } def
                     36:
                     37: %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
                     38:
                     39: %% demo2 : degree 26. Time = 355s + 60s
                     40: /demo2 {
                     41:   %%% Give your variables. s is used for FW-filtration.
                     42:    [(s,t,x,y,z) ring_of_differential_operators
                     43:   %%% Give the weight vector here.
                     44:     [[(s) 1] [(Dx) 1 (Dy) 1 (Dz) 1 (x) 1 (y) 1 (z) 1 ]] weight_vector
                     45:    0 ] define_ring
                     46:   %%% Give the generators.  t - s f(x), Dx + s Df/Dx Dt
                     47:    [( t - s (-x^2 z^2 + x^4 + y^4)).
                     48:     (  Dx + s (-2 x z^2 + 4 x^3) Dt ).
                     49:     (  Dy + s (4 y^3 ) Dt ).
                     50:     (  Dz + s (-2 x^2 z) Dt).
                     51:    ] /ff set
                     52:
                     53:   %%%%%%%%%%% Don't touch. %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
                     54:    ff print
                     55:    (  are generators.) message (   ) message
                     56:    ff {[[(h). (1).]] replace} map {homogenize} map /ff set
                     57:    (Computing groebner basis) message
                     58:    {[ff] groebner 0 get /ans set } timer
                     59:    (     ) message
                     60:    ans fw_principal /ans0 set
                     61:   %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
                     62:
                     63:   %%% Give variables to eliminate
                     64:   ans0 [(Dx) (Dy) (Dz) (x)  (y)  (z) ] eliminatev
                     65:   /ans1 set
                     66:
                     67:
                     68:   (The answer [ans1] is ) message
                     69:   ans1 print (  ) message
                     70: } def
                     71:
                     72: /bf3_0 {
                     73:   %%% Give your variables. s is used for FW-filtration.
                     74:    [(s,t,x,y,z) ring_of_differential_operators
                     75:   %%% Give the weight vector here.
                     76:     [[(s) 1] [(Dx) 1 (Dy) 1 (Dz) 1 (x) 1 (y) 1 (z) 1 ]] weight_vector
                     77:    0 ] define_ring
                     78:    /s (s). def /x (x). def /y (y). def /z (z). def
                     79:               /Dx (Dx). def /Dy (Dy). def /Dz (Dz). def
                     80:    /t (t). def /Dt (Dt). def /h (h). def
                     81: } def
                     82:
                     83: %%% Give the generators.  t - s f(x), Dx + s Df/Dx Dt as ff
                     84:
                     85: /bf3_1 {
                     86:   /ff set
                     87:   %%%%%%%%%%% Don't touch. %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
                     88:    ff print
                     89:    (  are generators.) message (   ) message
                     90:    ff {[[(h). (1).]] replace} map {homogenize} map /ff set
                     91:    (Computing groebner basis) message
                     92:    {[ff] groebner 0 get /ans set } timer
                     93:    (     ) message
                     94:    ans fw_principal /ans0 set
                     95:   %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
                     96:
                     97:   %%% Give variables to eliminate
                     98:   ans0 [(Dx) (Dy) (Dz) (x)  (y)  (z) ] eliminatev
                     99:   /ans1 set
                    100:
                    101:   (The answer [ans1] is ) message
                    102:   ans1 print (  ) message
                    103:   ans1
                    104: } def
                    105:
                    106:
                    107: %% [   ] {outputans1} map ;
                    108: /outputans1 {
                    109:  (t.t) (a) file /fd set
                    110:  (string) data_conversion /tmp0 set
                    111:  fd tmp0 writestring
                    112:  fd (  ,) writestring
                    113:  fd 10 (string) data_conversion writestring
                    114:  fd closefile
                    115: } def
                    116:
                    117:
                    118:
                    119:
                    120: /fw_principal {
                    121:    {[[(h). (1).]] replace} map {(s). coefficients 1 get 0 get} map
                    122: } def
                    123:
                    124:
                    125: %%%%%%%%%%%%%%%%%%%%%
                    126: % [g1 g2 g3 ...] var eliminate0
                    127: /eliminate0 {
                    128:   /arg2 set /arg1 set
                    129:   [/gb /degs /ans /n /var] pushVariables
                    130:   [
                    131:   /gb arg1 def
                    132:   /var arg2 def
                    133:   /degs gb {var . degree} map def
                    134:   /ans [
                    135:     0 1 << gb length 1 sub >> {
                    136:       /n set
                    137:       << degs n get  >>  0 eq
                    138:       { gb n get /ff set
                    139:         ff (0). eq
                    140:         {  }
                    141:         { ff } ifelse
                    142:       }
                    143:       {   } ifelse
                    144:     } for
                    145:   ] def
                    146:   /arg1 ans def
                    147:   ] pop
                    148:   popVariables
                    149:   arg1
                    150: } def
                    151:
                    152:
                    153:
                    154:
                    155:
                    156:
                    157:
                    158:
                    159:
                    160:
                    161:

FreeBSD-CVSweb <freebsd-cvsweb@FreeBSD.org>