AlgebraicNumbersImpl.mesa
Last Edited by: Arnon, July 19, 1985 2:54:46 pm PDT
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;
Errors
BadGroundField: PUBLIC ERROR [groundStructure: AC.Structure] = CODE;
SyntaxError: PUBLIC ERROR [kind: ATOM ← $Unspecified] = CODE;
Class for Fields of Algebraic Numbers
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 = {
Assumes that if item is a point, then it really belongs to the domain pointed to by its structure field.
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 ]
};
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] ]
};
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,
add: ClassAdd,
negate: ClassNegate,
subtract: ClassSubtract,
zero: ClassZero,
multiply: ClassMultiply,
commutative: FALSE,
one: ClassOne,
equal: Equal,
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,
add: ClassAdd,
negate: ClassNegate,
subtract: ClassSubtract,
zero: ClassZero,
multiply: ClassMultiply,
commutative: FALSE,
one: ClassOne,
equal: Equal,
integralDomain: FALSE,
gcdDomain: FALSE,
euclideanDomain: FALSE,
completeField: TRUE,
realField: FALSE,
realClosedField: FALSE,
algebraicallyClosedField: TRUE,
propList: LIST[fieldOfAlgebraicNumbersProp]
] ];
Field of Algebraic Numbers Constructor
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
] ] ];
};
Extract Field of Algebraic Numbers Operations from Class Property List
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;
};
Constructor
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] ];
};
IO
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.