DIRECTORY
Rope,
Basics,
Atom,
Ascii,
Convert,
IO,
AlgebraClasses,
Variables,
DistribPolys,
Polynomials;

PolynomialsImpl: CEDAR PROGRAM
IMPORTS Rope, Convert, IO, Atom, Variables, DistribPolys 
EXPORTS Polynomials =

BEGIN OPEN AC: AlgebraClasses, VARS: Variables, DP: DistribPolys, Polynomials;
ClassPrintName: AC.PrintNameProc = {
data: PolynomialRingData _ NARROW[structure.instanceData];
RETURN[Rope.Cat[
"Polynomials in ",
VARS.VariableSeqToRope[data.variables],
" over ",
data.coeffRing.class.printName[data.coeffRing]
] ];
};
ClassLegalFirstChar: AC.LegalFirstCharOp = {
data: PolynomialRingData _ NARROW[structure.instanceData];
IF data.coeffRing.class.legalFirstChar[char, data.coeffRing] THEN RETURN[TRUE];
RETURN[VARS.VariableFirstChar[char, data.variables] ];
};
ClassRead: AC.ReadOp = {
data: PolynomialRingData _ NARROW[structure.instanceData];
RETURN[ReadPoly[in, data.variables, data.coeffRing] ];
};
ClassFromRope: AC.FromRopeOp = {
stream: IO.STREAM _ IO.RIS[in];
RETURN[ ClassRead[stream, structure] ];
};
ClassToRope: AC.ToRopeOp = {
polynomial: Polynomial _ NARROW[in];
data: PolynomialRingData _ NARROW[structure.instanceData];
RETURN[ PolyToRope[polynomial, data.variables, data.coeffRing] ] -- use defaults
};
ClassWrite: AC.WriteOp = {
polynomial: Polynomial _ NARROW[in];
IO.PutRope[stream, ClassToRope[polynomial, structure] ]
}; 
ClassZero: AC.NullaryOp = {
RETURN[ ZeroPoly ]
}; 
ClassOne: AC.NullaryOp = {
data: PolynomialRingData _ NARROW[structure.instanceData];
one: Polynomial _ UnivariateMonomialConstructor[data.coeffRing.class.one[data.coeffRing], 0];
FOR i:NAT IN [2..data.variables.lengthPlus1) DO one _ MultivariateMonomialConstructor[one, 0] ENDLOOP;
RETURN[ one ]
}; 
ClassCharacteristic: AC.StructureRankOp = {
data: PolynomialRingData _ NARROW[structure.instanceData];
RETURN[ data.coeffRing.class.characteristic[data.coeffRing] ]
}; 
ClassAdd: AC.BinaryOp = {
firstPoly: Polynomial _ NARROW[firstArg];
secondPoly: Polynomial _ NARROW[secondArg];
data: PolynomialRingData _ NARROW[structure.instanceData];
RETURN[ Add[firstPoly, secondPoly, data.coeffRing] ]
}; 
ClassNegate: AC.UnaryOp = {
polynomial: Polynomial _ NARROW[arg];
data: PolynomialRingData _ NARROW[structure.instanceData];
RETURN[ Negate[polynomial, data.coeffRing] ]
}; 
ClassSubtract: AC.BinaryOp = {
firstPoly: Polynomial _ NARROW[firstArg];
secondPoly: Polynomial _ NARROW[secondArg];
data: PolynomialRingData _ NARROW[structure.instanceData];
RETURN[ Subtract[firstPoly, secondPoly, data.coeffRing] ]
}; 
ClassMultiply: AC.BinaryOp = {
firstPoly: Polynomial _ NARROW[firstArg];
secondPoly: Polynomial _ NARROW[secondArg];
data: PolynomialRingData _ NARROW[structure.instanceData];
RETURN[ Multiply[firstPoly, secondPoly, data.coeffRing] ]
}; 
ClassEqual: AC.EqualityOp = {
firstPoly: Polynomial _ NARROW[firstArg];
secondPoly: Polynomial _ NARROW[secondArg];
data: PolynomialRingData _ NARROW[structure.instanceData];
RETURN[ Equal[firstPoly, secondPoly, data.coeffRing] ]
}; 
ClassSign: AC.CompareToZeroOp = {
polynomial: Polynomial _ NARROW[arg];
data: PolynomialRingData _ NARROW[structure.instanceData];
RETURN[ Sign[polynomial, data.coeffRing] ]
}; 
ClassAbs: AC.UnaryOp = {
polynomial: Polynomial _ NARROW[arg];
data: PolynomialRingData _ NARROW[structure.instanceData];
RETURN[ Abs[polynomial, data.coeffRing] ]
}; 
ClassCompare: AC.BinaryCompareOp = {
firstPoly: Polynomial _ NARROW[firstArg];
secondPoly: Polynomial _ NARROW[secondArg];
data: PolynomialRingData _ NARROW[structure.instanceData];
RETURN[ Compare[firstPoly, secondPoly, data.coeffRing] ]
}; 
ClassRemainder: AC.BinaryOp = {
firstPoly: Polynomial _ NARROW[firstArg];
secondPoly: Polynomial _ NARROW[secondArg];
data: PolynomialRingData _ NARROW[structure.instanceData];
RETURN[ Remainder[firstPoly, secondPoly, structure] ]
}; 
ClassDifferentiate: AC.UnaryOp = {
polynomial: Polynomial _ NARROW[arg];
data: PolynomialRingData _ NARROW[structure.instanceData];
RETURN[ Diff[polynomial, data.coeffRing] ]
}; 
ClassLeadingCoefficient: AC.UnaryOp = {
polynomial: Polynomial _ NARROW[arg];
RETURN[ LeadingCoeff[polynomial] ]
}; 
ClassMainVariableDegree: AC.ElementRankOp = {
polynomial: Polynomial _ NARROW[arg];
RETURN[ MainVariableDeg[polynomial] ]
}; 
polynomialOps: PolynomialOps _ NEW[PolynomialOpsRec _ [
univariateMonomial: UnivariateMonomialConstructor,
multivariateMonomial: MultivariateMonomialConstructor,
differentiate: ClassDifferentiate,
leadingCoefficient: ClassLeadingCoefficient,
mainVariableDegree: ClassMainVariableDegree
] ];
polynomialProp: Atom.DottedPair _ NEW[Atom.DottedPairNode_ [$PolynomialRing, polynomialOps]];
polynomialsOverRingClass: PUBLIC AC.StructureClass _ NEW[AC.StructureClassRec _ [
flavor: ring,
printName: ClassPrintName,
characteristic: ClassCharacteristic,

legalFirstChar: ClassLegalFirstChar,
read: ClassRead,
fromRope: ClassFromRope,
toRope: ClassToRope,
write: ClassWrite,

add: ClassAdd,
negate: ClassNegate,
subtract: ClassSubtract,
zero: ClassZero,

multiply: ClassMultiply,
commutative: TRUE, -- not necessarily accurate; need separate classrecs for polys over commutative, and polys over noncommutative, rings.
one: ClassOne,

equal: ClassEqual,

ordered: TRUE, -- not necessarily accurate; need separate classrecs for polys over ordered, and polys over unordered, rings.
sign: ClassSign,
abs: ClassAbs,
compare: ClassCompare,

integralDomain: TRUE, -- not necessarily accurate; need separate classrecs
gcdDomain: FALSE, -- not necessarily accurate; need separate classrecs
gcd: NIL, -- should have a poly gcd proc here when appropriate
euclideanDomain: FALSE,

propList: LIST[polynomialProp]
] ];

