Annotation of OpenXM/src/kan96xx/Doc/factor-a.sm1.org, 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: (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