[BACK]Return to factor-b.sm1 CVS log [TXT][DIR] Up to [local] / OpenXM / src / k097

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>