polynomialsOverFieldClass: PUBLIC AC.StructureClass _ NEW[AC.StructureClassRec _ [
flavor: ring,
printName: ClassPrintName,
characteristic: ClassCharacteristic,

legalFirstChar: ClassLegalFirstChar,
read: ClassRead,
fromRope: ClassFromRope,
toRope: ClassToRope,
write: ClassWrite,
zero: ClassZero,

add: ClassAdd,
negate: ClassNegate,
subtract: ClassSubtract,
multiply: ClassMultiply,
commutative: TRUE, -- not necessarily accurate; need separate classrecs for polys over commutative, and polys over noncommutative, fields.
one: ClassOne,

equal: ClassEqual,

ordered: TRUE, -- not necessarily accurate; need separate classrecs for polys over ordered, and polys over unordered, fields.
sign: ClassSign,
abs: ClassAbs,
compare: ClassCompare,

integralDomain: TRUE, -- not necessarily accurate; need separate classrecs
gcdDomain: FALSE, -- not necessarily accurate; need separate classrecs
gcd: NIL, -- should have a poly gcd proc here when appropriate
euclideanDomain: TRUE,
remainder: ClassRemainder, -- euclideanDomains only

propList: LIST[polynomialProp]
] ];


PolynomialsOverRing: PUBLIC PROC [coeffRing: AC.Structure, V: VARS.VariableSeq] RETURNS [polynomialRing: AC.Structure] ~ {
polynomialRingData: PolynomialRingData _ NEW[PolynomialRingDataRec _ [
coeffRing: coeffRing,
variables: V
] ];
polynomialRing _ NEW[AC.StructureRec _ [
class: polynomialsOverRingClass,
instanceData: polynomialRingData
] ];
};

PolynomialsOverField: PUBLIC PROC [coeffField: AC.Structure, V: VARS.VariableSeq] RETURNS [polynomialRing: AC.Structure] ~ {
polynomialRingData: PolynomialRingData _ NEW[PolynomialRingDataRec _ [
coeffRing: coeffField,
variables: V
] ];
polynomialRing _ NEW[AC.StructureRec _ [
class: polynomialsOverFieldClass,
instanceData: polynomialRingData
] ];
};
IsPolynomialRing: PUBLIC PROC [structure: AC.Structure] RETURNS [BOOL] ~ {
IF Atom.GetPropFromList[structure.class.propList, $PolynomialRing] # NIL THEN RETURN[TRUE] ELSE RETURN[FALSE];
};

Differentiate: PUBLIC PROC [polynomialRing: AC.Structure] RETURNS [AC.UnaryOp] ~ {
polynomialOps: PolynomialOps  _ NARROW[ Atom.GetPropFromList[polynomialRing.class.propList, $PolynomialRing] ];
IF polynomialOps = NIL THEN ERROR;
RETURN[polynomialOps.differentiate];
};

LeadingCoefficient: PUBLIC PROC [polynomialRing: AC.Structure] RETURNS [AC.UnaryOp] ~ {
polynomialOps: PolynomialOps  _ NARROW[ Atom.GetPropFromList[polynomialRing.class.propList, $PolynomialRing] ];
IF polynomialOps = NIL THEN ERROR;
RETURN[polynomialOps.leadingCoefficient];
};

MainVariableDegree: PUBLIC PROC [polynomialRing: AC.Structure] RETURNS [AC.ElementRankOp] ~ {
polynomialOps: PolynomialOps  _ NARROW[ Atom.GetPropFromList[polynomialRing.class.propList, $PolynomialRing] ];
IF polynomialOps = NIL THEN ERROR;
RETURN[polynomialOps.mainVariableDegree];
};

UnivariateMonomialConstructor: PUBLIC UnivariateMonomialConstructorOp = {
RETURN[ NEW[ PolynomialRec _ [
numVars: 1,
data: nonconstant [ leadingTerm: [ exponent: exp,
coefficient: NEW[ PolynomialRec _ [
numVars: 0,
data: constant [ coeff ]
] ] ],
reductum: ZeroPoly ]
] ] ];
};

MultivariateMonomialConstructor: PUBLIC MultivariateMonomialConstructorOp = {
RETURN[ NEW[ PolynomialRec _ [
numVars: coeff.numVars + 1,
data: nonconstant [ leadingTerm: [ exponent: exp,
coefficient: coeff ],
reductum: ZeroPoly ]
] ] ];
};

ReadPoly: PUBLIC PROC [in: IO.STREAM, V: VARS.VariableSeq, coeffRing: AC.Structure] RETURNS [poly: Polynomial] = {
dPoly: DP.DPolynomial;
termChar: CHAR;
[dPoly, termChar] _ DP.ReadDPoly[in, V, coeffRing];
RETURN[ PolyFromDPoly[dPoly, V] ];
};

