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>