Annotation of OpenXM/src/kan96xx/Doc/factor-a.sm1.org, 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: (factor-a.sm1 : kan/sm1 package to factor polynomials by calling risa/asir.)
10: message
11: ( : kan/sm1 package to simplify rationals by calling risa/asir.)
12: message
13: ( : kan/sm1 package to compute hilbert polynomials by calling sm0.)
14: message
15: ( Version June 30, 1997. It runs on kan/sm1 version 951228 or later.) message
16:
17:
18: [(factor)
19: [(polynomial factor list_of_strings)
20: (Example: (x^2-1). factor :: ---> [[$1$ $1$] [$x-1$ $1$] [$x+1$ $1$]])
21: (cf.: data_conversion, map, get, pushfile)
22: (Note: The function call creates work files asir-tmp.t, asir-tmp.tt,)
23: ( asir-tmp-out.t, asri-tmp-log.t and asir-tmp-out.tt )
24: ( in the current directory.)
25: ]
26: ] putUsages
27:
28: %% /f (Dx^10*d*a-d*a) def
29:
30: /factor-asir-1 {
31: /arg1 set
32: [/f /fd /fnewline] pushVariables
33: [
34: arg1 /f set
35: %% (factor-asir-1 is tested with Asir version 950831 on Linux.) message
36: (asir-tmp.t) (w) file /fd set
37: /fnewline { fd 10 (string) data_conversion writestring } def
38: fd $output("asir-tmp-out.t");$ writestring fnewline
39: fd $fctr($ writestring
40: fd f writestring
41: fd $); output(); quit(); $ writestring fnewline
42: fd closefile
43: (/bin/rm -f asir-tmp.tt) system
44: (sed "s/D/kanD/g" asir-tmp.t | sed "s/E/kanE/g" | sed "s/Q/kanQ/g" >asir-tmp.tt) system
45: (/bin/rm -f asir-tmp-out.t asir-tmp-out.tt asir-tmp-log.t) system
46: (asir <asir-tmp.tt >asir-tmp-log.t) system
47: (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" >asir-tmp-out.tt) system
48: ] pop
49: popVariables
50: } def
51:
52: /clean-workfiles {
53: (/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) system
54: } def
55:
56:
57: %% comment: there is not data conversion function from string --> array
58: %% e.g. (abc) ---> [0x61, 0x62, 0x63]
59: %% We can do (abc) 1 10 put, but "get" does not work for strings.
60:
61: %% f factor-asir-1
62:
63: %%/aaa
64: %% ({{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}})
65: %%def
66:
67: /asir-list-to-kan {
68: /arg1 set
69: [/aaa /ftmp /ftmp2] pushVariables
70: [
71: /aaa arg1 def
72: [ aaa to_records pop ] /ftmp set
73: ftmp { to_records pop [ 3 1 roll ] } map /ftmp2 set
74: /arg1 ftmp2 def
75: ] pop
76: popVariables
77: arg1
78: } def
79:
80: /foo {
81: (input string is in f) message
82: f ::
83: f factor-asir-1
84: %% (asir-tmp-out.tt) run
85: %% (answer in @asir.out) message
86: %% bug of run.
87: (asir-tmp-out.tt) pushfile /@asir.out set
88: @asir.out asir-list-to-kan /ff2 set
89: (answer in ff2) message
90: } def
91:
92: /factor {
93: (string) data_conversion
94: factor-asir-1
95: (asir-tmp-out.tt) pushfile asir-list-to-kan
96: } def
97:
98: %%%%%%%%%%%%%%%%% macros for simplification (reduction, cancel)
99: %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
100: [(cancel)
101: [(polynomial cancel list_of_strings)
102: (This function simplifies rationals.)
103: (Example: $x^2-1$. $x+1$. div cancel :: ---> [[$x-1$ , $1$]])
104: (Note: The function call creates work files asir-tmp.t, asir-tmp.tt,)
105: ( asir-tmp-out.t, asri-tmp-log.t and asir-tmp-out.tt )
106: ( in the current directory.)
107: ]
108: ] putUsages
109:
110: /reduce-asir-1 {
111: /arg1 set
112: [/f /fd /fnewline] pushVariables
113: [
114: arg1 /f set
115: %% (reduce-asir-1 is tested with Asir version 950831 on Linux.) message
116: (asir-tmp.t) (w) file /fd set
117: /fnewline { fd 10 (string) data_conversion writestring } def
118: fd $output("asir-tmp-out.t");$ writestring fnewline
119: fd $AsirTmp012=red($ writestring
120: fd f writestring
121: fd $)$ writestring
122: fd ($ ) writestring fnewline
123: fd $AsirTmp013=ptozp(nm(AsirTmp012))$ writestring
124: fd ($ ) writestring fnewline
125: fd $AsirTmp014=red(nm(AsirTmp012)/AsirTmp013)$ writestring
126: fd ($ ) writestring fnewline
127: fd $[[nm(AsirTmp014)*AsirTmp013,dn(AsirTmp014)*dn(AsirTmp012)]];output();quit(); $ writestring fnewline
128: fd closefile
129: (/bin/rm -f asir-tmp.tt) system
130: (sed "s/D/kanD/g" asir-tmp.t | sed "s/E/kanE/g" | sed "s/Q/kanQ/g" >asir-tmp.tt) system
131: (/bin/rm -f asir-tmp-out.t asir-tmp-out.tt asir-tmp-log.t) system
132: (asir <asir-tmp.tt >asir-tmp-log.t) system
133: (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
134:
135:
136: ] pop
137: popVariables
138: } def
139:
140: /cancel {
141: (string) data_conversion
142: reduce-asir-1
143: (asir-tmp-out.tt) pushfile asir-list-to-kan
144: } def
145:
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 :: ---> [$n !$ $a_d x^d + ...$] )
167: (Example: [(x^2-1). (x y -2).] (x,y) hilbert (x) hilbReduce --> m x^d + ...::)
168: ( where m is the multiplicity.)
169: (cf.: hilbReduce, data_conversion, map, get, pushfile)
170: (Note: The function call creates work files sm0-tmp.t, sm0-tmp-out.tt,)
171: ( sm0-tmp-log.t and sm0-tmp-out.t in the current directory.)
172: ]
173: ] putUsages
174:
175:
176: %% Ex. [(x^2) (y^3) (x y)] (x,y) execSm0
177: /execSm0 {
178: /arg2 set
179: /arg1 set
180: [/monoms /fd /tmp /vars] pushVariables
181: [
182: /monoms arg1 def
183: /vars arg2 def
184: (/bin/rm -f sm0-tmp-out.t sm0-tmp-out.tt sm0-tmp-log.t) system
185: (sm0-tmp.t) (w) file /fd set
186: fd ( ${-p,0}$ options ) writestring
187: fd ( $) writestring
188: ${$ vars $}$ 3 cat_n /tmp set
189: fd tmp writestring
190: fd ($ ) writestring
191: fd ( polynomial_ring set_up_ring ${-proof}$ options ) writestring
192: fd monoms writeArray
193: fd ( /ff = ff yaGroebner /gg = gg hilbert2 /ans = ) writestring
194: fd (ans :: ans decompose $sm0-tmp-out.t$ printn_to_file quit) writestring
195: fd closefile
196: (sm0 -f sm0-tmp.t >>sm0-tmp-log.t) system
197: (When the output is [$ a V^k + ... $ $p!$], the multiplicity is ) message
198: $ (k! a)/p! $ message
199: ( ) message
200: ] pop
201: popVariables
202: } def
203:
204:
205: /writeArray {
206: /arg2 set /arg1 set
207: [/fd /arr /k] pushVariables
208: [ /fd arg1 def
209: /arr arg2 def
210: fd ([ ) writestring
211: 0 1 arr length 1 sub
212: {
213: /k set
214: fd ($ ) writestring
215: fd arr k get writestring
216: fd ($ ) writestring
217: } for
218: fd ( ] ) writestring
219: ] pop
220: popVariables
221: } def
222:
223: [(hilbReduce)
224: [([f,g] v hilbReduce h)
225: $ [(x-z). (y^3).] (x,y,z) hilbert (x) hilbReduce $
226: ]
227: ] putUsages
228: /hilbReduce {
229: /arg2 set
230: /arg1 set
231: [/hhh /f /d /vv /ans] pushVariables
232: [
233: /hhh arg1 def
234: /vv arg2 def
235: /f hhh 1 get . def
236: f vv . degree /vv set
237: hhh 0 get /d set d << d length 1 sub >> 0 put %% remove !
238: << d .. >> << d .. (integer) dc >> factorial /d set
239: d << vv (universalNumber) dc vv factorial >> idiv /d set
240: [(divByN) f d] gbext /ans set
241: ans 1 get (0). eq
242: { }
243: { (hilbReduce : Invalid hilbert function ) message error } ifelse
244: ans 0 get /arg1 set
245: ] pop
246: popVariables
247: arg1
248: } def[(hilbReduce)
249: [([f,g] v hilbReduce h)
250: $ [(x-z). (y^3).] (x,y,z) hilbert (x) hilbReduce $
251: ]
252: ] putUsages
253: /hilbReduce {
254: /arg2 set
255: /arg1 set
256: [/hhh /f /d /vv /ans] pushVariables
257: [
258: /hhh arg1 def
259: /vv arg2 def
260: /f hhh 1 get . def
261: f vv . degree /vv set
262: hhh 0 get /d set d << d length 1 sub >> 0 put %% remove !
263: << d .. >> << d .. (integer) dc >> factorial /d set
264: d << vv (universalNumber) dc vv factorial >> idiv /d set
265: [(divByN) f d] gbext /ans set
266: ans 1 get (0). eq
267: { }
268: { (hilbReduce : Invalid hilbert function ) message error } ifelse
269: ans 0 get /arg1 set
270: ] pop
271: popVariables
272: arg1
273: } def
274:
275: (Loaded macros "factor", "cancel", "hilbert", "hilbReduce".) message
276:
277:
278:
279:
280:
FreeBSD-CVSweb <freebsd-cvsweb@FreeBSD.org>
![[BACK]](/icons/cvsweb/back.gif){kind=icon}
Return to factor-a.sm1.org CVS log ![[TXT]](/icons/cvsweb/text.gif){kind=icon}
![[DIR]](/icons/cvsweb/dir.gif){kind=icon}
Up to [local] / OpenXM / src / kan96xx / Doc