PolyFromRope: PUBLIC PROC [in: Rope.ROPE, V: VARS.VariableSeq, coeffRing: AC.Structure] RETURNS [out: Polynomial] = {
stream: IO.STREAM _ IO.RIS[in];
out _ ReadPoly[stream, V, coeffRing];
};

PolyFullRepToRope: PUBLIC PROC [in: Polynomial, V: VARS.VariableSeq, coeffRing: AC.Structure] RETURNS [out: Rope.ROPE] = {
numVars: CARDINAL = V.lengthPlus1 - 1;  -- we need V arg to get this number
IF in = ZeroPoly THEN RETURN["0"];
WITH in SELECT FROM
input: REF PolynomialRec.constant => { 
out _ "";
RETURN[ Rope.Concat[out, coeffRing.class.toRope[input.value, coeffRing] ] ];
};
input: REF PolynomialRec.nonconstant => {
out _ "( ";
WHILE input # ZeroPoly DO
out _ Rope.Cat[out,
PolyFullRepToRope[input.leadingTerm.coefficient, VARS.VSRemoveMainVariable[V], coeffRing],
" ",
V[numVars],
Rope.Cat["^", Convert.RopeFromCard[input.leadingTerm.exponent] ]
];
input _ NARROW[input.reductum];
IF input # ZeroPoly THEN out _ Rope.Concat[ out, " + " ];
ENDLOOP;
RETURN[ Rope.Concat[ out, " )" ] ];
};
ENDCASE;
};

PolyToRope: PUBLIC PROC [in: Polynomial, V: VARS.VariableSeq, coeffRing: AC.Structure, termRope: Rope.ROPE _ DP.DollarRope] RETURNS [out: Rope.ROPE] = {
out _ DP.DPolyToRope[DPolyFromPoly[in, V], V, coeffRing, termRope];
};

WritePoly: PUBLIC PROC [in: Polynomial, V: VARS.VariableSeq, coeffRing: AC.Structure, out: IO.STREAM, termRope: Rope.ROPE _ DP.DollarRope] = {
out.PutF["\n %g \n", IO.rope[PolyToRope[in, V, coeffRing, termRope]] ];
};
ReadPolySeq: PUBLIC PROC [in: IO.STREAM, V: VARS.VariableSeq, coeffRing: AC.Structure] RETURNS [seq: PolynomialSeq] ~ {
puncChar: CHAR;
nextP: Polynomial;
length: NAT _ 0;
ReadPSFail: PUBLIC ERROR [subclass: ATOM _ $Unspecified] = CODE;
pList, pListTail: LIST OF Polynomial _ NIL;
[]_ in.SkipWhitespace[];
puncChar _ in.GetChar[];
IF puncChar # '( THEN ReadPSFail[$LeftParenExpected];
[]_ in.SkipWhitespace[];
WHILE in.PeekChar[]  # ') DO
nextP _ ReadPoly[in, V, coeffRing];
length _ length + 1;
IF pList=NIL THEN pList _ pListTail _LIST[nextP] ELSE
{ pListTail.rest _ LIST[nextP];  pListTail _ pListTail.rest };
[]_ in.SkipWhitespace[];
ENDLOOP;
[] _ in.GetChar[];  -- toss right paren
seq _ NEW[PolynomialSeqRec[length]];
FOR i:NAT IN [1..length+1) DO
seq[i] _ pList.first;
pList _ pList.rest;
ENDLOOP;
};

PolySeqFromRope: PUBLIC PROC [in: Rope.ROPE, V: VARS.VariableSeq, coeffRing: AC.Structure] RETURNS [out: PolynomialSeq] ~ {
PSStream: IO.STREAM _ IO.RIS[in];
RETURN[ ReadPolySeq[ PSStream, V, coeffRing ] ];
};

PolySeqToRope: PUBLIC PROC [in: PolynomialSeq, V: VARS.VariableSeq, coeffRing: AC.Structure] RETURNS [out: Rope.ROPE] ~ {
out _ "(\n"; 
FOR i:NAT IN [1..in.lengthPlus1) DO
out _ Rope.Cat[ out, DP.DPolyToRope[DPolyFromPoly[in[i], V], V, coeffRing],"\n"];
ENDLOOP;
out _ Rope.Concat[ out, ")\n" ];
};

WritePolySeq: PUBLIC PROC [in: PolynomialSeq, V: VARS.VariableSeq, coeffRing: AC.Structure, out: IO.STREAM] ~ {
PSRope: Rope.ROPE _ PolySeqToRope[in, V, coeffRing];
out.PutF["%g", IO.rope[PSRope] ];
};

PolyFromDPoly: PUBLIC PROC [in: DP.DPolynomial, V: VARS.VariableSeq] RETURNS [out: Polynomial] = {
numVars: CARDINAL = V.lengthPlus1 - 1;  -- we need V arg to get this number
termDegree: CARDINAL; -- degree in main variable of current (output) term
outTermDCoefficient: DP.DPolynomial;  -- output term coefficient, still in DP rep
outTermCoefficient: Polynomial; -- output term coefficient, converted to P rep
outTerm: Polynomial; -- completed output term
previousTerm: Polynomial;
IF in = DP.ZeroDPoly THEN RETURN[ZeroPoly];
IF numVars=0 THEN {
out _ NEW[PolynomialRec _ [
numVars: 0,
data: constant[value: in.first.coefficient]
] ];
RETURN;
};
previousTerm _ ZeroPoly;
WHILE in#NIL DO
termDegree _ DP.DVDegree[in.first.degreeVector, numVars]; -- degree in main variable
outTermDCoefficient _ LIST[ [in.first.coefficient, DP.DVRemoveMainVariablePower[in.first.degreeVector, numVars] ] ];
in _ in.rest;
WHILE in#NIL AND DP.DVDegree[in.first.degreeVector, numVars] = termDegree DO
outTermDCoefficient _ CONS[ [in.first.coefficient, DP.DVRemoveMainVariablePower[in.first.degreeVector, numVars] ], outTermDCoefficient];
in _ in.rest;
ENDLOOP;
outTermDCoefficient _ DP.DPReverse[ outTermDCoefficient ];
outTermCoefficient _ PolyFromDPoly[ outTermDCoefficient, VARS.VSRemoveMainVariable[V] ];
outTerm _ NEW[PolynomialRec _ [
numVars: numVars,
data: nonconstant [ leadingTerm: [ exponent: termDegree,
coefficient: outTermCoefficient ],
reductum: ZeroPoly ]
] ];
IF previousTerm # ZeroPoly THEN {
WITH previousTerm SELECT FROM
previousTermVariant: REF PolynomialRec.nonconstant => {
previousTermVariant.reductum _ outTerm;
previousTerm _ outTerm;
};
ENDCASE => ERROR;
}
ELSE out _ previousTerm _ outTerm;
ENDLOOP;
};

