<> <> <<>> DIRECTORY Rope, Atom, IO, Convert, MathExpr, MathConstructors, AlgebraClasses, Points; PointsImpl: CEDAR PROGRAM IMPORTS Rope, Atom, IO, Convert, MathConstructors, AlgebraClasses EXPORTS Points = BEGIN OPEN AC: AlgebraClasses, Points; <> SyntaxError: PUBLIC ERROR [reason: ATOM] = CODE; BadElementStructure: PUBLIC ERROR [coordinateStructure: AC.Structure] = CODE; TypeError: PUBLIC ERROR [message: ATOM _ $Unspecified] = CODE; <> ClassPrintName: AC.PrintNameProc = { data: PointStructureData _ NARROW[structure.instanceData]; RETURN[Rope.Cat[ "Points of dimension ", Convert.RopeFromCard[data.dimension], " over ", data.coordinateStructure.class.printName[data.coordinateStructure] ] ]; }; ClassShortPrintName: AC.PrintNameProc = { data: PointStructureData _ NARROW[structure.instanceData]; RETURN[Rope.Cat[ "P", Convert.RopeFromCard[data.dimension], "(", data.coordinateStructure.class.shortPrintName[data.coordinateStructure], ")" ] ]; }; ClassReportOps: AC.ReportOpsProc = { class: AC.StructureClass _ structure.class; opNames _ CONS["MainCoordinate", opNames]; refOps _ CONS[NEW[AC.UnaryOp _ MainCood ], refOps]; opNames _ CONS["RemoveMainCoordinate", opNames]; refOps _ CONS[NEW[AC.UnaryOp _ RemoveMainCood ], refOps]; IF class.equal # NIL THEN { opNames _ CONS["Equal", opNames]; refOps _ CONS[NEW[AC.EqualityOp _ Equal], refOps] }; IF class.multiply # NIL THEN { opNames _ CONS["Multiply", opNames]; refOps _ CONS[NEW[AC.BinaryOp _ Multiply], refOps] }; IF class.subtract # NIL THEN { opNames _ CONS["Subtract", opNames]; refOps _ CONS[NEW[AC.BinaryOp _ Subtract], refOps] }; IF class.negate # NIL THEN { opNames _ CONS["Negate", opNames]; refOps _ CONS[NEW[AC.UnaryOp _ Negate], refOps] }; IF class.add # NIL THEN { opNames _ CONS["Add", opNames]; refOps _ CONS[NEW[AC.BinaryOp _ Add], refOps] }; opNames _ CONS["FromLinearRope", opNames]; refOps _ CONS[NEW[AC.FromRopeOp _ FromRope], refOps]; }; ClassCharacteristic: AC.StructureRankOp = { data: PointStructureData _ NARROW[structure.instanceData]; RETURN[ data.coordinateStructure.class.characteristic[data.coordinateStructure] ] }; ClassIsElementOf: AC.ElementOfProc = { <> IF NOT structure.class.structureEqual[structure, item.structure] THEN RETURN[FALSE]; RETURN[ TRUE ] }; ClassDimension: AC.StructureRankOp = { data: PointStructureData _ NARROW[structure.instanceData]; RETURN[data.dimension] }; ClassLegalFirstChar: AC.LegalFirstCharOp = { SELECT char FROM '[ , '(=> RETURN[TRUE]; ENDCASE; RETURN[FALSE]; }; ClassToExpr: AC.ToExprOp = { data: PointStructureData; inData: PointData; outRow: LIST OF MathExpr.EXPR _ NIL; IF in=NIL OR in.data=NIL THEN RETURN[MathConstructors.MakeVariable["NilPoint"]]; inData _ NARROW[in.data]; data _ NARROW[in.structure.instanceData]; FOR j:NAT DECREASING IN [1..data.dimension] DO outRow _ CONS[data.coordinateStructure.class.toExpr[inData[j] ], outRow]; ENDLOOP; out _ MathConstructors.MakeVector[data.dimension, outRow, TRUE]; }; ClassZero: AC.NullaryOp = { structureData: PointStructureData _ NARROW[structure.instanceData]; coordinateStructure: AC.Structure _ structureData.coordinateStructure; RETURN[ ImbedSc[coordinateStructure.class.zero[coordinateStructure], structure] ] }; ClassOne: AC.NullaryOp = { structureData: PointStructureData _ NARROW[structure.instanceData]; coordinateStructure: AC.Structure _ structureData.coordinateStructure; RETURN[ ImbedSc[coordinateStructure.class.one[coordinateStructure], structure] ] }; pointStructureOps: PointOps _ NEW[PointOpsRec _ [ removeMainCoordinate: RemoveMainCood, mainCoordinate: MainCood, imbedScalar: ImbedSc, makePoint: MakePt ] ]; pointProp: Atom.DottedPair _ NEW[Atom.DottedPairNode_ [$PointStructure, pointStructureOps]]; <<>> pointsOverSetClass: PUBLIC AC.StructureClass _ NEW[AC.StructureClassRec _ [ category: set, printName: ClassPrintName, shortPrintName: ClassShortPrintName, structureEqual: AC.defaultStructureEqualityTest, isElementOf: ClassIsElementOf, legalFirstChar: ClassLegalFirstChar, read: Read, fromRope: FromRope, toRope: ToRope, toIndexRope: ToIndexRope, write: Write, toExpr: ClassToExpr, equal: Equal, integralDomain: FALSE, gcdDomain: FALSE, euclideanDomain: FALSE, propList: LIST[pointProp] ] ]; pointsOverAbelianGroupClass: PUBLIC AC.StructureClass _ NEW[AC.StructureClassRec _ [ category: group, printName: ClassPrintName, shortPrintName: ClassShortPrintName, structureEqual: AC.defaultStructureEqualityTest, isElementOf: ClassIsElementOf, legalFirstChar: ClassLegalFirstChar, read: Read, fromRope: FromRope, toRope: ToRope, toIndexRope: ToIndexRope, write: Write, toExpr: ClassToExpr, add: Add, negate: Negate, subtract: Subtract, zero: ClassZero, <> <> <> equal: Equal, integralDomain: FALSE, gcdDomain: FALSE, euclideanDomain: FALSE, propList: LIST[pointProp] ] ]; pointsOverRingClass: PUBLIC AC.StructureClass _ NEW[AC.StructureClassRec _ [ category: ring, printName: ClassPrintName, shortPrintName: ClassShortPrintName, structureEqual: AC.defaultStructureEqualityTest, characteristic: ClassCharacteristic, isElementOf: ClassIsElementOf, legalFirstChar: ClassLegalFirstChar, read: Read, fromRope: FromRope, toRope: ToRope, toIndexRope: ToIndexRope, write: Write, toExpr: ClassToExpr, add: Add, negate: Negate, subtract: Subtract, zero: ClassZero, multiply: Multiply, commutative: FALSE, -- commutative: FALSE may be bogus one: ClassOne, equal: Equal, integralDomain: FALSE, gcdDomain: FALSE, euclideanDomain: FALSE, propList: LIST[pointProp] ] ]; <> MakePointStructure: PUBLIC AC.PointStructureConstructor ~ { pointStructureData: PointStructureData _ NEW[PointStructureDataRec _ [ coordinateStructure: coordinateStructure, dimension: dimension ] ]; SELECT coordinateStructure.class.category FROM set, lattice => RETURN[ NEW[AC.StructureRec _ [ class: pointsOverSetClass, instanceData: pointStructureData ] ] ]; group, module, vectorSpace => RETURN[ NEW[AC.StructureRec _ [ class: pointsOverAbelianGroupClass, instanceData: pointStructureData ] ] ]; ring, field, algebra, divisionAlgebra => RETURN[ NEW[AC.StructureRec _ [ class: pointsOverRingClass, instanceData: pointStructureData ] ] ]; ENDCASE => ERROR BadElementStructure[coordinateStructure]; }; <> <> <> <<};>> <<>> <> <> <> <> <<}>> <> <<};>> <<>> <> <> <> <> <<}>> <> <<};>> <<>> <> <> <> <> <<}>> <> <<};>> <<>> <> <> <> <> <<}>> <> <<};>> <> ImbedScalar: PUBLIC AC.UnaryImbedOp ~ { structureData: PointStructureData _ NARROW[structure.instanceData]; coordinateStructure: AC.Structure _ structureData.coordinateStructure; outData: PointData _ NEW[PointDataRec[structureData.dimension] ]; IF NOT in.structure.class.structureEqual[in.structure, coordinateStructure] THEN ERROR TypeError[]; FOR i: NAT IN [1..structureData.dimension] DO outData[i] _ in; ENDLOOP; out _ NEW[AC.ObjectRec _ [structure: structure, data: outData] ]; }; MakePoint: PUBLIC AC.ListImbedOp ~ { structureData: PointStructureData _ NARROW[structure.instanceData]; coordinateStructure: AC.Structure _ structureData.coordinateStructure; length: NAT _ 0; ptr: LIST OF AC.Object _ data; outData: PointData; WHILE ptr#NIL DO length _ length + 1; ptr _ ptr.rest ENDLOOP; IF length # structureData.dimension THEN ERROR; outData _ NEW[PointDataRec[length] ]; FOR i:NAT IN [1..length] DO outData[i] _ data.first; data _ data.rest; ENDLOOP; out _ NEW[AC.ObjectRec _ [structure: structure, data: outData] ]; }; <> Read: PUBLIC AC.ReadOp ~ { structureData: PointStructureData _ NARROW[structure.instanceData]; dimension: NAT _ structureData.dimension; outData: PointData _ NEW[PointDataRec[dimension] ]; coordinateStructure: AC.Structure _ structureData.coordinateStructure; puncChar: CHAR; out _ NEW[AC.ObjectRec _ [structure: structure, data: outData] ]; []_ in.SkipWhitespace[]; puncChar _ in.GetChar[]; IF puncChar # '( AND puncChar # '[ THEN ERROR; []_ in.SkipWhitespace[]; FOR i:NAT IN [1 .. dimension] DO outData[i] _ coordinateStructure.class.read[in, coordinateStructure]; IF i < dimension THEN { []_ in.SkipWhitespace[]; IF in.PeekChar[]=', THEN [] _ in.GetChar[]; -- flush comma if present }; ENDLOOP; []_ in.SkipWhitespace[]; puncChar _ in.GetChar[]; IF puncChar # ') AND puncChar # '] THEN ERROR; []_ in.SkipWhitespace[]; }; FromRope: PUBLIC AC.FromRopeOp ~ { out _ Read[IO.RIS[in], structure]; }; ToRope: PUBLIC AC.ToRopeOp ~ { pointStructureData: PointStructureData _ NARROW[in.structure.instanceData]; coordinateStructure: AC.Structure _ pointStructureData.coordinateStructure; inData: PointData _ NARROW[in.data]; out _ "( "; FOR i:NAT IN [1..inData.dimensionPlus1) DO out _ Rope.Concat[ out, coordinateStructure.class.toRope[inData[i] ] ]; IF i < inData.dimensionPlus1-1 THEN out _ Rope.Concat[out,", "]; ENDLOOP; out _ Rope.Concat[ out, " )" ]; }; ToIndexRope: PUBLIC AC.ToRopeOp ~ { out _ "Point"; }; Write: PUBLIC AC.WriteOp ~ { stream.PutRope[ ToRope[in] ] }; <> IsPointStructure: PUBLIC AC.StructurePredicate ~ { IF Atom.GetPropFromList[structure.class.propList, $PointStructure] # NIL THEN RETURN[TRUE] ELSE RETURN[FALSE]; }; RemoveMainCood: PUBLIC AC.UnaryOp ~ { pointStructureData: PointStructureData _ NARROW[arg.structure.instanceData]; dimension: NAT _ pointStructureData.dimension; coordinateStructure: AC.Structure _ pointStructureData.coordinateStructure; PData: PointData _ NARROW[arg.data]; QData: PointData _ NEW[PointDataRec[dimension-1] ]; FOR i:NAT IN [1..dimension - 1] DO QData[i] _ PData[i] ENDLOOP; RETURN[ NEW[AC.ObjectRec _ [ structure: MakePointStructure[coordinateStructure, dimension-1], data: QData ] ] ]; }; MainCood: PUBLIC AC.UnaryOp ~ { pointStructureData: PointStructureData _ NARROW[arg.structure.instanceData]; dimension: NAT _ pointStructureData.dimension; PData: PointData _ NARROW[arg.data]; RETURN[ PData[dimension] ]; }; <> Equal: PUBLIC AC.EqualityOp ~ { data: PointStructureData _ NARROW[firstArg.structure.instanceData]; firstArgData: PointData _ NARROW[firstArg.data]; secondArgData: PointData _ NARROW[secondArg.data]; FOR j: INTEGER IN [1..data.dimension] DO IF NOT data.coordinateStructure.class.equal[firstArgData[j], secondArgData[j] ] THEN RETURN[FALSE]; ENDLOOP; RETURN[TRUE]; }; <> Add: PUBLIC AC.BinaryOp ~ { pointStructureData: PointStructureData _ NARROW[firstArg.structure.instanceData]; dimension: NAT _ pointStructureData.dimension; coordinateStructure: AC.Structure _ pointStructureData.coordinateStructure; firstData: PointData _ NARROW[firstArg.data]; secondData: PointData _ NARROW[secondArg.data]; resultData: PointData _ NEW[PointDataRec[dimension] ]; FOR i: NAT IN [1..dimension] DO resultData[i] _ coordinateStructure.class.add[firstData[i], secondData[i] ]; ENDLOOP; RETURN[ NEW[AC.ObjectRec _ [ structure: firstArg.structure, data: resultData ] ] ]; }; Negate: PUBLIC AC.UnaryOp ~ { pointStructureData: PointStructureData _ NARROW[arg.structure.instanceData]; dimension: NAT _ pointStructureData.dimension; coordinateStructure: AC.Structure _ pointStructureData.coordinateStructure; data: PointData _ NARROW[arg.data]; resultData: PointData _ NEW[PointDataRec[dimension] ]; FOR i: NAT IN [1..dimension] DO resultData[i] _ coordinateStructure.class.negate[data[i] ]; ENDLOOP; RETURN[ NEW[AC.ObjectRec _ [ structure: arg.structure, data: resultData ] ] ]; }; Subtract: PUBLIC AC.BinaryOp ~ { pointStructureData: PointStructureData _ NARROW[firstArg.structure.instanceData]; dimension: NAT _ pointStructureData.dimension; coordinateStructure: AC.Structure _ pointStructureData.coordinateStructure; firstData: PointData _ NARROW[firstArg.data]; secondData: PointData _ NARROW[secondArg.data]; resultData: PointData _ NEW[PointDataRec[dimension] ]; FOR i: NAT IN [1..dimension] DO resultData[i] _ coordinateStructure.class.subtract[firstData[i], secondData[i] ]; ENDLOOP; RETURN[ NEW[AC.ObjectRec _ [ structure: firstArg.structure, data: resultData ] ] ]; }; Multiply: PUBLIC AC.BinaryOp ~ { pointStructureData: PointStructureData _ NARROW[firstArg.structure.instanceData]; dimension: NAT _ pointStructureData.dimension; coordinateStructure: AC.Structure _ pointStructureData.coordinateStructure; firstData: PointData _ NARROW[firstArg.data]; secondData: PointData _ NARROW[secondArg.data]; resultData: PointData _ NEW[PointDataRec[dimension] ]; FOR i: NAT IN [1..dimension] DO resultData[i] _ coordinateStructure.class.multiply[firstData[i], secondData[i] ]; ENDLOOP; RETURN[ NEW[AC.ObjectRec _ [ structure: firstArg.structure, data: resultData ] ] ]; }; <> pointsOverSetClass _ AC.MakeClass["PointsOverSetClass", NIL, NIL]; pointsOverAbelianGroupClass _ AC.MakeClass["PointsOverAbelianGroupClass", NIL, NIL]; pointsOverRingClass _ AC.MakeClass["PointsOverRingClass", NIL, NIL]; END.