Annotation of OpenXM/src/k097/factor-b.sm1, Revision 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