DPolyFromPoly: PUBLIC PROC [in: Polynomial, V: VARS.VariableSeq] RETURNS [out: DP.DPolynomial] ~ {
numVars: CARDINAL = V.lengthPlus1 - 1;  -- we need V arg to get this number
inTermDegree: CARDINAL; -- degree in main variable of current (input) term
inTermDPolynomial: DP.DPolynomial;
IF in = ZeroPoly THEN RETURN[DP.ZeroDPoly];
IF numVars#in.numVars THEN ERROR; -- consistency check
WITH in SELECT FROM
input: REF PolynomialRec.constant => RETURN[ LIST[ [input.value, NIL] ] ];
input: REF PolynomialRec.nonconstant => {
out _ DP.ZeroDPoly;
WHILE input # ZeroPoly DO
inTermDegree _ input.leadingTerm.exponent;
inTermDPolynomial _ DPolyFromPoly[input.leadingTerm.coefficient, VARS.VSRemoveMainVariable[V] ];
WHILE inTermDPolynomial#NIL DO
out _ CONS[ [ inTermDPolynomial.first.coefficient, DP.DVAddMainVariablePower[inTermDPolynomial.first.degreeVector, numVars, inTermDegree] ], out];
inTermDPolynomial _ inTermDPolynomial.rest;
ENDLOOP;
input _ NARROW[ input.reductum ];
ENDLOOP;
out _  DP.DPReverse[out];
};
ENDCASE;
};


Add: PUBLIC PROC [in1, in2: Polynomial, coeffRing: AC.Structure] RETURNS [out: Polynomial] ~ {
previousOutTerm, outTerm, tail: Polynomial;
termToAdd: BOOL;
IF in1 = ZeroPoly THEN RETURN[in2];
IF in2 = ZeroPoly THEN RETURN[in1];
IF in1.numVars # in2.numVars THEN ERROR;
WITH in1 SELECT FROM
input1: REF PolynomialRec.constant => {
WITH in2 SELECT FROM
input2: REF PolynomialRec.constant => {
val: REF _ coeffRing.class.add[input1.value, input2.value, coeffRing];
IF coeffRing.class.equal[val, coeffRing.class.zero[coeffRing], coeffRing] THEN RETURN[ZeroPoly];
out _ NEW[PolynomialRec _ [
numVars: 0,
data: constant[value: val]
] ];
RETURN;
};
ENDCASE => ERROR;
};
input1: REF PolynomialRec.nonconstant => {
WITH in2 SELECT FROM
input2: REF PolynomialRec.nonconstant => {
out _ previousOutTerm _ ZeroPoly;
WHILE input1 # ZeroPoly AND input2 # ZeroPoly DO
termToAdd _ TRUE;
SELECT input1.leadingTerm.exponent FROM
< input2.leadingTerm.exponent => {
outTerm _ NEW[PolynomialRec _ [
numVars: input2.numVars,
data: nonconstant[leadingTerm: input2.leadingTerm, reductum: ZeroPoly]
] ]; 
input2 _ NARROW[ input2.reductum ];
};
> input2.leadingTerm.exponent => {
outTerm _ NEW[PolynomialRec _ [
numVars: input1.numVars,
data: nonconstant [leadingTerm: input1.leadingTerm, reductum: ZeroPoly ]
] ];
input1 _ NARROW[ input1.reductum ];
};
= input2.leadingTerm.exponent => {
coeff: Polynomial _ Add[
input1.leadingTerm.coefficient,
input2.leadingTerm.coefficient,
coeffRing
];
IF coeff # ZeroPoly THEN
outTerm _ NEW[PolynomialRec _ [
numVars: input1.numVars,
data: nonconstant [ leadingTerm: [ exponent: input2.leadingTerm.exponent,
coefficient: coeff ],
reductum: ZeroPoly ]
] ]
ELSE
termToAdd _ FALSE;
input1 _ NARROW[ input1.reductum ];
input2 _ NARROW[ input2.reductum ];
};
ENDCASE;
IF termToAdd THEN IF previousOutTerm # ZeroPoly THEN {
WITH previousOutTerm SELECT FROM
previousOutTermVariant: REF PolynomialRec.nonconstant => {
previousOutTermVariant.reductum _ outTerm;
previousOutTerm _ outTerm;
};
ENDCASE => ERROR;
}
ELSE out _ previousOutTerm _ outTerm;
ENDLOOP;
IF input1 = ZeroPoly THEN tail _ input2 ELSE tail _ input1;
IF out # ZeroPoly THEN WITH previousOutTerm SELECT FROM
previousOutTermVariant: REF PolynomialRec.nonconstant => previousOutTermVariant.reductum _ tail;
ENDCASE => ERROR
ELSE out _ tail;
};
ENDCASE => ERROR;
};
ENDCASE;
};

Negate: PUBLIC PROC [in: Polynomial, coeffRing: AC.Structure] RETURNS [out: Polynomial] ~ {
outTerm, previousOutTerm: Polynomial;
IF in = ZeroPoly THEN RETURN[ZeroPoly];
WITH in SELECT FROM
input: REF PolynomialRec.constant => {
out _ NEW[PolynomialRec _ [
numVars: 0,
data: constant[value: coeffRing.class.negate[input.value, coeffRing] ]
] ];
RETURN;
};
input: REF PolynomialRec.nonconstant => {
previousOutTerm _ ZeroPoly;
WHILE input # ZeroPoly DO
outTerm _ NEW[PolynomialRec _ [
numVars: input.numVars,
data: nonconstant[leadingTerm: [
exponent: input.leadingTerm.exponent,
coefficient: Negate[input.leadingTerm.coefficient, coeffRing]
],
reductum: ZeroPoly ]
] ]; 
input _ NARROW[input.reductum ];
IF previousOutTerm # ZeroPoly THEN {
WITH previousOutTerm SELECT FROM
previousOutTermVariant: REF PolynomialRec.nonconstant => {
previousOutTermVariant.reductum _ outTerm;
previousOutTerm _ outTerm;
};
ENDCASE => ERROR;
}
ELSE out _ previousOutTerm _ outTerm;
ENDLOOP;
};
ENDCASE;
};

