Annotation of OpenXM/src/k097/factor-b.sm1, Revision 1.1.1.1
1.1 maekawa 1: %% This package requires kan/sm1 version 951228 or later.
2: %% The binary file of kan/sm1 of this version is temporary obtainable from
3: %% ftp.math.s.kobe-u.ac.jp. The file /pub/kan/sm1.binary.sunos4.3.japanese
4: %% is for sun with JLE.
5: %% How to Install
6: %% 1.Copy this file and rename it to sm1 (mv sm1.binary.sunos4.3.japanese sm1).
7: %% 2.Add executable property (chmod +x sm1).
8:
9:
10: %% NEW feature of factor-b.sm1. [ ---> kanLeftBrace, ] ---> kanRightBrace
11: {
12: (factor-b.sm1 : kan/sm1 package to factor polynomials by calling risa/asir.)
13: message
14: ( : kan/sm1 package to simplify rationals by calling risa/asir.)
15: message
16: ( : kan/sm1 package to compute hilbert polynomials by calling sm0.)
17: message
18: ( Version June 30, 1997. It runs on kan/sm1 version 951228 or later.) message
19: }
20:
21: [(factor)
22: [(polynomial factor list_of_strings)
23: (Example: (x^2-1). factor :: ---> [[$1$ $1$] [$x-1$ $1$] [$x+1$ $1$]])
24: (cf.: data_conversion, map, get, pushfile)
25: (Note: The function call creates work files asir-tmp.t, asir-tmp.tt,)
26: ( asir-tmp-out.t, asir-tmp-log.t and asir-tmp-out.tt )
27: ( in the current directory.)
28: ]
29: ] putUsages
30:
31: %% /f (Dx^10*d*a-d*a) def
32:
33: /factor-asir-1 {
34: /arg1 set
35: [/f /fd /fnewline] pushVariables
36: [
37: arg1 /f set
38: %%(factor-asir-1 is tested with Asir version 950831 on Linux.) message
39: (asir-tmp.t) (w) file /fd set
40: /fnewline { fd 10 (string) data_conversion writestring } def
41: fd $output("asir-tmp-out.t");$ writestring fnewline
42: fd $fctr($ writestring
43: fd f writestring
44: fd $); output(); quit(); $ writestring fnewline
45: fd closefile
46: (/bin/rm -f asir-tmp.tt) system
47: (sed "s/D/kanD/g" asir-tmp.t | sed "s/E/kanE/g" | sed "s/Q/kanQ/g" | sed "s/\[/kanLeftBrace/g" | sed "s/\]/kanRightBrace/g" | sed "s/\,/kanComma/g" >asir-tmp.tt) system
48: (/bin/rm -f asir-tmp-out.t asir-tmp-out.tt asir-tmp-log.t) system
49: (asir <asir-tmp.tt >asir-tmp-log.t) system
50: (sed "s/\[1\]/ /g" asir-tmp-out.t | sed "s/\[2\]/ /g" | sed "1s/1/ /g"| sed "s/\[/{/g" | sed "s/\]/}/g" | sed "s/kanD/D/g" | sed "s/kanE/E/g" | sed "s/kanQ/Q/g" | sed "s/kanLeftBrace/\[/g" | sed "s/kanRightBrace/\]/g" | sed "s/kanComma/\,/g" >asir-tmp-out.tt) system
51: ] pop
52: popVariables
53: } def
54:
55: /clean-workfiles {
56: (/bin/rm -f asir-tmp-out.t asir-tmp-out.tt asir-tmp.t asir-tmp.tt sm0-tmp.t sm0-tmp-out.t asir-tmp-log.t sm0-tmp-out.tt) system
57: } def
58:
59:
60: %% comment: there is not data conversion function from string --> array
61: %% e.g. (abc) ---> [0x61, 0x62, 0x63]
62: %% We can do (abc) 1 10 put, but "get" does not work for strings.
63:
64: %% f factor-asir-1
65:
66: %%/aaa
67: %% ({{1,1},{x-1,1},{x+1,1},{x^4+x^3+x^2+x+1,1},{x^4-x^3+x^2-x+1,1}})
68: %%def
69:
70: /asir-list-to-kan {
71: /arg1 set
72: [/aaa /ftmp /ftmp2] pushVariables
73: [
74: /aaa arg1 def
75: [ aaa to_records pop ] /ftmp set
76: ftmp { to_records pop [ 3 1 roll ] } map /ftmp2 set
77: /arg1 ftmp2 def
78: ] pop
79: popVariables
80: arg1
81: } def
82:
83: /foo {
84: (input string is in f) message
85: f ::
86: f factor-asir-1
87: %% (asir-tmp-out.tt) run
88: %% (answer in @asir.out) message
89: %% bug of run.
90: (asir-tmp-out.tt) pushfile /@asir.out set
91: @asir.out asir-list-to-kan /ff2 set
92: (answer in ff2) message
93: } def
94:
95: /factor {
96: (string) data_conversion
97: factor-asir-1
98: (asir-tmp-out.tt) pushfile asir-list-to-kan
99: } def
100:
101: %%%%%%%%%%%%%%%%% macros for simplification (reduction, cancel)
102: %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
103: [(cancel)
104: [(polynomial cancel list_of_strings)
105: (This function simplifies rationals.)
106: (Example: $x^2-1$. $x+1$. div cancel :: ---> [[$x-1$ , $1$]])
107: (Note: The function call creates work files asir-tmp.t, asir-tmp.tt,)
108: ( asir-tmp-out.t, asri-tmp-log.t and asir-tmp-out.tt )
109: ( in the current directory.)
110: ]
111: ] putUsages
112:
113: /reduce-asir-1 {
114: /arg1 set
115: [/f /fd /fnewline] pushVariables
116: [
117: arg1 /f set
118: %% (reduce-asir-1 is tested with Asir version 950831 on Linux.) message
119: (asir-tmp.t) (w) file /fd set
120: /fnewline { fd 10 (string) data_conversion writestring } def
121: fd $output("asir-tmp-out.t");$ writestring fnewline
122: fd $AsirTmp012=red($ writestring
123: fd f writestring
124: fd $)$ writestring
125: fd ($ ) writestring fnewline
126: fd $AsirTmp013=ptozp(nm(AsirTmp012))$ writestring
127: fd ($ ) writestring fnewline
128: fd $AsirTmp014=red(nm(AsirTmp012)/AsirTmp013)$ writestring
129: fd ($ ) writestring fnewline
130: fd $[[nm(AsirTmp014)*AsirTmp013,dn(AsirTmp014)*dn(AsirTmp012)]];output();quit(); $ writestring fnewline
131: fd closefile
132: (/bin/rm -f asir-tmp.tt) system
133: (sed "s/D/kanD/g" asir-tmp.t | sed "s/E/kanE/g" | sed "s/Q/kanQ/g" >asir-tmp.tt) system
134: (/bin/rm -f asir-tmp-out.t asir-tmp-out.tt asir-tmp-log.t) system
135: (asir <asir-tmp.tt >asir-tmp-log.t) system
136: (sed "s/\[1\]/ /g" asir-tmp-out.t | sed "s/\[2\]/ /g" |sed "s/\[3\]/ /g" |sed "s/\[4\]/ /g" |sed "s/\[5\]/ /g" | sed "1s/1/ /g"| sed "s/\[/{/g" | sed "s/\]/}/g" | sed "s/kanD/D/g" | sed "s/kanE/E/g" | sed "s/kanQ/Q/g" | sed "s/kanLeftBrace/\[/g" | sed "s/kanRightBrace/\]/g" | sed "s/kanComma/\,/g" >asir-tmp-out.tt) system
137: ] pop
138: popVariables
139: } def
140:
141: /cancel {
142: (string) data_conversion
143: reduce-asir-1
144: (asir-tmp-out.tt) pushfile asir-list-to-kan
145: } def
146: %%%%%%%%%%%%%%%%% macros for Hilbert functions
147: %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
148: /hilbert {
149: /arg2 set
150: /arg1 set
151: [/bases /vars] pushVariables
152: [
153: /bases arg1 def
154: /vars arg2 def
155: bases {init (string) data_conversion} map /bases set
156: bases vars execSm0
157:
158: (sed '1s/^\$/{/g' sm0-tmp-out.t | sed '1s/\$$/ , /g' | sed '2s/^\$//g' | sed '2s/\$$/}/g' | sed 's/V//g' >sm0-tmp-out.tt) system
159: ] pop
160: popVariables
161: [ (sm0-tmp-out.tt) pushfile to_records pop]
162: } def
163: [(hilbert)
164: [(------------------------------------------------------------------------)
165: (list_of_polynomials variables hilbert hilbert_function)
166: (Example: [(x^2-1). (x y -2).] (x,y) hilbert :: ---> [$...$ $,,,$] )
167: (cf.: data_conversion, map, get, pushfile)
168: (Note: The function call creates work files sm0-tmp.t, sm0-tmp-out.tt,)
169: ( sm0-tmp-log.t and sm0-tmp-out.t in the current directory.)
170: ]
171: ] putUsages
172:
173:
174: %% Ex. [(x^2) (y^3) (x y)] (x,y) execSm0
175: /execSm0 {
176: /arg2 set
177: /arg1 set
178: [/monoms /fd /tmp /vars] pushVariables
179: [
180: /monoms arg1 def
181: /vars arg2 def
182: (/bin/rm -f sm0-tmp-out.t sm0-tmp-out.tt sm0-tmp-log.t) system
183: (sm0-tmp.t) (w) file /fd set
184: fd ( ${-p,0}$ options ) writestring
185: fd ( $) writestring
186: ${$ vars $}$ 3 cat_n /tmp set
187: fd tmp writestring
188: fd ($ ) writestring
189: fd ( polynomial_ring set_up_ring ${-proof}$ options ) writestring
190: fd monoms writeArray
191: fd ( /ff = ff yaGroebner /gg = gg hilbert2 /ans = ) writestring
192: fd (ans :: ans decompose $sm0-tmp-out.t$ printn_to_file quit) writestring
193: fd closefile
194: (sm0 -f sm0-tmp.t >sm0-tmp-log.t) system
195: (When the output is [$ a V^k + ... $ $p!$], the multiplicity is ) message
196: $ (k! a)/p! $ message
197: ( ) message
198: ] pop
199: popVariables
200: } def
201:
202:
203: /writeArray {
204: /arg2 set /arg1 set
205: [/fd /arr /k] pushVariables
206: [ /fd arg1 def
207: /arr arg2 def
208: fd ([ ) writestring
209: 0 1 arr length 1 sub
210: {
211: /k set
212: fd ($ ) writestring
213: fd arr k get writestring
214: fd ($ ) writestring
215: } for
216: fd ( ] ) writestring
217: ] pop
218: popVariables
219: } def
220:
221:
222:
223: %%(Loaded macros "factor", "hilbert".) message
224:
225: [(primadec)
226: [([polynomials] [variables] primadec list_of_strings)
227: (cf.: data_conversion, map, get, pushfile)
228: (Note: The function call creates work files asir-tmp.t, asir-tmp.tt,)
229: ( asir-tmp-out.t, asir-tmp-log.t and asir-tmp-out.tt )
230: ( in the current directory.)
231: ]
232: ] putUsages
233:
234:
235: /sendcommand-to-asir2 { %% arg1 arg2 command sendcommand-to-asir2
236: /arg3 set /arg2 set /arg1 set
237: [/f /fd /fnewline /com /g] pushVariables
238: [
239: arg1 /f set arg2 /g set arg3 /com set
240: (asir-tmp.t) (w) file /fd set
241: /fnewline { fd 10 (string) data_conversion writestring } def
242: fd $load("gr"); load("primdec"); output("asir-tmp-out.t");$ writestring fnewline
243: fd com $($ 2 cat_n writestring
244: fd f writestring
245: fd $,$ writestring
246: fd g writestring
247: fd $); output(); quit(); $ writestring fnewline
248: fd closefile
249: (/bin/rm -f asir-tmp.tt) system
250: (sed "s/D/kanD/g" asir-tmp.t | sed "s/E/kanE/g" | sed "s/Q/kanQ/g" >asir-tmp.tt) system
251: (/bin/rm -f asir-tmp-out.t asir-tmp-out.tt asir-tmp-log.t) system
252: (asir <asir-tmp.tt >asir-tmp-log.t) system
253: (sed "s/\[147\]/ /g" asir-tmp-out.t | sed "s/\[148\]/ /g" | sed "1s/1/ /g"| sed "s/kanD/D/g" | sed "s/kanE/E/g" | sed "s/kanQ/Q/g" >asir-tmp-out.tt) system
254: ] pop
255: popVariables
256: } def
257:
258: /clean-workfiles {
259: (/bin/rm -f asir-tmp-out.t asir-tmp-out.tt asir-tmp.t asir-tmp.tt sm0-tmp.t sm0-tmp-out.t asir-tmp-log.t sm0-tmp-out.tt) system
260: } def
261:
262:
263: /asir-list-to-kan {
264: /arg1 set
265: [/aaa /ftmp /ftmp2] pushVariables
266: [
267: /aaa arg1 def
268: [ aaa to_records pop ] /ftmp set
269: ftmp { to_records pop [ 3 1 roll ] } map /ftmp2 set
270: /arg1 ftmp2 def
271: ] pop
272: popVariables
273: arg1
274: } def
275:
276:
277: /primadec {
278: /arg2 set /arg1 set
279: [/f /g] pushVariables
280: [
281: /f arg1 def /g arg2 def
282: f { (string) dc removeBrace } map toString
283: g { (string) dc removeBrace } map toString (primadec)
284: sendcommand-to-asir2
285: (asir-tmp-out.tt) pushfile asir-list-to-kan /arg1
286: ] pop popVariables
287: arg1
288: } def
289:
290: /removeBrace { %% string removeBrace string
291: %% (z[1]^2-1) removeBrace (z_1 ^2-1)
292: /arg1 set
293: [/f /i /ans /fa] pushVariables
294: [
295: /f arg1 def f 1 copy /f set
296: f (array) dc /fa set
297: 0 1 fa length 1 sub {
298: /i set
299: fa i get 91 eq
300: { f i 95 put }
301: { } ifelse
302: fa i get 93 eq
303: { f i 32 put }
304: { } ifelse
305: } for
306: % fa aload length cat_n /arg1 set %% This may cause operand stack overflow.
307: f /arg1 set
308: ] pop
309: popVariables
310: arg1
311: } def
312:
313:
314:
315:
316:
317:
318:
319:
FreeBSD-CVSweb <freebsd-cvsweb@FreeBSD.org>
![[BACK]](/icons/cvsweb/back.gif){kind=icon}
Return to factor-b.sm1 CVS log ![[TXT]](/icons/cvsweb/text.gif){kind=icon}
![[DIR]](/icons/cvsweb/dir.gif){kind=icon}
Up to [local] / OpenXM / src / k097