<> <> DIRECTORY Rope, Basics, IO, Ascii, Convert, AlgebraClasses, Variables, Ints, Sequences, VariableSequences, DistribPolys; DistribPolysImpl: CEDAR PROGRAM IMPORTS Rope, IO, Ascii, Convert, AlgebraClasses, Variables, Ints, Sequences EXPORTS DistribPolys = BEGIN OPEN AC: AlgebraClasses, VARS: Variables, SEQ: Sequences, VARSEQ: VariableSequences, DistribPolys; <> ROPE: TYPE = Rope.ROPE; STREAM: TYPE = IO.STREAM; Object: TYPE = AC.Object; Method: TYPE = AC.Method; <> DollarProc: PUBLIC TermCharProc = { RETURN[char='$] }; RightBracketProc: PUBLIC TermCharProc = { RETURN[char='] OR char=')] }; BasicPolyTerminators: PUBLIC TermCharProc = { SELECT char FROM ', , '$ , '] , ') => RETURN[TRUE]; ENDCASE; RETURN[FALSE] }; DollarRope: PUBLIC Rope.ROPE _ " $"; <<>> <> <<>> ReadDPoly: PUBLIC PROC [in: IO.STREAM, V: VARSEQ.VariableSequence, coeffRing: AC.Object, termCharProc: TermCharProc _ BasicPolyTerminators] RETURNS [poly: DPolynomial, termChar: CHAR _ 000C] = { char: CHAR; firstTerm: BOOL _ TRUE; legalTermStartSeen: BOOL; coeff: AC.Object; sign: INTEGER; exponent: CARDINAL; degreeVec: DegreeVector; variable: Object; varIndexInt: Ints.Int; varIndex: CARDINAL; ReadDPFail: PUBLIC ERROR [subclass: ATOM _ $Unspecified] = CODE; ok: BOOL; zero: AC.Object _ AC.ApplyLkpNoRecastObject[$zero, coeffRing, LIST[coeffRing] ]; one: AC.Object _ AC.ApplyLkpNoRecastObject[$one, coeffRing, LIST[coeffRing] ]; legalFirstCharMethod: Method _ AC.LookupMethodInStructure[$legalFirstChar, coeffRing]; readMethod: Method _ AC.LookupMethodInStructure[$read, coeffRing]; equalMethod: Method _ AC.LookupMethodInStructure[$eqFormula, coeffRing]; negateMethod: Method _ AC.LookupMethodInStructure[$negation, coeffRing]; poly _ NIL; []_ in.SkipWhitespace[]; <> IF in.PeekChar[] = '0 THEN { [] _ in.GetChar[]; -- toss it (assumes that we can strip a leading zero) []_ in.SkipWhitespace[]; IF in.EndOf[] THEN RETURN[ZeroDPoly]; char _ in.PeekChar[]; IF char = '$ THEN RETURN[ZeroDPoly, in.GetChar[] ]; IF termCharProc[char] THEN RETURN[ZeroDPoly, char]; }; <> DO <> legalTermStartSeen _ FALSE; sign _ 1; coeff _ one; -- default term is +1 degreeVec _ NIL; <> []_ in.SkipWhitespace[]; IF in.PeekChar[] = '- THEN { sign _ -1; [] _ in.GetChar[]; -- toss it []_ in.SkipWhitespace[]; } ELSE IF in.PeekChar[] = '+ THEN { [] _ in.GetChar[]; -- toss it []_ in.SkipWhitespace[]; } ELSE IF NOT firstTerm THEN ERROR; firstTerm _ FALSE; <> IF AC.ApplyLegalFirstCharMethod[legalFirstCharMethod, in.PeekChar[], coeffRing] THEN { legalTermStartSeen _ TRUE; coeff _ AC.ApplyReadMethod[readMethod, in, coeffRing]; []_ in.SkipWhitespace[]; IF AC.ApplyPredNoLkpNoRecast[equalMethod, LIST[coeff, zero] ] THEN ERROR ReadDPFail[$ZeroCoefficient]; -- zero coeff not allowed }; IF sign < 1 THEN coeff _ AC.ApplyNoLkpNoRecastObject[negateMethod, LIST[coeff] ]; -- if sign < 1, then negate either coeff read or default coeff of 1 <> WHILE NOT in.EndOf[] AND (Ascii.Letter[in.PeekChar[]] OR in.PeekChar[]='*) DO legalTermStartSeen _ TRUE; exponent _ 1; IF in.PeekChar[] = '* THEN { [] _ in.GetChar[]; -- toss * multiplication []_ in.SkipWhitespace[]; }; variable _ VARS.FromRope[in.GetID[] ]; varIndexInt _ SEQ.Find[V, variable]; IF varIndexInt = NIL THEN ERROR ReadDPFail[$UnknownVariable]; varIndex _ Ints.ToINT[varIndexInt]; []_ in.SkipWhitespace[]; IF NOT in.EndOf[] THEN IF in.PeekChar[] = '* OR in.PeekChar[] = '^ THEN { char _ in.GetChar[]; -- toss (could be either * multiplication, first char of ** exponentiation, or ^ exponentiation, here) []_ in.SkipWhitespace[]; } ELSE char _ 'X; -- anything IF NOT in.EndOf[] THEN IF (char = '* AND in.PeekChar[] = '*) OR char = '^ THEN { -- allow ** or ^ exponentiation IF in.PeekChar[] = '* THEN [] _ in.GetChar[]; -- toss []_ in.SkipWhitespace[]; SELECT in.PeekChar[] FROM IN ['0..'9] => { exponent _ in.GetCard; []_ in.SkipWhitespace[]; IF exponent = 0 THEN ERROR ReadDPFail[$ZeroExponent]; }; ENDCASE=> ERROR ReadDPFail[$NonNumericExponent]; }; [ok, degreeVec] _ DVInsertVariablePower[varIndex, exponent, degreeVec]; IF NOT ok THEN ERROR ReadDPFail[$RepeatedVariable]; ENDLOOP; <> IF legalTermStartSeen THEN { [ok, poly] _ DPInsertTerm[coeff, degreeVec, poly]; IF NOT ok THEN ERROR ReadDPFail[$RepeatedMonomial]; } ELSE ERROR ReadDPFail[$UnexpectedCharacter]; IF in.EndOf[] THEN RETURN[poly]; char _ in.PeekChar[]; IF char = '$ THEN RETURN[poly, in.GetChar[] ]; IF termCharProc[char] THEN RETURN[poly, char ]; ENDLOOP; }; DPolyFromRope: PUBLIC PROC [in: Rope.ROPE, V: VARSEQ.VariableSequence, coeffRing: AC.Object, termCharProc: TermCharProc _ BasicPolyTerminators] RETURNS [out: DPolynomial] = { stream: IO.STREAM _ IO.RIS[in]; termChar: CHAR; [out, termChar ] _ ReadDPoly[stream, V, coeffRing, termCharProc]; }; DPolyToRope: PUBLIC PROC [in: DPolynomial, V: VARSEQ.VariableSequence, coeffRing: AC.Object, termRope: Rope.ROPE _ NIL] RETURNS [out: Rope.ROPE]={ firstTerm: BOOL _ TRUE; trivialMonomial: BOOL; coeff, coeffAbs: AC.Object; degreeVec: DegreeVector; coeffSign: Basics.Comparison; exponent, index: CARDINAL; one: AC.Object _ AC.ApplyLkpNoRecastObject[$one, coeffRing, LIST[coeffRing] ]; equalMethod: Method _ AC.LookupMethodInStructure[$eqFormula, coeffRing]; toRopeMethod: Method _ AC.LookupMethodInStructure[$toRope, coeffRing]; isOrdered: BOOL _ AC.HasProperty[coeffRing, $ordered]; signMethod, absMethod: Method; IF in = ZeroDPoly THEN RETURN[Rope.Concat["0", termRope]]; out _ ""; IF isOrdered THEN { signMethod _ AC.LookupMethodInStructure[$sign, coeffRing]; absMethod _ AC.LookupMethodInStructure[$abs, coeffRing]; }; WHILE in#NIL DO [coeff, degreeVec] _ in.first; in _ in.rest; IF isOrdered THEN { coeffSign _ AC.ApplyCompareToZeroMethod[signMethod, coeff]; coeffAbs _ AC.ApplyNoLkpNoRecastObject[absMethod, LIST[coeff] ] } ELSE { -- for unordered coeffRing, act as though coeff is positive coeffSign _ greater; coeffAbs _ coeff; }; IF coeffSign = less THEN out _ Rope.Concat[out,"- "] ELSE IF NOT firstTerm THEN out _ Rope.Concat[out,"+ "]; firstTerm _ FALSE; IF NOT AC.ApplyPredNoLkpNoRecast[equalMethod, LIST[coeffAbs, one] ] THEN out _ Rope.Cat[out, NARROW[AC.ApplyNoLkpNoRecastRef[toRopeMethod, LIST[coeffAbs] ] ], " "]; trivialMonomial _ TRUE; degreeVec _ DVReverse[degreeVec]; WHILE degreeVec#NIL DO trivialMonomial _ FALSE; exponent _ degreeVec.first; degreeVec _ degreeVec.rest; index _ degreeVec.first; degreeVec _ degreeVec.rest; out _ Rope.Concat[out, VARS.ToRope[SEQ.Select[V, Ints.FromINT[index] ] ] ]; <1 THEN out _ Rope.Cat[out, "^", Convert.RopeFromCard[exponent]];>> IF exponent>1 THEN out _ Rope.Cat[out, "**", Convert.RopeFromCard[exponent]]; -- temp change 5/21/87 for Bridging to SAC-2 out _ Rope.Concat[out," "]; ENDLOOP; IF trivialMonomial AND AC.ApplyPredNoLkpNoRecast[equalMethod, LIST[coeffAbs, one] ] THEN out _ Rope.Cat[out, NARROW[AC.ApplyNoLkpNoRecastRef[toRopeMethod, LIST[one] ] ], " "]; ENDLOOP; out _ Rope.Concat[out, termRope]; }; WriteDPoly: PUBLIC PROC [in: DPolynomial, V: VARSEQ.VariableSequence, coeffRing: AC.Object, out: IO.STREAM, termRope: Rope.ROPE _ NIL] = { polyRope: Rope.ROPE _ DPolyToRope[in, V, coeffRing]; out.PutF["\n %g \n", IO.rope[polyRope] ]; }; <<>> DPInsertTerm: PROC [coefficient: AC.Object, degreeVec: DegreeVector, inPoly: DPolynomial] RETURNS [ok: BOOL, outPoly: DPolynomial] ~ { <> <> nextCoeff: AC.Object; nextDegreeVec: DegreeVector; poly: DPolynomial _ inPoly; degreeVecComparison: [-1..1]; ok _ TRUE; IF inPoly=NIL THEN { outPoly_CONS[ [coefficient, degreeVec], NIL ]; RETURN }; outPoly _ inPoly; [nextCoeff, nextDegreeVec] _ poly.first; poly _ poly.rest; degreeVecComparison _ DVCompare[degreeVec, nextDegreeVec]; SELECT degreeVecComparison FROM 0 => { ok _ FALSE; RETURN }; 1 => { outPoly_CONS[ [coefficient, degreeVec], inPoly ]; RETURN }; ENDCASE; outPoly _ CONS[ [nextCoeff, nextDegreeVec], NIL]; WHILE poly# NIL DO [nextCoeff, nextDegreeVec] _ poly.first; poly _ poly.rest; degreeVecComparison _ DVCompare[degreeVec, nextDegreeVec]; SELECT degreeVecComparison FROM 0 => { outPoly _ inPoly; ok _ FALSE; RETURN }; 1 => { outPoly _ CONS[ [nextCoeff, nextDegreeVec], CONS[ [coefficient, degreeVec], outPoly] ]; outPoly _ DPReverse[outPoly]; outPoly _ DPNconc[outPoly, poly]; RETURN }; ENDCASE; outPoly _ CONS[ [nextCoeff, nextDegreeVec], outPoly]; ENDLOOP; outPoly _ CONS[ [coefficient, degreeVec], outPoly]; outPoly _ DPReverse[outPoly]; }; DPNconc: PROC [l1, l2: DPolynomial] RETURNS [DPolynomial] ~ { z: DPolynomial _ l1; IF z = NIL THEN RETURN[l2]; UNTIL z.rest = NIL DO z _ z.rest; ENDLOOP; z.rest _ l2; RETURN[l1]; }; DPReverse: PUBLIC PROC [list: DPolynomial] RETURNS[val: DPolynomial] = { val _ NIL; UNTIL list = NIL DO val _ CONS[list.first, val]; list _ list.rest; ENDLOOP; RETURN[val]; }; -- of Reverse <> DVInsertVariablePower: PUBLIC PROC [varIndex, exponent: CARDINAL, inDegreeVec: DegreeVector] RETURNS [ok: BOOL, outDegreeVec: DegreeVector] ~ { <> <> nextIndex, nextExponent: CARDINAL; degreeVec: DegreeVector _ inDegreeVec; outDegreeVec _ inDegreeVec; ok _ TRUE; IF inDegreeVec=NIL THEN { IF exponent=0 THEN RETURN ELSE { outDegreeVec_CONS[varIndex, CONS[ exponent, NIL] ]; RETURN } }; nextIndex _ degreeVec.first; degreeVec _ degreeVec.rest; nextExponent _ degreeVec.first; degreeVec _ degreeVec.rest; SELECT varIndex FROM = nextIndex => { ok _ FALSE; RETURN }; > nextIndex => IF exponent=0 THEN RETURN ELSE { outDegreeVec_CONS[varIndex, CONS[exponent, inDegreeVec] ]; RETURN }; ENDCASE; outDegreeVec _ CONS[nextExponent, CONS[nextIndex, NIL]]; WHILE degreeVec# NIL DO nextIndex _ degreeVec.first; degreeVec _ degreeVec.rest; nextExponent _ degreeVec.first; degreeVec _ degreeVec.rest; SELECT varIndex FROM = nextIndex => { outDegreeVec _ inDegreeVec;ok _ FALSE; RETURN }; > nextIndex => IF exponent=0 THEN { outDegreeVec _ inDegreeVec; RETURN } ELSE { outDegreeVec_DVCons4[nextExponent, nextIndex, exponent, varIndex, outDegreeVec]; outDegreeVec _ DVReverse[outDegreeVec]; outDegreeVec _ DVNconc[outDegreeVec, degreeVec]; RETURN }; ENDCASE; outDegreeVec _ CONS[nextExponent, CONS[nextIndex, outDegreeVec]]; ENDLOOP; outDegreeVec _ CONS[exponent, CONS[varIndex, outDegreeVec]]; outDegreeVec _ DVReverse[outDegreeVec]; }; DVCompare: PUBLIC PROC [dv1, dv2: DegreeVector] RETURNS [ [-1..1] ] ~ { index1, index2, exponent1, exponent2: CARDINAL; WHILE dv1#NIL AND dv2#NIL DO index1 _ dv1.first; dv1 _ dv1.rest; exponent1 _ dv1.first; dv1 _ dv1.rest; index2 _ dv2.first; dv2 _ dv2.rest; exponent2 _ dv2.first; dv2 _ dv2.rest; IF index1 > index2 THEN RETURN[1]; IF index1 < index2 THEN RETURN[-1]; IF exponent1 > exponent2 THEN RETURN[1]; IF exponent1 < exponent2 THEN RETURN[-1]; ENDLOOP; IF dv1#NIL THEN RETURN[1]; IF dv2#NIL THEN RETURN[-1]; RETURN[0]; }; DVDegree: PUBLIC PROC [degreeVec: DegreeVector, numVars: CARDINAL] RETURNS [degree: CARDINAL] ~ { IF degreeVec = NIL THEN RETURN[0]; IF degreeVec.first = numVars THEN RETURN[degreeVec.rest.first] ELSE RETURN[0]; }; DVRemoveMainVariablePower: PUBLIC PROC [in: DegreeVector, numVars: CARDINAL] RETURNS [out: DegreeVector] ~ { IF in = NIL THEN RETURN[NIL]; IF in.first = numVars THEN RETURN [in.rest.rest] ELSE RETURN[in]; }; DVAddMainVariablePower: PUBLIC PROC [in: DegreeVector, varIndex, exponent: CARDINAL] RETURNS [out: DegreeVector] ~ { IF exponent>0 THEN RETURN[ CONS[varIndex, CONS[ exponent, in] ] ] ELSE RETURN[in]; }; DVCons4: PUBLIC PROC [x1, x2, x3, x4: CARDINAL, degreeVec: DegreeVector] RETURNS [DegreeVector] ~ { RETURN[ CONS[x1, CONS[x2, CONS[x3, CONS[x4, degreeVec]]]] ]; }; DVNconc: PUBLIC PROC [l1, l2: DegreeVector] RETURNS [DegreeVector] ~ { z: DegreeVector _ l1; IF z = NIL THEN RETURN[l2]; UNTIL z.rest = NIL DO z _ z.rest; ENDLOOP; z.rest _ l2; RETURN[l1]; }; DVReverse: PUBLIC PROC [list: DegreeVector] RETURNS[val: DegreeVector] = { val _ NIL; UNTIL list = NIL DO val _ CONS[list.first, val]; list _ list.rest; ENDLOOP; RETURN[val]; }; -- of Reverse END.