Subtract: PUBLIC PROC [in1, in2: Polynomial, coeffRing: AC.Structure] RETURNS [Polynomial] ~ {
RETURN[ Add[ in1, Negate[ in2, coeffRing], coeffRing ] ];
};

Multiply: PUBLIC PROC [in1, in2: Polynomial, coeffRing: AC.Structure] RETURNS [out: Polynomial] ~ {
previousOutSummandTerm, outSummandTerm, outSummand: Polynomial;
IF in1 = ZeroPoly OR in2 = ZeroPoly THEN RETURN[ZeroPoly];
IF in1.numVars # in2.numVars THEN ERROR;
WITH in1 SELECT FROM
input1: REF PolynomialRec.constant => {
WITH in2 SELECT FROM
input2: REF PolynomialRec.constant => {
val: REF _ coeffRing.class.multiply[input1.value, input2.value, coeffRing];
out _ NEW[PolynomialRec _ [
numVars: 0,
data: constant[value: val]
] ];
RETURN;
};
ENDCASE => ERROR;
};
input1: REF PolynomialRec.nonconstant => {
WITH in2 SELECT FROM
input2: REF PolynomialRec.nonconstant => {
scratchInput1: REF PolynomialRec.nonconstant;
out _ ZeroPoly;
WHILE input2 # ZeroPoly DO
previousOutSummandTerm _ ZeroPoly;
scratchInput1 _  input1;
WHILE scratchInput1 # ZeroPoly DO
coeff: Polynomial _ Multiply[
scratchInput1.leadingTerm.coefficient,
input2.leadingTerm.coefficient,
coeffRing
];
outSummandTerm _ NEW[PolynomialRec _ [
numVars: scratchInput1.numVars,
data: nonconstant [ leadingTerm: [
exponent: scratchInput1.leadingTerm.exponent + input2.leadingTerm.exponent,
coefficient: coeff ],
reductum: ZeroPoly ]
] ];
IF previousOutSummandTerm # ZeroPoly THEN
WITH previousOutSummandTerm SELECT FROM
previousOutSummandTermVariant: REF PolynomialRec.nonconstant => {
previousOutSummandTermVariant.reductum _ outSummandTerm;
previousOutSummandTerm _ outSummandTerm;
};
ENDCASE => ERROR
ELSE outSummand _ previousOutSummandTerm _ outSummandTerm;
scratchInput1 _ NARROW[ scratchInput1.reductum ];
ENDLOOP;
out _ Add[out, outSummand, coeffRing];
input2 _ NARROW[ input2.reductum ];
ENDLOOP;
};
ENDCASE => ERROR
};
ENDCASE;
};

Remainder: PUBLIC PROC [dividend, divisor: Polynomial, polynomialsOverField: AC.Structure] RETURNS [Polynomial] ~ {
R: AC.Structure = polynomialsOverField;
newDividend: Polynomial _ dividend;
data: PolynomialRingData _ NARROW[R.instanceData];
IF data.coeffRing.class.flavor # field AND data.coeffRing.class.flavor # divisionAlgebra THEN ERROR;
WHILE MainVariableDeg[newDividend] >= MainVariableDeg[divisor] DO
coeff: REF _ data.coeffRing.class.divide[LeadingCoeff[newDividend], LeadingCoeff[divisor] ];
degreeDelta: CARDINAL _ MainVariableDeg[newDividend] - MainVariableDeg[divisor];
multiplier: Polynomial _ UnivariateMonomialConstructor[coeff, degreeDelta];
product: Polynomial _ NARROW[R.class.multiply[multiplier, divisor, R]];
newDividend _ NARROW[R.class.subtract[newDividend, product, R]];
ENDLOOP;
RETURN[newDividend];
};

 
Diff: PUBLIC PROC [in: Polynomial, coeffRing: AC.Structure] RETURNS [out: Polynomial] ~ {
outTerm, previousOutTerm: Polynomial;
IF in = ZeroPoly THEN RETURN[ZeroPoly];
WITH in SELECT FROM
input: REF PolynomialRec.constant => RETURN[ZeroPoly];
input: REF PolynomialRec.nonconstant => {
numV: CARDINAL = input.numVars;
out _ previousOutTerm _ ZeroPoly;
WHILE input # ZeroPoly AND input.leadingTerm.exponent > 0 DO
imbeddedExp: REF _ coeffRing.class.fromRope[Convert.RopeFromCard[input.leadingTerm.exponent,10, FALSE] ];
IF input.numVars = 1 THEN {
newCoeff: REF _ coeffRing.class.multiply[imbeddedExp, LeadingCoeff[input], coeffRing];
outTerm _ UnivariateMonomialConstructor[newCoeff, input.leadingTerm.exponent-1]
}
ELSE {
newCoeff: Polynomial;
newImbeddedExp: Polynomial _ UnivariateMonomialConstructor[imbeddedExp, 0];
FOR i:INT IN [2 .. input.numVars-1] DO newImbeddedExp _ MultivariateMonomialConstructor[newImbeddedExp, 0] ENDLOOP;
newCoeff _ Multiply[newImbeddedExp, NARROW[LeadingCoeff[input]], coeffRing];
outTerm _ MultivariateMonomialConstructor[newCoeff, input.leadingTerm.exponent-1]
};
input _ NARROW[input.reductum];
IF previousOutTerm # ZeroPoly THEN {
WITH previousOutTerm SELECT FROM
previousOutTermVariant: REF PolynomialRec.nonconstant => {
previousOutTermVariant.reductum _ outTerm;
previousOutTerm _ outTerm;
};
ENDCASE => ERROR;
}
ELSE out _ previousOutTerm _ outTerm;
ENDLOOP;
};
ENDCASE;
};

