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