CellsImpl.mesa
Last Edited by: Arnon, July 19, 1985 2:54:46 pm PDT
DIRECTORY
Rope,
Atom,
IO,
Convert,
Imager,
ImagerPath,
MathExpr,
MathConstructors,
AlgebraClasses,
FormulaOperators,
Ints,
Reals,
BigRats,
RatIntervals,
Variables,
Polynomials,
Formulas,
AlgebraicNumbers,
ExtensionFields,
SamplePoints,
Points,
Sequences,
Graphs,
CoveringSets,
Colors,
Cells;
CellsImpl: CEDAR PROGRAM
IMPORTS Rope, Atom, IO, Convert, Imager, ImagerPath, AlgebraClasses, MathConstructors, FormulaOperators, Ints, Points, Formulas, SamplePoints, CoveringSets, Colors
EXPORTS Cells =
BEGIN OPEN AC: AlgebraClasses, BR: BigRats, RI: RatIntervals, VARS: Variables, AN: AlgebraicNumbers, PTS: Points, POL: Polynomials, AN: AlgebraicNumbers, EF: ExtensionFields, SEQ: Sequences, QFF: Formulas, SP: SamplePoints, CS: CoveringSets, Cells;
Errors
SyntaxError: PUBLIC ERROR [reason: ATOM] = CODE;
BadElementStructure: PUBLIC ERROR [elementStructure: AC.Structure] = CODE;
TypeError: PUBLIC ERROR [message: ATOM ← $Unspecified] = CODE;
Class for Cell Structures
ClassPrintName: AC.PrintNameProc = {
data: CellStructureData ← NARROW[structure.instanceData];
basisSigStructData: PTS.PointStructureData ← NARROW[data.basisSignatureStructure.instanceData];
numBasisElements: CARDINAL ← basisSigStructData.dimension;
out: Rope.ROPE ← Rope.Cat[
"Cells over ",
data.inputPolynomialRing.class.printName[data.inputPolynomialRing],
" and ",
data.minPolyRing.class.printName[data.minPolyRing]
];
RETURN[Rope.Cat[out,
" with ",
Convert.RopeFromCard[numBasisElements],
" basis elements"
] ];
};
ClassShortPrintName: AC.PrintNameProc = {
data: CellStructureData ← NARROW[structure.instanceData];
basisSigStructData: PTS.PointStructureData ← NARROW[data.basisSignatureStructure.instanceData];
numBasisElements: CARDINAL ← basisSigStructData.dimension;
out: Rope.ROPE ← Rope.Cat[
"Cells(",
data.inputPolynomialRing.class.shortPrintName[data.inputPolynomialRing],
" , ",
data.minPolyRing.class.shortPrintName[data.minPolyRing],
" , "];
RETURN[Rope.Cat[out,
Convert.RopeFromCard[numBasisElements],
")"
] ];
};
ClassReportOps: AC.ReportOpsProc = {
opNames ← CONS["Display2D", opNames];
refOps ← CONS[NEW[AC.Display2DOp ← Disp2D ], refOps];
opNames ← CONS["BoundingBox", opNames];
refOps ← CONS[NEW[AC.UnaryOp ← BoundBox ], refOps];
opNames ← CONS["SetColor", opNames];
refOps ← CONS[NEW[AC.BinaryInPlaceOp ← SetCol ], refOps];
opNames ← CONS["Color", opNames];
refOps ← CONS[NEW[AC.UnaryOp ← Col ], refOps];
opNames ← CONS["CoveringSet", opNames];
refOps ← CONS[NEW[AC.UnaryOp ← CoverSet ], refOps];
opNames ← CONS["DefiningFormula", opNames];
refOps ← CONS[NEW[AC.UnaryOp ← DefiningForm ], refOps];
opNames ← CONS["SamplePoint", opNames];
refOps ← CONS[NEW[AC.UnaryOp ← SamplePt ], refOps];
opNames ← CONS["BasisSignature", opNames];
refOps ← CONS[NEW[AC.UnaryOp ← BasisSig ], refOps];
opNames ← CONS["AdjacentCells", opNames];
refOps ← CONS[NEW[AC.UnaryOp ← AdjCells ], refOps];
opNames ← CONS["Cad", opNames];
refOps ← CONS[NEW[AC.UnaryOp ← GetCad ], refOps];
opNames ← CONS["FromLinearRope", opNames];
refOps ← CONS[NEW[AC.FromRopeOp ← FromRope], refOps];
};
ClassIsElementOf: AC.ElementOfProc = {
Assumes that if item is a cell, then it really belongs to the structure 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 = {
inData: CellData;
outColumn, tail: LIST OF MathExpr.EXPR ← NIL;
colLength: CARDINAL;
IF in=NIL THEN {
out ← MathConstructors.MakeVector[1, LIST[MathConstructors.MakeVariable["NILCELL"]], FALSE];
RETURN;
};
inData ← NARROW[in.data];
IF inData=NIL THEN {
out ← MathConstructors.MakeVector[1, LIST[MathConstructors.MakeVariable["NILCELL"]], FALSE];
RETURN;
};
outColumn ← tail ← LIST[MathConstructors.MakeVariable["BEGINCELL"] ];
tail ← tail.rest ← LIST[MathConstructors.MakeVariable["INDEX"] ];
tail ← tail.rest ← LIST[inData.index.structure.class.toExpr[inData.index] ];
tail ← tail.rest ← LIST[MathConstructors.MakeVariable["SAMPLEPOINT"] ];
IF inData.samplePoint # NIL THEN
tail ← tail.rest ← LIST[inData.samplePoint.structure.class.toExpr[inData.samplePoint] ]
ELSE
tail ← tail.rest ← LIST[MathConstructors.MakeVariable["NILSAMPLEPOINT"] ];
tail ← tail.rest ← LIST[MathConstructors.MakeVariable["DEFININGFORMULA"] ];
IF inData.definingFormula # NIL THEN
tail ← tail.rest ← LIST[inData.definingFormula.structure.class.toExpr[inData.definingFormula] ]
ELSE
tail ← tail.rest ← LIST[MathConstructors.MakeVariable["NILDEFININGFORMULA"] ];
tail ← tail.rest ← LIST[MathConstructors.MakeVariable["BEGINCOVERINGSET"] ];
IF inData.coveringSet # NIL THEN
tail ← tail.rest ← LIST[inData.coveringSet.structure.class.toExpr[inData.coveringSet] ]
ELSE
tail ← tail.rest ← LIST[MathConstructors.MakeVariable["NILCOVERINGSET"] ];
tail ← tail.rest ← LIST[MathConstructors.MakeVariable["ENDCELL"] ];
colLength ← 10;
out ← MathConstructors.MakeVector[colLength, outColumn, FALSE];
};
ClassToExpr: AC.ToExprOp = {
inData: CellData;
outColumn, tail: LIST OF MathExpr.EXPR ← NIL;
colLength: CARDINAL ← 1;
IF in=NIL THEN {
out ← MathConstructors.MakeVector[colLength, LIST[MathConstructors.MakeVariable["NILCELL"]], FALSE];
RETURN;
};
inData ← NARROW[in.data];
IF inData=NIL THEN {
out ← MathConstructors.MakeVector[colLength, LIST[MathConstructors.MakeVariable["NILCELL"]], FALSE];
RETURN;
};
outColumn ← tail ← LIST[MathConstructors.MakeVariable[
Rope.Concat[Convert.RopeFromCard[inData.dimension], "-Cell"] ] ];
tail ← tail.rest ← LIST[inData.index.structure.class.toExpr[inData.index] ];
colLength ← 2;
out ← MathConstructors.MakeVector[colLength, outColumn, FALSE];
};
cellOps: CellOps ← NEW[CellOpsRec ← [
cad: GetCad,
adjacentCells: AdjCells,
basisSignature: BasisSig,
samplePoint: SamplePt,
definingFormula: DefiningForm,
coveringSet: CoverSet,
color: Col,
setColor: SetCol,
boundingBox: BoundBox,
display2D: Disp2D
] ];
cellProp: Atom.DottedPair ← NEW[Atom.DottedPairNode← [$CellStructure, cellOps]];
cellStructureClass: PUBLIC AC.StructureClass ← NEW[AC.StructureClassRec ← [
category: set,
printName: ClassPrintName,
shortPrintName: ClassShortPrintName,
structureEqual: AC.defaultStructureEqualityTest,
reportOps: ClassReportOps,
isElementOf: ClassIsElementOf,
legalFirstChar: ClassLegalFirstChar,
read: Read,
fromRope: FromRope,
toRope: ToRope,
toIndexRope: ToIndexRope,
write: Write,
toExpr: ClassToExpr,
integralDomain: FALSE,
gcdDomain: FALSE,
euclideanDomain: FALSE,
propList: LIST[cellProp]
] ];
Cell Structure Constructor
MakeCellStructure: PUBLIC PROC [inputPolynomialRing, minPolyRing: AC.Structure, numBasisElements: CARDINAL] RETURNS [cellStructure: AC.Structure] ~ {
basisSignatureStructure: AC.Structure ← PTS.MakePointStructure[FormulaOperators.Operators, numBasisElements];
cellStructureData: CellStructureData ← NEW[CellStructureDataRec ← [
inputPolynomialRing: inputPolynomialRing,
minPolyRing: minPolyRing,
basisSignatureStructure: basisSignatureStructure
] ];
RETURN[ NEW[AC.StructureRec ← [
class: cellStructureClass,
instanceData: cellStructureData
] ] ];
};
Extract Cell Operations from Class Record Property Lists
IsCellStructure: PUBLIC PROC [structure: AC.Structure] RETURNS [BOOL] ~ {
IF Atom.GetPropFromList[structure.class.propList, $CellStructure] # NIL THEN RETURN[TRUE] ELSE RETURN[FALSE];
};
Cad: PUBLIC PROC [structure: AC.Structure] RETURNS [AC.UnaryOp] ~ {
IF IsCellStructure[structure] THEN {
cellOps: CellOps ← NARROW[ Atom.GetPropFromList[structure.class.propList, $CellStructure] ];
RETURN[cellOps.cad];
}
ELSE ERROR;
};
AdjacentCells: PUBLIC PROC [structure: AC.Structure] RETURNS [AC.UnaryOp] ~ {
IF IsCellStructure[structure] THEN {
cellOps: CellOps ← NARROW[ Atom.GetPropFromList[structure.class.propList, $CellStructure] ];
RETURN[cellOps.adjacentCells];
}
ELSE ERROR;
};
BasisSignature: PUBLIC PROC [structure: AC.Structure] RETURNS [AC.UnaryOp] ~ {
IF IsCellStructure[structure] THEN {
cellOps: CellOps ← NARROW[ Atom.GetPropFromList[structure.class.propList, $CellStructure] ];
RETURN[cellOps.basisSignature];
}
ELSE ERROR;
};
SamplePoint: PUBLIC PROC [structure: AC.Structure] RETURNS [AC.UnaryOp] ~ {
IF IsCellStructure[structure] THEN {
cellOps: CellOps ← NARROW[ Atom.GetPropFromList[structure.class.propList, $CellStructure] ];
RETURN[cellOps.samplePoint];
}
ELSE ERROR;
};
DefiningFormula: PUBLIC PROC [structure: AC.Structure] RETURNS [AC.UnaryOp] ~ {
IF IsCellStructure[structure] THEN {
cellOps: CellOps ← NARROW[ Atom.GetPropFromList[structure.class.propList, $CellStructure] ];
RETURN[cellOps.definingFormula];
}
ELSE ERROR;
};
CoveringSet: PUBLIC PROC [structure: AC.Structure] RETURNS [AC.UnaryOp] ~ {
IF IsCellStructure[structure] THEN {
cellOps: CellOps ← NARROW[ Atom.GetPropFromList[structure.class.propList, $CellStructure] ];
RETURN[cellOps.coveringSet];
}
ELSE ERROR;
};
Color: PUBLIC PROC [structure: AC.Structure] RETURNS [AC.UnaryOp] ~ {
IF IsCellStructure[structure] THEN {
cellOps: CellOps ← NARROW[ Atom.GetPropFromList[structure.class.propList, $CellStructure] ];
RETURN[cellOps.color];
}
ELSE ERROR;
};
SetColor: PUBLIC PROC [structure: AC.Structure] RETURNS [AC.BinaryInPlaceOp] ~ {
IF IsCellStructure[structure] THEN {
cellOps: CellOps ← NARROW[ Atom.GetPropFromList[structure.class.propList, $CellStructure] ];
RETURN[cellOps.setColor];
}
ELSE ERROR;
};
BoundingBox: PUBLIC PROC [structure: AC.Structure] RETURNS [AC.UnaryOp] ~ {
IF IsCellStructure[structure] THEN {
cellOps: CellOps ← NARROW[ Atom.GetPropFromList[structure.class.propList, $CellStructure] ];
RETURN[cellOps.boundingBox];
}
ELSE ERROR;
};
Display2D: PUBLIC PROC [structure: AC.Structure] RETURNS [AC.Display2DOp] ~ {
IF IsCellStructure[structure] THEN {
cellOps: CellOps ← NARROW[ Atom.GetPropFromList[structure.class.propList, $CellStructure] ];
RETURN[cellOps.display2D];
}
ELSE ERROR;
};
Conversion and IO
cadVertexClass: PUBLIC Graphs.VertexClass ← Graphs.NewVertexClass[[
Expand: CellExpand
]];
CellExpand: PUBLIC Graphs.ExpandProc ~ {
cell: Cell ← NARROW[vertex.rep];
cellData: CellData ← NARROW[cell.data];
adjacencies: SEQ.Sequence ← cellData.adjacentCells;
adjacenciesData: SEQ.SequenceData ← NARROW[adjacencies.data];
FOR i:NAT IN [1..adjacenciesData.lengthPlus1 - 1] DO
otherCellData: CellData ← NARROW[adjacenciesData[i].data];
otherVertex ← otherCellData.abstractVertex;
edge: Graphs.Edge ← Graphs.AddEdge[vertex, otherVertex, Undirected, NIL, NIL];
edge: Graphs.Edge ← [
direction: Undirected,
label: NIL,
otherSide: cellData.abstractVertex
];
Consume.proc[edge, Consume.data];
ENDLOOP;
};
Read: PUBLIC AC.ReadOp ~ {
cellStructureData: CellStructureData ← NARROW[structure.instanceData];
inputPolynomialRing: AC.Structure ← cellStructureData.inputPolynomialRing;
minPolyRing: AC.Structure ← cellStructureData.minPolyRing;
basisSignatureStructure: AC.Structure ← cellStructureData.basisSignatureStructure;
polyRingData: POL.PolynomialRingData ← NARROW[inputPolynomialRing.instanceData];
ambientSpaceDimension: CARDINAL ← polyRingData.allVariables.lengthPlus1 - 1;
cellIndexStructure: AC.Structure ← PTS.MakePointStructure[Ints.Ints, ambientSpaceDimension];
formulaAlgebra: AC.Structure ← QFF.MakeFormulaAlgebra[inputPolynomialRing];
samplePointStructure: AC.Structure ← SP.MakeSamplePointStructure[inputPolynomialRing, minPolyRing];
coveringSetStructure: AC.Structure ← CS.MakeCoveringSetStructure[ambientSpaceDimension];
outData: CellData;
token: Rope.ROPE;
index: CellIndex;
basisSignature: Signature;
samplePoint: SP.SamplePoint ← NIL;
samplePointData: SP.SamplePointData;
definingFormula: QFF.Formula ← NIL;
coveringSet: CS.CoveringSet ← NIL;
token ← in.GetID[];
IF NOT Rope.Equal[token, "BEGINCELL"] THEN ERROR;
token ← in.GetID[];
IF NOT Rope.Equal[token, "INDEX"] THEN ERROR;
index ← cellIndexStructure.class.read[in, cellIndexStructure];
token ← in.GetID[];
IF Rope.Equal[token, "BASISSIGNATURE"] THEN {
basisSignature ← basisSignatureStructure.class.read[in, basisSignatureStructure];
token ← in.GetID[];
};
IF Rope.Equal[token, "SAMPLEPOINT"] THEN {
samplePoint ← samplePointStructure.class.read[in, samplePointStructure];
token ← in.GetID[];
};
IF Rope.Equal[token, "DEFININGFORMULA"] THEN {
definingFormula ← formulaAlgebra.class.read[in, formulaAlgebra];
token ← in.GetID[];
};
IF Rope.Equal[token, "BEGINCOVERINGSET"] THEN {
coveringSet ← coveringSetStructure.class.read[in, coveringSetStructure];
token ← in.GetID[];
};
IF NOT Rope.Equal[token, "ENDCELL"] THEN ERROR;
outData ← NEW[CellDataRec ← [
index: index,
basisSignature: basisSignature,
samplePoint: samplePoint,
definingFormula: definingFormula,
coveringSet: coveringSet
]];
out ← NEW[AC.ObjectRec ← [structure: structure, data: outData] ];
outData.dimension ← CellDim[out];
samplePointData ← NARROW[samplePoint.data];
samplePointData.cell ← out; -- need to do the same for covering set
outData.abstractVertex ← NEW [Graphs.VertexPrivate ← [
class: cadVertexClass,
rep: out
]];
RETURN[out];
};
FromRope: PUBLIC AC.FromRopeOp ~ {
out ← Read[IO.RIS[in], structure];
};
ToIndexRope: AC.ToRopeOp ~ {
inData: CellData ← NARROW[in.data];
out ← inData.index.structure.class.toRope[inData.index];
};
ToRope: PUBLIC AC.ToRopeOp ~ {
inData: CellData ← NARROW[in.data];
out ← "";
out ← "BEGINCELL\n";
out ← Rope.Concat[out, "INDEX\n"];
out ← Rope.Cat[out, inData.index.structure.class.toRope[inData.index], "\n"];
IF inData.basisSignature#NIL THEN {
out ← Rope.Concat[out, "BASISSIGNATURE\n"];
out ← Rope.Cat[out, inData.basisSignature.structure.class.toRope[inData.basisSignature], "\n"];
};
IF inData.samplePoint#NIL THEN {
out ← Rope.Concat[out, "SAMPLEPOINT\n"];
out ← Rope.Concat[out, inData.samplePoint.structure.class.toRope[inData.samplePoint]];
};
IF inData.definingFormula#NIL THEN {
out ← Rope.Concat[out, "DEFININGFORMULA\n"];
out ← Rope.Cat[out, inData.definingFormula.structure.class.toRope[inData.definingFormula], "\n"];
};
IF inData.coveringSet#NIL THEN {
out ← Rope.Concat[out, "BEGINCOVERINGSET\n"];
out ← Rope.Cat[out, inData.coveringSet.structure.class.toRope[inData.coveringSet], "\n"];
};
out ← Rope.Concat[out, "ENDCELL\n"];
};
Write: PUBLIC AC.WriteOp ~ {
stream.PutRope[ToRope[in] ]
};
Operations
SetCad: PUBLIC PROC [cell, cad: AC.Object] ~ {
data: CellData ← NARROW[cell.data];
data.cad ← cad;
};
GetCad: PUBLIC AC.UnaryOp ~ {
data: CellData ← NARROW[arg.data];
RETURN[data.cad];
};
CellDim: PUBLIC AC.ElementRankOp ~ {
data: CellData ← NARROW[arg.data];
inData: PTS.PointData ← NARROW[data.index.data];
dimension: CARDINAL ← 0;
FOR i:NAT IN [1..inData.dimensionPlus1 - 1] DO
coodData: Ints.IntData ← NARROW[inData[i].data];
dimension ← dimension + coodData^ MOD 2;
ENDLOOP;
RETURN[dimension];
};
AdjCells: PUBLIC AC.UnaryOp ~ {
data: CellData ← NARROW[arg.data];
RETURN[data.adjacentCells];
};
BasisSig: PUBLIC AC.UnaryOp ~ {
data: CellData ← NARROW[arg.data];
RETURN[data.basisSignature];
};
SamplePt: PUBLIC AC.UnaryOp ~ {
data: CellData ← NARROW[arg.data];
RETURN[data.samplePoint];
};
DefiningForm: PUBLIC AC.UnaryOp ~ {
data: CellData ← NARROW[arg.data];
RETURN[data.definingFormula];
};
CoverSet: PUBLIC AC.UnaryOp ~ {
data: CellData ← NARROW[arg.data];
RETURN[data.coveringSet];
};
Col: PUBLIC AC.UnaryOp ~ {
data: CellData ← NARROW[arg.data];
RETURN[data.color];
};
SetCol: PUBLIC AC.BinaryInPlaceOp ~ {
data: CellData ← NARROW[firstArg.data];
rope: Rope.ROPE ← NARROW[secondArg];
data.color ← Colors.FromRope[rope, Colors.Colors];
};
BoundBox: PUBLIC AC.UnaryOp ~ {
cellData: CellData ← NARROW[arg.data];
coveringSetData: CS.CoveringSetData;
IF cellData.coveringSet = NIL THEN RETURN[NIL];
coveringSetData ← NARROW[cellData.coveringSet.data];
RETURN[coveringSetData.boundingBox];
};
Disp2D: PUBLIC AC.Display2DOp ~ {
cellData: CellData ← NARROW[object.data];
dimension: CARDINAL ← cellData.dimension;
IF cellData.coveringSet = NIL THEN RETURN;
SELECT dimension FROM
0 => Display0Cell[object, context, dotWidth];
1 => Display1Cell[object, context, segmentWidth];
ENDCASE;
};
ImagerVecFromRealPoint: PROC [point: PTS.Point] RETURNS [v: Imager.VEC] ~ {
x: Reals.Real ← NARROW[point.data, PTS.PointData][1];
y: Reals.Real ← NARROW[point.data, PTS.PointData][2];
xData: Reals.RealData ← NARROW[x.data];
yData: Reals.RealData ← NARROW[y.data];
RETURN[ [xData^ , yData^] ];
};
Display0Cell: PROC [cell: Cell, context: Imager.Context, dotWidth: REAL] ~ {
cellData: CellData ← NARROW[cell.data];
coveringSetData: CS.CoveringSetData ← NARROW[cellData.coveringSet.data];
dataPointsData: SEQ.SequenceData ← NARROW[coveringSetData.dataPoints.data];
column: SEQ.Sequence ← dataPointsData[1];
columnData: SEQ.SequenceData ← NARROW[column.data];
vec: Imager.VEC;
IF columnData.lengthPlus1 = 1 THEN RETURN;
vec ← ImagerVecFromRealPoint[columnData[1] ];
Imager.SetStrokeWidth[context, dotWidth];
Imager.MaskStrokeTrajectory[context, ImagerPath.MoveTo[vec] ];
};
Display1Cell: PROC [cell: Cell, context: Imager.Context, segmentWidth: REAL] ~ {
cellData: CellData ← NARROW[cell.data];
coveringSetData: CS.CoveringSetData ← NARROW[cellData.coveringSet.data];
dataPointsData: SEQ.SequenceData ← NARROW[coveringSetData.dataPoints.data];
column: SEQ.Sequence ← dataPointsData[1];
columnData: SEQ.SequenceData ← NARROW[column.data];
vec: Imager.VEC;
trajectory: Imager.Trajectory;
IF columnData.lengthPlus1 = 1 THEN RETURN;
vec ← ImagerVecFromRealPoint[columnData[1] ];
trajectory ← ImagerPath.MoveTo[vec];
Imager.SetStrokeWidth[context, segmentWidth];
FOR j:NAT IN [1..columnData.lengthPlus1-1] DO
vec ← ImagerVecFromRealPoint[columnData[j] ];
trajectory ← trajectory.LineTo[vec];
ENDLOOP;
Imager.MaskStrokeTrajectory[context, trajectory];
};
END.