Equal: PUBLIC PROC [in1, in2: Polynomial, coeffRing: AC.Structure] RETURNS [BOOL _ FALSE] ~ {
WITH in1 SELECT FROM
input: REF PolynomialRec.constant =>
RETURN[coeffRing.class.subtract[in1, in2, coeffRing] = ZeroPoly];
input: REF PolynomialRec.nonconstant => 
RETURN[Subtract[in1, in2, coeffRing] = ZeroPoly ];
ENDCASE;
};

Sign: PUBLIC PROC [in: Polynomial, coeffRing: AC.Structure] RETURNS [Basics.Comparison _ equal] ~ {
IF in = ZeroPoly THEN RETURN[equal];
WITH in SELECT FROM
input: REF PolynomialRec.constant =>
RETURN[coeffRing.class.sign[input.value, coeffRing] ];
input: REF PolynomialRec.nonconstant => 
RETURN[Sign[input.leadingTerm.coefficient, coeffRing] ];
ENDCASE;
};

Abs: PUBLIC PROC [in: Polynomial, coeffRing: AC.Structure] RETURNS [out: Polynomial] ~ {
sign: Basics.Comparison _ Sign[in, coeffRing];
IF sign = less THEN RETURN[Negate[in, coeffRing]] ELSE RETURN[in];
};

Compare: PUBLIC PROC [in1, in2: Polynomial, coeffRing: AC.Structure] RETURNS [Basics.Comparison] ~ {
diff: Polynomial _ Subtract[in1, in2, coeffRing];
SELECT Sign[diff, coeffRing] FROM
less => RETURN[less];	
equal => RETURN[equal];
ENDCASE;
RETURN[greater];
};
LeadingCoeff: PUBLIC PROC [in: Polynomial] RETURNS [out: REF _ NIL] ~ {
IF in = ZeroPoly THEN RETURN[ZeroPoly];
WITH in SELECT FROM
input: REF PolynomialRec.constant => RETURN[input.value];
input: REF PolynomialRec.nonconstant => {
SELECT in.numVars FROM
1 => RETURN[LeadingCoeff[input.leadingTerm.coefficient]]; -- extract ground ring elt
ENDCASE => RETURN[input.leadingTerm.coefficient];
};
ENDCASE;
};
MainVariableDeg: PUBLIC PROC [in: Polynomial] RETURNS [CARDINAL _ 0] ~ {
IF in = ZeroPoly THEN RETURN[0];
WITH in SELECT FROM
input: REF PolynomialRec.constant => RETURN[0];
input: REF PolynomialRec.nonconstant => RETURN[input.leadingTerm.exponent];
ENDCASE;
};




END.
”PolynomialsImpl.mesa
Last Edited by: Arnon, June 10, 1985 4:19:22 pm PDT
Classes for Polynomial Rings
Legal first char of polynomial is either legal first char of coefficient, or first char of some variable.
structuredProp: Atom.DottedPair _ NEW[Atom.DottedPairNode_ [$Structured, $Structured]];
Polynomial Ring Constructors
A particular polynomialRing is defined by its coefficient domain, and its variables.
Extract Polynomial Operations from Class Property Lists
Constructors
Conversion and IO

Dump the internal representation in a more reasonable form than SAC-2 rep
Display in a reasonable format

Arithmetic
Note that structure arg is poly ring, not coefficient ring
Assumes that CARDINAL exponent values can be imbedded in coeffRing, in particular, that coeffRing.class.fromRope[Convert.RopeFromCard[input.leadingTerm.exponent]] works.
Comparison
IF NOT AC.IsOrdered[coeffRing] THEN ERROR;
Selection

