ipint.
[Integral polynomial common operations interpreter. 6/27/80.
6/9/82 - if file input is desired (i.e. A command is to be used),
then the environment variable FILE2 is expected to have been set
to the name of the input file.]
const PUNIT=9.
const ASIZE=50;
safe w,r,i^,i,j,C.
global I(ASIZE),V(ASIZE),r,i^,i,j,C.
(1) begin4; openn( 2,2); openn(9,9);
w=0; i^=0;
W=-1;
(2) [Read command and arguments.]
print "enter command (M for menu)"; C=creadb();
if C=='R'|C=='G'|C=='F'|
C=='D'|C=='I'|C=='X'|
C=='S'|C=='Z'|C=='P'|C=='*'|C=='+'|
C=='-'|C=='B'|C=='L'|C=='Y' then
{ i=aread(); if i>i^ |(i<1&C~='S') then
{ print "argument out of range"; go to 2 };
if C=='R'|C=='G'|C=='*'|
C=='+'|C=='-'|C=='B'
then { j=aread(); if j<1|j>i^ then
{ print "argument out of range"; go to 2 };
if ~EQUAL(V[i],V[j])&C~='B' then
{ print "arguments have different variable lists";
go to 2 } };
if i>=1 then r=length(V[i]) };
(3) [Display menu (M command).]
if C=='M' then {
print "H - command output to terminal (default)";
print "W - command output to output file";
print "J - set left and right margins";
print "V - enter new default variable list";
print "U - display current variable list";
print "T - display index of topmost item";
print "S i - show item i (negative arg for history)";
print "L i - show item i linear";
print "Y i - show variable list of item i";
print "C - restart item array";
print "I i - introduce variables with default variable list";
print "P i - permute item i with default variable list";
print "E - enter new item with default variable list";
print "A - enter new item from unit 2";
print "+ i j - sum of items i and j";
print "- i j - difference of items i and j";
print "* i j - product of items i and j";
print "R i j - resultant of items i and j";
print "G i j - gcd of items i and j";
print "F i - factor item i";
print "D i - discriminant of item i";
print "Z i - isolate real roots of (univariate) item i";
print "X i - graph item i, a bivariate polynomial";
print "B i j - algebraic basis from univar i and bivar j";
print "Q - quit";
go to 2 };
(4) [Miscellaneous commands which never have title line.]
if C=='Q' then stop;
if C=='J' then { clout("current LMARG is "); awrite(LMARG);
clout(", current RMARG is "); awrite(RMARG); emptob;
clout("enter LMARG"); emptob; LMARG=aread();
clout("enter RMARG"); emptob; RMARG=aread() };
if C=='T' then { clout("index of topmost item is ");
awrite(i^); emptob; go to 2 };
if C=='C' then { i^=0; go to 2 };
if C=='H' then { w=0; go to 2 };
if C=='W' then { w=1; go to 2 };
if C=='U' then { if W=-1 then
print "no current default variable list" else vlwrit(W);
emptob; go to 2 };
if C=='V' then
{ clout("enter variable list");
emptob; W=vlread(); go to 2 };
if C=='Y' then { vlwrit(V[i]); emptob; go to 2 };
(5) [Enter polynomial (E and A commands); no title line.]
if C=='E'|C=='A' then { if W=-1 then
{ print "no current variable list"; go to 2 };
if i^==ASIZE then go to 16;
clout ("enter polynomial according to default variable list ");
vlwrit(W); emptob; i^=i^+1;
if C=='A' then { i#=IUNIT; IUNIT=2 };
I[i^]=ipsr(W); V[i^]=W;
if C=='A' then IUNIT=i#;
cwrit2('I','('); awrite(i^); cwrit3(')',' ','='); emptob;
ipsw(I[i^],V[i^]) };
(6) [Enter title line.]
if w==1 then
{ print "enter a title line (standard character set)";
OUNIT=PUNIT; blines(2);
read; for k#=1,...,ISIZE do cwrite(cread());
write; IPOS=ISIZE; blines(1) };
(7) [Show items (S and L commands).]
if C=='S' then { if i<=0 then j=i^+i else j=i;
if j<1 then j=1; if i<=0 then i=i^;
for k=j,...,i do
{ cwrit2('I','('); awrite(k); cwrit3(')',' ','='); emptob;
ipsw(I[k],V[k]) } };
if C=='L' then { ipswl(I[i],V[i]); emptob};
(8) [Permute variables (P command).]
if C=='P' then { if W~=-1 then r'=length(W) else r'=-1;
if r'~=r then { OUNIT=6;
clout("default variable list has length "); awrite(r');
emptob; clout("variable list of item has length ");
awrite(r); emptob; go to 2 };
if i^==ASIZE then go to 16; i^=i^+1;
W'=W; P=(); while W'~=() do { adv(W';W1,W');
k=0; b=0; V'=V[i]; while b==0&V'~=() do
{ k=k+1; adv(V';V1,V'); b=EQUAL(V1,W1) };
if b==0 then { OUNIT=6;
print "unknown variable"; go to 2 }; P=comp(k,P) };
P=inv(P);
I[i^]=PPERMV(r,I[i],P); V[i^]=W;
cwrit2('I','('); awrite(i^); cwrit3(')',' ','='); emptob;
ipsw(I[i^],V[i^]) };
(9) [Introduce new variables (I command).]
if C=='I' then
{ if W=-1 then { OUNIT=6;
print "no default variable list"; go to 2 };
if i^==ASIZE then go to 16; i^=i^+1;
W'=W; while W'~=() do { adv(W';W1,W');
b=0; V'=V[i]; while b==0&V'~=() do
{ adv(V';V1,V'); b=EQUAL(V1,W1) };
if b==1 then { OUNIT=6;
clout("variable "); clout(W1); clout(" already occurs");
emptob; go to 2 } };
k=length(W);
I[i^]=PINV(r,I[i],k); W'=cinv(W); W'=inv(W');
V[i^]=conc(W',V[i]);
cwrit2('I','('); awrite(i^); cwrit3(')',' ','='); emptob;
ipsw(I[i^],V[i^]) };
(10) [Discriminant (D command).]
if C=='D' then
{ if i^==ASIZE then go to 16; i^=i^+1;
Z=cinv(V[i]); Z=red(Z); Z=inv(Z);
I[i^]=ipdscr(r,I[i]); V[i^]=Z;
clout("discriminant = I"); cwrite('('); awrite(i^);
cwrite(')'); emptob;
ipsw(I[i^],Z) };
(11) [Resultant (R command).]
if C=='R' then
{ if i^==ASIZE then go to 16; i^=i^+1;
Z=cinv(V[i]); Z=red(Z); Z=inv(Z);
I[i^]=ipres(r,I[i],I[j]); V[i^]=Z;
clout("resultant = I"); cwrite('('); awrite(i^);
cwrite(')'); emptob;
ipsw(I[i^],Z) };
(12) [Isolate real zeros (Z command).]
if C=='Z' then { if r~=1 then { OUNIT=6;
print "argument is not univariate"; go to 2 };
ipscpp(r,I[i];s,c,P); clout("content is");
iwrite(c); emptob;
clout("primitive part is"); ipsw(P,V[i]);
L=ipsf(r,P); n=length(L); awrite(n);
clout (" squarefree factors"); emptob; blines(1);
L'=L; while L'~=() do
{ adv(L';M,L'); first2(M;e,B);
clout("exponent is "); awrite(e);
clout(", factor is"); ipsw(B,V[i]);
clout("real roots of factor");
k=-15; K=iprch(B,(),k);
blines(1); i#=0; K'=K; while K'~=() do
{ i#=i#+1; adv(K';J,K'); I1=second(J);
clout("interval no. "); awrite(i#); emptob;
first2(I1;u,v);
rnwrit(u); clout(" "); rndwr(u,5); emptob;
rnwrit(v); clout(" "); rndwr(v,5); emptob;
blines(1) } } };
(13) [Further commands; subrs used due to translator dying
on garbage collection (7/82 larger translator now).]
if C=='F'|C=='G'|C=='*'|
C=='+'|C=='-' then IPINTS().
if C=='B' then IPINT2().
(14) [Graph bivariate polynomial (X command).]
if C=='X' then { if LENGTH(V[i])~=2 then
{ OUNIT=6; clout("item "); awrite(i);
clout(" is not a bivariate polynomial"); emptob; go to 2 };
CPLOT(I[i]) }.
(15) [Reset OUNIT to terminal if file output on.]
if w==1 then OUNIT=6; go to 2.
(16) [Item array full.]
if w==1 then OUNIT=6;
print "item array full; use C command to restart";
go to 2..