%% This package requires kan/sm1 version 951228 or later.
%% The binary file of kan/sm1 of this version is temporary obtainable from
%% ftp.math.s.kobe-u.ac.jp. The file /pub/kan/sm1.binary.sunos4.3.japanese
%% is for sun with JLE.
%% How to Install
%% 1.Copy this file and rename it to sm1 (mv sm1.binary.sunos4.3.japanese sm1).
%% 2.Add executable property (chmod +x sm1).
(factor-a.sm1 : kan/sm1 package to factor polynomials by calling risa/asir.)
message
( : kan/sm1 package to simplify rationals by calling risa/asir.)
message
( : kan/sm1 package to compute hilbert polynomials by calling sm0.)
message
( Version June 30, 1997. It runs on kan/sm1 version 951228 or later.) message
[(factor)
[(polynomial factor list_of_strings)
(Example: (x^2-1). factor :: ---> [[$1$ $1$] [$x-1$ $1$] [$x+1$ $1$]])
(cf.: data_conversion, map, get, pushfile)
(Note: The function call creates work files asir-tmp.t, asir-tmp.tt,)
( asir-tmp-out.t, asri-tmp-log.t and asir-tmp-out.tt )
( in the current directory.)
]
] putUsages
%% /f (Dx^10*d*a-d*a) def
/factor-asir-1 {
/arg1 set
[/f /fd /fnewline] pushVariables
[
arg1 /f set
%% (factor-asir-1 is tested with Asir version 950831 on Linux.) message
(asir-tmp.t) (w) file /fd set
/fnewline { fd 10 (string) data_conversion writestring } def
fd $output("asir-tmp-out.t");$ writestring fnewline
fd $fctr($ writestring
fd f writestring
fd $); output(); quit(); $ writestring fnewline
fd closefile
(/bin/rm -f asir-tmp.tt) system
(sed "s/D/kanD/g" asir-tmp.t | sed "s/E/kanE/g" | sed "s/Q/kanQ/g" >asir-tmp.tt) system
(/bin/rm -f asir-tmp-out.t asir-tmp-out.tt asir-tmp-log.t) system
(asir <asir-tmp.tt >asir-tmp-log.t) system
(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
] pop
popVariables
} def
/clean-workfiles {
(/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
} def
%% comment: there is not data conversion function from string --> array
%% e.g. (abc) ---> [0x61, 0x62, 0x63]
%% We can do (abc) 1 10 put, but "get" does not work for strings.
%% f factor-asir-1
%%/aaa
%% ({{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}})
%%def
/asir-list-to-kan {
/arg1 set
[/aaa /ftmp /ftmp2] pushVariables
[
/aaa arg1 def
[ aaa to_records pop ] /ftmp set
ftmp { to_records pop [ 3 1 roll ] } map /ftmp2 set
/arg1 ftmp2 def
] pop
popVariables
arg1
} def
/foo {
(input string is in f) message
f ::
f factor-asir-1
%% (asir-tmp-out.tt) run
%% (answer in @asir.out) message
%% bug of run.
(asir-tmp-out.tt) pushfile /@asir.out set
@asir.out asir-list-to-kan /ff2 set
(answer in ff2) message
} def
/factor {
(string) data_conversion
factor-asir-1
(asir-tmp-out.tt) pushfile asir-list-to-kan
} def
%%%%%%%%%%%%%%%%% macros for simplification (reduction, cancel)
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
[(cancel)
[(polynomial cancel list_of_strings)
(This function simplifies rationals.)
(Example: $x^2-1$. $x+1$. div cancel :: ---> [[$x-1$ , $1$]])
(Note: The function call creates work files asir-tmp.t, asir-tmp.tt,)
( asir-tmp-out.t, asri-tmp-log.t and asir-tmp-out.tt )
( in the current directory.)
]
] putUsages
/reduce-asir-1 {
/arg1 set
[/f /fd /fnewline] pushVariables
[
arg1 /f set
%% (reduce-asir-1 is tested with Asir version 950831 on Linux.) message
(asir-tmp.t) (w) file /fd set
/fnewline { fd 10 (string) data_conversion writestring } def
fd $output("asir-tmp-out.t");$ writestring fnewline
fd $AsirTmp012=red($ writestring
fd f writestring
fd $)$ writestring
fd ($ ) writestring fnewline
fd $AsirTmp013=ptozp(nm(AsirTmp012))$ writestring
fd ($ ) writestring fnewline
fd $AsirTmp014=red(nm(AsirTmp012)/AsirTmp013)$ writestring
fd ($ ) writestring fnewline
fd $[[nm(AsirTmp014)*AsirTmp013,dn(AsirTmp014)*dn(AsirTmp012)]];output();quit(); $ writestring fnewline
fd closefile
(/bin/rm -f asir-tmp.tt) system
(sed "s/D/kanD/g" asir-tmp.t | sed "s/E/kanE/g" | sed "s/Q/kanQ/g" >asir-tmp.tt) system
(/bin/rm -f asir-tmp-out.t asir-tmp-out.tt asir-tmp-log.t) system
(asir <asir-tmp.tt >asir-tmp-log.t) system
(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
] pop
popVariables
} def
/cancel {
(string) data_conversion
reduce-asir-1
(asir-tmp-out.tt) pushfile asir-list-to-kan
} def
%%%%%%%%%%%%%%%%% macros for Hilbert functions
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
/hilbert {
/arg2 set
/arg1 set
[/bases /vars] pushVariables
[
/bases arg1 def
/vars arg2 def
bases {init (string) data_conversion} map /bases set
bases vars execSm0
(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
] pop
popVariables
[ (sm0-tmp-out.tt) pushfile to_records pop]
} def
[(hilbert)
[(------------------------------------------------------------------------)
(list_of_polynomials variables hilbert hilbert_function)
(Example: [(x^2-1). (x y -2).] (x,y) hilbert :: ---> [$n !$ $a_d x^d + ...$] )
(Example: [(x^2-1). (x y -2).] (x,y) hilbert (x) hilbReduce --> m x^d + ...::)
( where m is the multiplicity.)
(cf.: hilbReduce, data_conversion, map, get, pushfile)
(Note: The function call creates work files sm0-tmp.t, sm0-tmp-out.tt,)
( sm0-tmp-log.t and sm0-tmp-out.t in the current directory.)
]
] putUsages
%% Ex. [(x^2) (y^3) (x y)] (x,y) execSm0
/execSm0 {
/arg2 set
/arg1 set
[/monoms /fd /tmp /vars] pushVariables
[
/monoms arg1 def
/vars arg2 def
(/bin/rm -f sm0-tmp-out.t sm0-tmp-out.tt sm0-tmp-log.t) system
(sm0-tmp.t) (w) file /fd set
fd ( ${-p,0}$ options ) writestring
fd ( $) writestring
${$ vars $}$ 3 cat_n /tmp set
fd tmp writestring
fd ($ ) writestring
fd ( polynomial_ring set_up_ring ${-proof}$ options ) writestring
fd monoms writeArray
fd ( /ff = ff yaGroebner /gg = gg hilbert2 /ans = ) writestring
fd (ans :: ans decompose $sm0-tmp-out.t$ printn_to_file quit) writestring
fd closefile
(sm0 -f sm0-tmp.t >>sm0-tmp-log.t) system
(When the output is [$ a V^k + ... $ $p!$], the multiplicity is ) message
$ (k! a)/p! $ message
( ) message
] pop
popVariables
} def
/writeArray {
/arg2 set /arg1 set
[/fd /arr /k] pushVariables
[ /fd arg1 def
/arr arg2 def
fd ([ ) writestring
0 1 arr length 1 sub
{
/k set
fd ($ ) writestring
fd arr k get writestring
fd ($ ) writestring
} for
fd ( ] ) writestring
] pop
popVariables
} def
[(hilbReduce)
[([f,g] v hilbReduce h)
$ [(x-z). (y^3).] (x,y,z) hilbert (x) hilbReduce $
]
] putUsages
/hilbReduce {
/arg2 set
/arg1 set
[/hhh /f /d /vv /ans] pushVariables
[
/hhh arg1 def
/vv arg2 def
/f hhh 1 get . def
f vv . degree /vv set
hhh 0 get /d set d << d length 1 sub >> 0 put %% remove !
<< d .. >> << d .. (integer) dc >> factorial /d set
d << vv (universalNumber) dc vv factorial >> idiv /d set
[(divByN) f d] gbext /ans set
ans 1 get (0). eq
{ }
{ (hilbReduce : Invalid hilbert function ) message error } ifelse
ans 0 get /arg1 set
] pop
popVariables
arg1
} def[(hilbReduce)
[([f,g] v hilbReduce h)
$ [(x-z). (y^3).] (x,y,z) hilbert (x) hilbReduce $
]
] putUsages
/hilbReduce {
/arg2 set
/arg1 set
[/hhh /f /d /vv /ans] pushVariables
[
/hhh arg1 def
/vv arg2 def
/f hhh 1 get . def
f vv . degree /vv set
hhh 0 get /d set d << d length 1 sub >> 0 put %% remove !
<< d .. >> << d .. (integer) dc >> factorial /d set
d << vv (universalNumber) dc vv factorial >> idiv /d set
[(divByN) f d] gbext /ans set
ans 1 get (0). eq
{ }
{ (hilbReduce : Invalid hilbert function ) message error } ifelse
ans 0 get /arg1 set
] pop
popVariables
arg1
} def
(Loaded macros "factor", "cancel", "hilbert", "hilbReduce".) message