ΚΓ˜Jš
œ™J™3J˜š
Οk	˜	Jš
œ˜J˜J˜J˜Jš
œ˜Jšœ
˜Jš
œ˜Jš
œ
˜
Jš
œ
˜
Jš
œ˜—J˜
head2šœœ
˜Jšœ2˜9Jšœ˜J˜—Jš
œ
œ
œœ	œ˜N
headš
œ™šΟnœœ˜$Jšœœ˜:šœ
˜Jš
œ˜Jšœ#˜'J˜	Jš
œ.˜.Jš
œ˜—J˜—šžœœ˜,Jšœœ˜:Icodešœ;œ
œ
œ˜Ošœ
œ+˜6Mš
œi™i—J˜—šž	œœ˜Jšœœ˜:Jšœ0˜6J˜—šž
œœ˜ Mš	œœ
œœ
œ˜Mšœ!˜'M˜—šžœœ
˜Jšœœ˜$Jšœœ˜:Jšœ;Οc˜PJ˜—šž
œœ˜Jšœœ˜$Jšœ5˜7Jš
œ˜—šž	œœ˜Jšœ˜Jš
œ˜—šžœœ˜Jšœœ˜:Mš
œ]˜]Jš
œœ
œ!œ/œ
˜fJšœ˜
Jš
œ˜—šžœœ˜+Jšœœ˜:Jšœ7˜=Jš
œ˜—šžœœ
˜Jšœœ˜)Jšœœ˜+Jšœœ˜:Jšœ.˜4Jš
œ˜—šžœœ˜Jšœœ˜%Jšœœ˜:Jšœ&˜,Jš
œ˜—šž
œœ
˜Jšœœ˜)Jšœœ˜+Jšœœ˜:Jšœ3˜9Jš
œ˜—šž
œœ
˜Jšœœ˜)Jšœœ˜+Jšœœ˜:Jšœ3˜9Jš
œ˜—šž
œœ˜Jšœœ˜)Jšœœ˜+Jšœœ˜:Jšœ0˜6Jš
œ˜—šž	œœ˜!Jšœœ˜%Jšœœ˜:Jšœ$˜*Jš
œ˜—šžœœ˜Jšœœ˜%Jšœœ˜:Jšœ#˜)Jš
œ˜—šžœœ˜$Jšœœ˜)Jšœœ˜+Jšœœ˜:Jšœ2˜8Jš
œ˜—šžœœ
˜Jšœœ˜)Jšœœ˜+Jšœœ˜:Jšœ/˜5Jš
œ˜—šžœœ˜"Jšœœ˜%Jšœœ˜:Jšœ$˜*Jš
œ˜—šžœœ˜'Jšœœ˜%Jšœ˜"Jš
œ˜—šžœœ˜-Jšœœ˜%Jšœ˜%Jš
œ˜—šœœ˜7Mš
œ2˜2Mš
œ6˜6Mš
œ"˜"Mš
œ,˜,Mš
œ+˜+M˜—Mšœ"œ8˜]Mšœ"œ2™Wš	œœ
œœ
œ˜QJ˜
Jš
œ˜Jš
œ$˜$J˜Jš
œ$˜$Jš
œ˜Jš
œ˜Jš
œ˜Jš
œ˜J˜Mš
œ˜Mš
œ˜Mš
œ˜J˜J˜Mš
œ˜Mšœ
œŸv˜‰
J˜J˜J˜J˜Mšœ	œŸm˜|Mš
œ˜M˜Mš
œ˜M˜MšœœŸ1˜JMšœœŸ1˜FMšœœŸ4˜>Mšœœ
˜M˜Jšœ
œ˜M˜M˜—š	œœ
œœ
œ˜RJ˜
Jš
œ˜Jš
œ$˜$J˜Jš
œ$˜$Jš
œ˜Jš
œ˜Jš
œ˜Jš
œ˜J˜J˜Mš
œ˜Mš
œ˜Mš
œ˜Mš
œ˜Mšœ
œŸw˜Š
J˜J˜J˜J˜Mšœ	œŸn˜}Mš
œ˜M˜Mš
œ˜M˜MšœœŸ1˜JMšœœŸ1˜FMšœœŸ4˜>Mšœœ
˜MšœŸ˜3M˜Jšœ
œ˜M˜—M˜—š
œ™M˜šžœœ
œœœœ˜zJš
œT™Tšœ)œ˜FMš
œ˜Mš
œ˜Mš
œ˜—šœœ
œ
œ˜(Jš
œ ˜ Jš
œ ˜ M˜—M˜M˜—šžœœœœœœ˜|šœ)œ˜FMš
œ˜Mš
œ˜Mš
œ˜—šœœ
œ
œ˜(Jš
œ!˜!Jš
œ ˜ M˜—M˜——š
œ7™7šžœœ
œ
œœœ˜JMšœCœ
œ
œ
œœ
œ
œ˜nM˜—M˜šž
œœ
œœœœ
˜RMšœ œI˜oMšœœ
œ
œ
˜"Mšœ˜$M˜M˜—šžœœ
œœœœ
˜WMšœ œI˜oMšœœ
œ
œ
˜"Mšœ#˜)M˜M˜—šžœœ
œœœœ˜]Mšœ œI˜oMšœœ
œ
œ
˜"Mšœ#˜)M˜——š
œ™J˜šžœœ$˜Išœœ˜Jš
œ˜š
œ1˜1šœ
œ˜#Jš
œ˜Jš
œ˜Jš
œ˜—Jš
œ˜—J˜—J˜J˜—šžœœ&˜Mšœœ˜Jš
œ˜š
œ1˜1Jš
œ˜Jš
œ˜—J˜—J˜J˜——š
œ™J™šžœœ
œœ
œž
œœœœ˜rJšœœ
˜Jšœ
œ
˜Jšœœ˜3Jšœ˜"J˜M˜—šžœœ
œœž
œœœœ˜uMš	œœ
œœ
œ˜Mš
œ%˜%M˜M˜—šžœœ
œž
œœœœœ˜zJ™IMšœ	œŸ#˜KJšœœ
œ˜"šœœ
˜šœœ˜'J˜	JšœF˜LJ˜—šœœ˜)J˜šœ˜š
œ˜Mšœ1œ%˜ZMš
œ˜Mš
œ˜Mš
œ@˜@M˜—Mšœœ˜Mšœœ!˜9Mšœ
˜—Mšœ˜#M˜—Mšœ
˜—M˜M˜—šž
œœ
œž
œœœœœ
œœ˜˜
J™Jšœœ;˜CJ˜J˜—šž	œœ
œž
œœœœ
œœœ˜Ž
Jšœœ0˜GJš
œ˜J™—šžœœ
œœ
œž
œœœœ˜wJšœ
œ
˜Mš
œ˜Mšœœ˜Jš	œœ
œœœ
˜@Jšœœ
œœ
˜+Jš
œ˜Jš
œ˜Jšœœ ˜5Jš
œ˜šœ˜Jš
œ#˜#Mš
œ˜š	œœ
œœ˜5Jšœœ'˜>—Jš
œ˜Mšœ
˜—JšœŸ˜'Mšœœ˜$šœœ
œ˜Jš
œ˜Jš
œ˜Jšœ
˜—M˜J˜—šžœœ
œœž
œœœœ˜{Mš	œ
œ
œœ
œ˜!Mšœ*˜0M˜J˜—šž
œœ
œž
œœœœœ˜yJš
œ
˜
šœœ
œ˜#Jšœœ:˜QJšœ
˜—Jš
œ ˜ M˜J˜—šžœœ
œž
œœœœ
œ˜oJšœ
œ#˜4Jšœœ˜!J˜J˜—šž
œœ
œœž
œœœ˜bMšœ	œŸ#˜KJšœœŸ3˜IJšœœŸ+˜QJšœ Ÿ.˜NMšœŸ˜-Mš
œ˜Jšœœœ
œ˜+šœœ˜šœœ˜Jš
œ˜Jš
œ+˜+J˜—Jšœ
˜J˜—Jš
œ˜šœœ
˜Jšœ
œ+Ÿ˜TJšœœœ?˜tJ˜
š	œœ
œ
œ7˜LJšœœœS˜ˆ
J˜
Jšœ
˜—Jšœœ"˜:Jšœ9œ˜Xšœ
œ˜Jš
œ˜š
œ8˜8Jš
œ"˜"Jš
œ˜—J˜—šœœ˜!šœœ
˜šœœ˜7Mš
œ'˜'Mš
œ˜M˜—Mšœœ
˜—M˜
—Mšœ˜"Mšœ
˜—M˜J˜—šž
œœž
œœœœ˜bMšœ	œŸ#˜KJšœœŸ2˜JJšœœ
˜"Jšœœ
œ
œ˜+Mšœœ
œŸ˜6šœœ
˜Jš	œœœœœ˜Jšœœ˜)Jšœœ˜šœ˜Mš
œ*˜*JšœAœ˜`šœœ
˜Jšœœ)œ]˜’
Jš
œ+˜+Jšœ
˜—Jšœœ˜!Jšœ
˜—Jšœœ˜J˜—Jšœ
˜—M˜M˜——š
œ
™
J˜š
žœœ
œ#œœ˜^Jš
œ+˜+Jšœœ
˜Jšœœ
œ˜#Jšœœ
œ˜#Jšœœ
œ
˜(šœœ
˜šœœ˜'šœœ
˜šœœ˜'Jšœœ>˜FJšœHœ
œ˜`šœœ˜Jš
œ˜Jš
œ˜J˜—Jšœ
˜J˜—Jšœœ
˜—J˜—šœœ˜*šœœ
˜šœœ˜*Jš
œ!˜!šœœ˜0Jšœœ
˜šœ˜'š
œ"˜"šœ
œ˜Jš
œ˜Jš
œF˜FJ˜—Jšœ	œ˜#J˜—š
œ"˜"šœ
œ˜Jš
œ˜Jš
œH˜HJ˜—Jšœ	œ˜#J˜—š
œ"˜"š
œ˜Jš
œ˜Jš
œ˜˜	Jš
œ˜——šœ˜šœ
œ˜Jš
œ˜š
œI˜IJš
œ˜Jš
œ˜—J˜——š
˜Jšœœ
˜—Jšœ	œ˜#Jšœ	œ˜#J˜—Mšœ
˜—šœœ
œœ˜6šœœ
˜ šœœ˜:Mš
œ*˜*Mš
œ˜M˜—Mšœœ
˜—M˜
Mšœ!˜%—Mšœ
˜—Mšœœœ˜;š	œœ
œœ
˜7MšœœE˜`Mšœ˜—Mšœ˜M˜—Mšœœ
˜—Mš
œ˜—Mšœ
˜—M˜J˜—š
žœœ
œœœ˜[Jš
œ%˜%Jšœœ
œ˜'šœœ
˜šœœ˜&šœœ˜Jš
œ˜Jš
œF˜FJ˜—Jšœ
˜J˜—šœœ˜)Jš
œ˜šœ˜šœ
œ˜Jš
œ˜š
œ ˜ Jš
œ%˜%Jš
œ=˜=Jš
œ˜Jš
œ˜—J˜—Jšœœ˜ šœœ˜$šœœ
˜ šœœ˜:Mš
œ*˜*Mš
œ˜M˜—Mšœœ
˜—M˜
Mšœ!˜%—Jšœ
˜—J˜—Jšœ
˜—M˜J˜—š
žœœ
œ#œœ˜^Jšœ3˜9J˜J˜—š
žœœ
œ#œœ˜cJš
œ?˜?Jšœœœ
œ˜:Jšœœ
œ
˜(šœœ
˜šœœ˜'šœœ
˜šœœ˜'JšœœC˜Kšœœ˜Jš
œ˜Jš
œ˜J˜—Jšœ
˜J˜—Jšœœ
˜—J˜—šœœ˜*šœœ
˜šœœ˜*Jšœœ˜-Jš
œ˜šœ˜Jš
œ"˜"Jš
œ˜šœ˜!š
œ˜Jš
œ&˜&Jš
œ˜˜	Jš
œ˜——šœœ˜&Jš
œ˜š
œ"˜"Jš
œK˜KJš
œ˜Jš
œ˜—J˜—šœ#˜)šœœ
˜'šœœ˜AMš
œ8˜8Mš
œ(˜(M˜—Mšœ˜——Mšœ6˜:Jšœœ˜1Jšœ
˜—Jš
œ&˜&Jšœ	œ˜#Jšœ
˜—J˜—Mšœ˜—Mš
œ˜—Mšœ
˜—M˜M˜—š
ž	œœ
œ7œœ˜sJš
œ:™:Jšž
œœ"˜'Jš
œ#˜#Jšœœ˜2Jšœ%œ/œ
œ
˜dšœ:˜AJšœœR˜\Jšœ
œ;˜PJš
œK˜KJšœœ+˜GJšœœ,˜@Jšœ
˜—Jšœ˜˜J˜—J˜
—š
žœœ
œœœ˜YJš
ϩ
™©
Jš
œ%˜%Jšœœ
œ˜'šœœ
˜Jšœœœ˜6šœœ˜)Jšœœ˜Jš
œ!˜!šœœ ˜<Jšœ
œPœ˜išœœ˜Jšœ
œI˜VMš
œO˜OM˜
—šœ˜Mš
œ˜Mš
œK˜KMš
œœ
œœEœ
˜sMšœ$œ"˜LMš
œQ˜QM˜—Jšœœ˜šœœ˜$šœœ
˜ šœœ˜:Mš
œ*˜*Mš
œ˜M˜—Mšœœ
˜—M˜
Mšœ!˜%—Jšœ
˜—J˜—Jšœ
˜—M˜J˜——š
œ
™
šžœœ
œ#œœœœ˜]šœœ
˜šœœ˜$Jšœ;˜A—šœœ˜(Jšœ,˜2—Jšœ
˜—M˜J˜—š
žœœ
œœœ ˜cJšœœ
œ˜$Mš
œ
œ
œœ
œ
™*šœœ
˜šœœ˜$Jšœ0˜6—šœœ˜(Jšœ2˜8—Jšœ
˜—M˜J˜—š
žœœ
œœœ˜XJš
œ.˜.Jš
œ
œ
œœ
œ˜BM˜J˜—š
žœœ
œ#œœ˜dJš
œ1˜1šœ˜!Jšœœ˜Jšœ	œ˜Jšœ
˜—Jšœ
˜M˜——™	šžœœ
œœœœ˜GJšœœ
œ˜'šœœ
˜Jšœœœ˜9šœœ˜)šœ˜Mšœœ/Ÿ˜TMšœœ ˜1—M˜—Mšœ
˜—J˜J™—š
žœœ
œœœ	˜HJšœœ
œ˜ šœœ
˜Jšœœœ˜/Jšœœœ˜KJšœ
˜—J˜J˜——M˜J˜J˜Jšœ
˜—…—^n~Ε