DIRECTORYRope,IO,Atom,AlgebraClasses,MathExpr,MathConstructors,BigRats,RatIntervals,Polynomials,AlgebraicNumbers;AlgebraicNumbersImpl: CEDAR PROGRAMIMPORTS Rope, IO, RatIntervals, BigRats, Atom, AlgebraClasses, MathConstructors EXPORTS AlgebraicNumbers =BEGIN OPEN AC: AlgebraClasses, BR: BigRats, RI: RatIntervals, POL: Polynomials, AlgebraicNumbers;BadGroundField: PUBLIC ERROR [groundStructure: AC.Structure] = CODE;SyntaxError: PUBLIC ERROR [kind: ATOM _ $Unspecified] = CODE;ClassPrintName: AC.PrintNameProc = {out: Rope.ROPE _ "Field of all ";data: FieldOfAlgebraicNumbersData _ NARROW[structure.instanceData];IF data.real THEN out _ Rope.Concat[out, "real "];out _ Rope.Cat[out, "algebraic numbers over ", data.groundField.class.printName[data.groundField] ];RETURN[out];};ClassShortPrintName: AC.PrintNameProc = {out: Rope.ROPE;data: FieldOfAlgebraicNumbersData _ NARROW[structure.instanceData];IF data.real THEN out _ "RAN(" ELSE out _ "AN(";out _ Rope.Cat[out,data.minPolyRing.class.shortPrintName[data.minPolyRing],")"];RETURN[out];};ClassIsElementOf: AC.ElementOfProc = {IF NOT structure.class.structureEqual[structure, item.structure] THEN RETURN[FALSE];RETURN[ TRUE ]}; ClassLegalFirstChar: AC.LegalFirstCharOp = {SELECT char FROM'[ , '(=> RETURN[TRUE];ENDCASE;RETURN[FALSE];};ClassToExpr: AC.ToExprOp = {data: FieldOfAlgebraicNumbersData _ NARROW[in.structure.instanceData];inData: AlgebraicNumberData _ NARROW[in.data];outColumn: LIST OF MathExpr.EXPR _ LIST[inData.minimalPolynomial.structure.class.toExpr[inData.minimalPolynomial] ];IF data.real THEN {outColumn.rest _ LIST[inData.isolatingInterval.structure.class.toExpr[inData.isolatingInterval] ];out _  MathConstructors.MakeVector[2, outColumn, FALSE]}ELSE out _  MathConstructors.MakeVector[1, outColumn, FALSE];}; ClassCharacteristic: AC.StructureRankOp = {RETURN[ 0 ]}; fieldOfAlgebraicNumbersOps: FieldOfAlgebraicNumbersOps _ NEW[FieldOfAlgebraicNumbersOpsRec _ [makeAlgebraicNumber: MakeAlgebraicNum] ];fieldOfAlgebraicNumbersProp: Atom.DottedPair _ NEW[Atom.DottedPairNode_ [$FieldOfAlgebraicNumbers, fieldOfAlgebraicNumbersOps]];RealAlgebraicNumbersClass: PUBLIC AC.StructureClass _ NEW[AC.StructureClassRec _ [category: set,printName: ClassPrintName,shortPrintName: ClassShortPrintName,structureEqual: AC.defaultStructureEqualityTest,characteristic: ClassCharacteristic,isElementOf: ClassIsElementOf,legalFirstChar: ClassLegalFirstChar,read: Read,fromRope: FromRope,toRope: ToRope,write: Write,toExpr: ClassToExpr,integralDomain: FALSE,gcdDomain: FALSE,euclideanDomain: FALSE,completeField: TRUE,realField: TRUE,realClosedField: TRUE,algebraicallyClosedField: FALSE,propList: LIST[fieldOfAlgebraicNumbersProp]] ];AlgebraicNumbersClass: PUBLIC AC.StructureClass _ NEW[AC.StructureClassRec _ [category: set,printName: ClassPrintName,shortPrintName: ClassShortPrintName,structureEqual: AC.defaultStructureEqualityTest,characteristic: ClassCharacteristic,isElementOf: ClassIsElementOf,legalFirstChar: ClassLegalFirstChar,read: Read,fromRope: FromRope,toRope: ToRope,write: Write,toExpr: ClassToExpr,integralDomain: FALSE,gcdDomain: FALSE,euclideanDomain: FALSE,completeField: TRUE,realField: FALSE,realClosedField: FALSE,algebraicallyClosedField: TRUE,propList: LIST[fieldOfAlgebraicNumbersProp]] ];MakeFieldOfAlgebraicNumbers: PUBLIC PROC [minPolyRing: AC.Structure, real: BOOL] RETURNS [fieldOfAlgebraicNumbers: AC.Structure] ~ {polyRingData: POL.PolynomialRingData _ NARROW[minPolyRing.instanceData]; groundField: AC.Structure _ polyRingData.coeffRing;fieldOfAlgebraicNumbersData: FieldOfAlgebraicNumbersData _ NEW[FieldOfAlgebraicNumbersDataRec _ [groundField: groundField,minPolyRing: minPolyRing,real: real] ];IF groundField.class.category#field AND groundField.class.category#divisionAlgebra THEN ERROR;IF real THEN RETURN[ NEW[AC.StructureRec _ [class: RealAlgebraicNumbersClass,instanceData: fieldOfAlgebraicNumbersData] ] ]ELSE RETURN[ NEW[AC.StructureRec _ [class: AlgebraicNumbersClass,instanceData: fieldOfAlgebraicNumbersData] ] ];};IsFieldOfAlgebraicNumbers: PUBLIC PROC [structure: AC.Structure] RETURNS [BOOL] ~ {IF Atom.GetPropFromList[structure.class.propList, $FieldOfAlgebraicNumbers] # NIL THEN RETURN[TRUE] ELSE RETURN[FALSE];};MakeAlgebraicNumber: PUBLIC PROC [structure: AC.Structure] RETURNS [AC.BinaryImbedOp] ~ {IF IsFieldOfAlgebraicNumbers[structure] THEN {ops: FieldOfAlgebraicNumbersOps  _ NARROW[ Atom.GetPropFromList[structure.class.propList, $FieldOfAlgebraicNumbers] ];RETURN[ops.makeAlgebraicNumber];}ELSE ERROR;};MakeAlgebraicNum: PUBLIC AC.BinaryImbedOp ~ {fieldOfAlgebraicNumbersData: FieldOfAlgebraicNumbersData _ NARROW[structure.instanceData];minPolyRing: AC.Structure _ fieldOfAlgebraicNumbersData.minPolyRing;groundField: AC.Structure _ fieldOfAlgebraicNumbersData.groundField;outData: AlgebraicNumberData;IF NOT fieldOfAlgebraicNumbersData.real THEN {IF groundField.class.algebraicallyClosedField THEN ERROR;outData _ NEW[AlgebraicNumberDataRec _ [minimalPolynomial: data1]]}ELSE {IF NOT groundField.class.realField THEN ERROR;IF groundField.class.realClosedField THEN ERROR;outData _ NEW[AlgebraicNumberDataRec _ [minimalPolynomial: data1,isolatingInterval: NARROW[data2]]]};out _ NEW[AC.ObjectRec _ [structure: structure, data: outData] ];};Read: PUBLIC AC.ReadOp ~ {fieldData: FieldOfAlgebraicNumbersData _ NARROW[structure.instanceData];minPolyRing: AC.Structure _ fieldData.minPolyRing; groundField: AC.Structure _ fieldData.groundField;minimalPolynomial: POL.Polynomial;data: POL.PolynomialRingData _ NARROW[minPolyRing.instanceData];puncChar: CHAR;outData: AlgebraicNumberData;IF groundField # BR.BigRats THEN ERROR BadGroundField[groundField]; --temporarily []_ in.SkipWhitespace[];puncChar _ in.GetChar[];IF puncChar # '( AND puncChar # '[ THEN ERROR;minimalPolynomial _ NARROW[minPolyRing.class.read[in, minPolyRing] ]; -- should check monic, irreducibleIF NOT fieldData.real THEN {IF groundField.class.algebraicallyClosedField THEN ERROR;outData _  NEW[AlgebraicNumberDataRec _ [minimalPolynomial: minimalPolynomial]]}ELSE {isolatingInterval: RI.RatInterval;[]_ in.SkipWhitespace[];puncChar _ in.GetChar[];IF puncChar # ', THEN SyntaxError[$CommaExpected];[]_ in.SkipWhitespace[];isolatingInterval _ RI.RatIntervals.class.read[in, RI.RatIntervals];outData _  NEW[AlgebraicNumberDataRec _ [minimalPolynomial: minimalPolynomial,isolatingInterval: isolatingInterval]]};[]_ in.SkipWhitespace[];puncChar _ in.GetChar[];IF puncChar # ') AND puncChar # '] THEN ERROR;out _ NEW[AC.ObjectRec _ [structure: structure, data: outData] ];};FromRope: PUBLIC AC.FromRopeOp = {out _ Read[IO.RIS[in], structure];};ToRope: PUBLIC AC.ToRopeOp ~ {inData: AlgebraicNumberData _ NARROW[in.data];fieldData: FieldOfAlgebraicNumbersData _ NARROW[in.structure.instanceData];out _ Rope.Concat["(",inData.minimalPolynomial.structure.class.toRope[inData.minimalPolynomial] ];IF fieldData.real THEN out _ Rope.Cat[out, ", ", RI.RatIntervals.class.toRope[inData.isolatingInterval] ];out _ Rope.Concat[out, ")"];};ToIndexRope: PUBLIC AC.ToRopeOp ~ {inData: AlgebraicNumberData _ NARROW[in.data];fieldData: FieldOfAlgebraicNumbersData _ NARROW[in.structure.instanceData];IF fieldData.real THEN out _ "RealAlgNum" ELSE out _ "AlgNum";};Write: PUBLIC AC.WriteOp = {stream.PutRope[ ToRope[in] ]}; END.     AlgebraicNumbersImpl.mesaLast Edited by: Arnon, July 19, 1985 2:54:46 pm PDTErrorsClass for Fields of Algebraic NumbersAssumes that if item is a point, then it really belongs to the domain pointed to by its structure field.ClassAdd: AC.BinaryOp = {firstPoint: Point _ NARROW[firstArg];secondPoint: Point _ NARROW[secondArg];IF NOT firstPoint.structure.class.structureEqual[firstPoint.structure, secondPoint.structure] THEN TypeError[];RETURN[ Add[firstPoint, secondPoint] ]}; ClassNegate: AC.UnaryOp = {point: Point _ NARROW[arg];RETURN[ Negate[point] ]}; ClassSubtract: AC.BinaryOp = {firstPoint: Point _ NARROW[firstArg];secondPoint: Point _ NARROW[secondArg];IF NOT firstPoint.structure.class.structureEqual[firstPoint.structure, secondPoint.structure] THEN TypeError[];RETURN[ Subtract[firstPoint, secondPoint] ]}; ClassZero: AC.NullaryOp = {data: FieldOfAlgebraicNumbersData _ NARROW[structure.instanceData];RETURN[ DiagPoint[data.coordinateStructure.class.zero[data.coordinateStructure], structure] ]}; ClassMultiply: AC.BinaryOp = {firstPoint: Point _ NARROW[firstArg];secondPoint: Point _ NARROW[secondArg];IF NOT firstPoint.structure.class.structureEqual[firstPoint.structure, secondPoint.structure] THEN TypeError[];RETURN[ Multiply[firstPoint, secondPoint] ]}; ClassOne: AC.NullaryOp = {data: FieldOfAlgebraicNumbersData _ NARROW[structure.instanceData];RETURN[ DiagPoint[data.coordinateStructure.class.one[data.coordinateStructure], structure] ]}; ClassEqual: AC.EqualityOp = {firstPoint: Point _ NARROW[firstArg];secondPoint: Point _ NARROW[secondArg];IF NOT firstArg.structure.class.structureEqual[firstArg.structure, secondPoint.structure] THEN TypeError[];RETURN[ Equal[firstArg, secondPoint] ]}; add: ClassAdd,negate: ClassNegate,subtract: ClassSubtract,zero: ClassZero,multiply: ClassMultiply,commutative: FALSE,one: ClassOne,equal: Equal,add: ClassAdd,negate: ClassNegate,subtract: ClassSubtract,zero: ClassZero,multiply: ClassMultiply,commutative: FALSE,one: ClassOne,equal: Equal,Field of Algebraic Numbers ConstructorExtract Field of Algebraic Numbers Operations from Class Property ListConstructorIOÊž  ˜ Jšœ™J™3J™ šÏk	˜	Jšœ˜Icodešœ˜K˜Jšœ˜J˜	J˜J˜Jšœ˜Jšœ˜Jšœ˜—J˜ head2šœœ˜#JšœI˜PJšœ˜J˜ —Jšœœœœœœ ˜ahead™Jš	œœœœœ˜DJš	œœœœœ˜=—šœ%™%šÏnœœ˜$Jšœ
œ˜!Jšœ$œ˜CJšœœ!˜2Jšœd˜dJšœ˜J˜—šžœœ˜)Jšœ
œ˜Jšœ$œ˜CJšœœ˜0šœ˜Jšœ8˜8Jšœ˜—Jšœ˜J˜—šžœœ˜&J™hJš
œœ;œœœ˜TJšœœ˜Jšœ˜—šžœœ˜,šœ˜Kšœ
œœ˜Kšœ˜—Kšœœ˜J˜—šžœœ˜Jšœ$œ˜FJšœœ
˜.š	œœœ
œœ˜(JšœL˜L—šœœ˜šœœ˜JšœL˜L—Jšœ1œ˜7J˜—Jšœ2œ˜=Jšœ˜—šžœœ˜+Jšœ˜Jšœ˜—šžœœ™Jšœœ™%Jšœœ™'JšœœXœ™oJšœ ™&Jšœ™—šžœœ™Jšœœ™Jšœ™Jšœ™—šžœœ™Jšœœ™%Jšœœ™'JšœœXœ™oJšœ%™+Jšœ™—šž	œœ™Jšœ$œ™CJšœW™]Jšœ™—šžœœ™Jšœœ™%Jšœœ™'JšœœXœ™oJšœ%™+Jšœ™—šžœœ™Jšœ$œ™CJšœV™\Jšœ™—šž
œœ™Jšœœ™%Jšœœ™'JšœœTœ™kJšœ ™&Jšœ™—šœ9œ"˜^Kšœž˜%K˜—Kšœ/œN˜€K™ š	œœœœœ˜RJšœ˜Jšœ˜Jšœ$˜$Kšœœ˜0Jšœ$˜$J˜ Kšœ˜J˜ Jšœ$˜$Jšœ˜Jšœ˜Jšœ˜Jšœ˜Jšœ˜J˜ Kšœ™Kšœ™Kšœ™Kšœ™K˜ Kšœ™Kšœœ™Kšœ™K˜ Kšœ™K˜ Kšœœ˜Kšœœ˜Kšœœ˜K˜ Kšœœ˜Kšœœ˜Kšœœ˜Kšœœ˜ K˜ K˜ Jšœ
œ˜+K˜K˜ —š	œœœœœ˜NJšœ˜Jšœ˜Jšœ$˜$Kšœœ˜0Jšœ$˜$J˜ Kšœ˜J˜ Jšœ$˜$Jšœ˜Jšœ˜Jšœ˜Jšœ˜Jšœ˜J˜ Kšœ™Kšœ™Kšœ™Kšœ™K˜ Kšœ™Kšœœ™Kšœ™K˜ Kšœ™K˜ Kšœœ˜Kšœœ˜Kšœœ˜K˜ Kšœœ˜Kšœœ˜Kšœœ˜Kšœœ˜K˜ Jšœ
œ˜+K˜K˜ —K˜ —šœ&™&K˜ šžœœœœœœœ˜„Kšœœœ˜IKšœœ$˜3šœ;œ#˜aKšœ˜Kšœ˜Kšœ
˜
Kšœ˜—Kšœ"œ,œœ˜^š
œœœœœ˜,Jšœ!˜!Jšœ)˜)K˜—šœœœœ˜$Jšœ˜Jšœ)˜)K˜—K˜K˜ ——šœF™Fšžœœœœœœ˜SKšœLœœœœœœœ˜wK˜K˜ —šžœœœœœœžœ˜Yšœžœœ˜.Kšœ#œM˜vKšœžœ˜ K˜—Kšœœ˜K˜K˜ ——šœ™šžœœœ˜-Kšœ;œ˜ZKšœœ5˜DJšœœ5˜DJšœ˜šœœ"œ˜.Kšœ,œœ˜9šœ
œ˜(Jšœ˜Jšœ˜—J˜—šœ˜Kšœœœœ˜.Kšœ#œœ˜0šœ
œ˜(Jšœ˜Jšœ ˜ Jšœ˜—J˜—Jšœœœ5˜AJ˜——™šžœœžœ˜Jšœ)œ˜HJšœœ$˜3Jšœœ#˜2JšœœÏc˜"Jšœœœ˜@Jšœ
œ˜Jšœ˜Kš	œœ	œœŸ˜RJšœ˜Jšœ˜Jšœœœœ˜.Jšœœ,Ÿ"˜hšœœ˜Kšœ,œœ˜9šœœ˜)Jšœ$˜$Jšœ˜—J˜—šœ˜Jšœœ˜"Jšœ˜Jšœ˜Jšœœ˜2Jšœ˜Jšœœœ˜Dšœœ˜)Jšœ%˜%Jšœ$˜$Jšœ˜—J˜—Jšœ˜Jšœ˜Jšœœœœ˜.Jšœœœ5˜AK˜J˜ —šžœœž
œ˜"Jšœœœ˜"Jšœ˜J™ —šžœœžœ˜Jšœœ
˜.Jšœ)œ˜Kšœ˜Jšœ˜JšœL˜L—Jšœœœ7˜jJšœ˜J˜J˜ —šžœ	œ˜#Jšœœ
˜.Jšœ)œ˜KJšœœ(˜>J˜J˜ —šžœœ˜Jšœ˜Jšœ˜J˜ —J˜ —Jšœ˜— …—    v  1¤  