Annotation of OpenXM/src/kan96xx/Doc/Old/bf.sm1, Revision 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>