PolynomialsImpl.mesa
Last Edited by: Arnon, June 10, 1985 4:19:22 pm PDT
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;
Classes for Polynomial Rings
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] ];
Legal first char of polynomial is either legal first char of coefficient, or first char of some variable.
};
ClassRead: AC.ReadOp = {
data: PolynomialRingData ← NARROW[structure.instanceData];
RETURN[ReadPoly[in, data.variables, data.coeffRing] ];
};
ClassFromRope: AC.FromRopeOp = {
stream: IO.STREAMIO.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]];
structuredProp: Atom.DottedPair ← NEW[Atom.DottedPairNode← [$Structured, $Structured]];
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]
] ];
Polynomial Ring Constructors
PolynomialsOverRing: PUBLIC PROC [coeffRing: AC.Structure, V: VARS.VariableSeq] RETURNS [polynomialRing: AC.Structure] ~ {
A particular polynomialRing is defined by its coefficient domain, and its variables.
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
] ];
};
Extract Polynomial Operations from Class Property Lists
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];
};
Constructors
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 ]
] ] ];
};
Conversion and IO
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.STREAMIO.RIS[in];
out ← ReadPoly[stream, V, coeffRing];
};
PolyFullRepToRope: PUBLIC PROC [in: Polynomial, V: VARS.VariableSeq, coeffRing: AC.Structure] RETURNS [out: Rope.ROPE] = {
Dump the internal representation in a more reasonable form than SAC-2 rep
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.ROPEDP.DollarRope] RETURNS [out: Rope.ROPE] = {
Display in a reasonable format
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.ROPEDP.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.STREAMIO.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;
};
Arithmetic
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] ~ {
Note that structure arg is poly ring, not coefficient ring
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] ~ {
Assumes that CARDINAL exponent values can be imbedded in coeffRing, in particular, that coeffRing.class.fromRope[Convert.RopeFromCard[input.leadingTerm.exponent]] works.
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;
};
Comparison
Equal: PUBLIC PROC [in1, in2: Polynomial, coeffRing: AC.Structure] RETURNS [BOOLFALSE] ~ {
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];
IF NOT AC.IsOrdered[coeffRing] THEN ERROR;
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];
};
Selection
LeadingCoeff: PUBLIC PROC [in: Polynomial] RETURNS [out: REFNIL] ~ {
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.