CoveringSetsImpl.mesa
Last Edited by: Arnon, July 19, 1985 2:54:46 pm PDT
DIRECTORY
Rope,
Atom,
IO,
Convert,
MathExpr,
MathConstructors,
AlgebraClasses,
Ints,
Reals,
BigRats,
RatIntervals,
Variables,
Polynomials,
AlgebraicNumbers,
ExtensionFields,
Points,
Sequences,
CoveringSets;
CoveringSetsImpl: CEDAR PROGRAM
IMPORTS Rope, Atom, IO, Convert, AlgebraClasses, MathConstructors, Points, Sequences, Ints, Reals, BigRats
EXPORTS CoveringSets =
BEGIN OPEN AC: AlgebraClasses, BR: BigRats, RI: RatIntervals, VARS: Variables, AN: AlgebraicNumbers, PTS: Points, POL: Polynomials, AN: AlgebraicNumbers, EF: ExtensionFields,SEQ: Sequences, CoveringSets;
Errors
SyntaxError: PUBLIC ERROR [reason: ATOM] = CODE;
BadElementStructure: PUBLIC ERROR [elementStructure: AC.Structure] = CODE;
TypeError: PUBLIC ERROR [message: ATOM ← $Unspecified] = CODE;
Class for CoveringSet Structures
ClassPrintName: AC.PrintNameProc = {
data: CoveringSetStructureData ← NARROW[structure.instanceData];
RETURN[Rope.Cat[
"Covering Sets in ",
Convert.RopeFromCard[data.ambientSpaceDimension],
"-dimensional space"
] ];
};
ClassShortPrintName: AC.PrintNameProc = {
data: CoveringSetStructureData ← NARROW[structure.instanceData];
RETURN[Rope.Cat[
"CS(",
Convert.RopeFromCard[data.ambientSpaceDimension],
")"
] ];
};
ClassIsElementOf: AC.ElementOfProc = {
Assumes that if item is a coveringSet, 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 = {
inData: CoveringSetData;
outColumn, tail: LIST OF MathExpr.EXPR ← NIL;
colLength: CARDINAL;
IF in=NIL THEN {
out ← MathConstructors.MakeVector[1, LIST[MathConstructors.MakeVariable["NILCOVERINGSET"]], FALSE];
RETURN;
};
inData ← NARROW[in.data];
IF inData=NIL THEN {
out ← MathConstructors.MakeVector[1, LIST[MathConstructors.MakeVariable["NILCOVERINGSET"]], FALSE];
RETURN;
};
IF inData.stepSize # NIL THEN {
outColumn ← tail ← LIST[MathConstructors.MakeVariable["STEPSIZE"] ];
tail ← tail.rest ← LIST[inData.stepSize.structure.class.toExpr[inData.stepSize] ];
tail ← tail.rest ← LIST[MathConstructors.MakeVariable["NUMDECIMALPLACES"] ];
tail ← tail.rest ← LIST[inData.numDecimalPlaces.structure.class.toExpr[inData.numDecimalPlaces] ];
tail ← tail.rest ← LIST[MathConstructors.MakeVariable["REACH"] ];
tail ← tail.rest ← LIST[inData.reach.structure.class.toExpr[inData.reach] ];
tail ← tail.rest ← LIST[MathConstructors.MakeVariable["BOUNDINGBOX"] ];
tail ← tail.rest ← LIST[inData.boundingBox.structure.class.toExpr[inData.boundingBox] ];
tail ← tail.rest ← LIST[MathConstructors.MakeVariable["DATAPOINTS"] ];
colLength ← 9;
};
out ← MathConstructors.MakeVector[colLength, outColumn, FALSE];
};
coveringSetOps: CoveringSetOps ← NEW[CoveringSetOpsRec ← [
stepSize: StepSz,
numDecimalPlaces: NumDecPlc,
reach: Rch,
boundingBox: BoundBox,
dataPoints: DataPts
] ];
coveringSetProp: Atom.DottedPair ← NEW[Atom.DottedPairNode← [$CoveringSetStructure, coveringSetOps]];
coveringSetStructureClass: 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,
integralDomain: FALSE,
gcdDomain: FALSE,
euclideanDomain: FALSE,
propList: LIST[coveringSetProp]
] ];
CoveringSet Structure Constructor
MakeCoveringSetStructure: PUBLIC PROC [ambientSpaceDimension: CARDINAL] RETURNS [coveringSetStructure: AC.Structure] ~ {
coveringSetStructureData: CoveringSetStructureData ← NEW[CoveringSetStructureDataRec ← [
ambientSpaceDimension: ambientSpaceDimension
] ];
RETURN[ NEW[AC.StructureRec ← [
class: coveringSetStructureClass,
instanceData: coveringSetStructureData
] ] ];
};
Extract CoveringSet Operations from Class Record Property Lists
IsCoveringSetStructure: PUBLIC PROC [structure: AC.Structure] RETURNS [BOOL] ~ {
IF Atom.GetPropFromList[structure.class.propList, $CoveringSetStructure] # NIL THEN RETURN[TRUE] ELSE RETURN[FALSE];
};
Cell: PUBLIC PROC [structure: AC.Structure] RETURNS [AC.UnaryOp] ~ {
IF IsCoveringSetStructure[structure] THEN {
coveringSetOps: CoveringSetOps ← NARROW[ Atom.GetPropFromList[structure.class.propList, $CoveringSetStructure] ];
RETURN[coveringSetOps.cell];
}
ELSE ERROR;
};
StepSize: PUBLIC PROC [structure: AC.Structure] RETURNS [AC.UnaryOp] ~ {
IF IsCoveringSetStructure[structure] THEN {
coveringSetOps: CoveringSetOps ← NARROW[ Atom.GetPropFromList[structure.class.propList, $CoveringSetStructure] ];
RETURN[coveringSetOps.stepSize];
}
ELSE ERROR;
};
NumDecimalPlaces: PUBLIC PROC [structure: AC.Structure] RETURNS [AC.UnaryOp] ~ {
IF IsCoveringSetStructure[structure] THEN {
coveringSetOps: CoveringSetOps ← NARROW[ Atom.GetPropFromList[structure.class.propList, $CoveringSetStructure] ];
RETURN[coveringSetOps.numDecimalPlaces];
}
ELSE ERROR;
};
Reach: PUBLIC PROC [structure: AC.Structure] RETURNS [AC.UnaryOp] ~ {
IF IsCoveringSetStructure[structure] THEN {
coveringSetOps: CoveringSetOps ← NARROW[ Atom.GetPropFromList[structure.class.propList, $CoveringSetStructure] ];
RETURN[coveringSetOps.reach];
}
ELSE ERROR;
};
BoundingBox: PUBLIC PROC [structure: AC.Structure] RETURNS [AC.UnaryOp] ~ {
IF IsCoveringSetStructure[structure] THEN {
coveringSetOps: CoveringSetOps ← NARROW[ Atom.GetPropFromList[structure.class.propList, $CoveringSetStructure] ];
RETURN[coveringSetOps.boundingBox];
}
ELSE ERROR;
};
DataPoints: PUBLIC PROC [structure: AC.Structure] RETURNS [AC.UnaryOp] ~ {
IF IsCoveringSetStructure[structure] THEN {
coveringSetOps: CoveringSetOps ← NARROW[ Atom.GetPropFromList[structure.class.propList, $CoveringSetStructure] ];
RETURN[coveringSetOps.dataPoints];
}
ELSE ERROR;
};
Conversion and IO
Read: PUBLIC AC.ReadOp ~ {
coveringSetStructureData: CoveringSetStructureData ← NARROW[structure.instanceData];
dimension: NAT ← coveringSetStructureData.ambientSpaceDimension;
token: Rope.ROPE ← in.GetID[];
pointStructure: AC.Structure ← PTS.MakePointStructure[Reals.Reals, dimension]; -- currently assume data points have real-valued coordinates
boundingBoxStructure: AC.Structure ← PTS.MakePointStructure[Reals.Reals, 2*dimension];
columnStructure: AC.Structure ← SEQ.MakeSequenceStructure[pointStructure];
dataPointsStructure: AC.Structure ← SEQ.MakeSequenceStructure[columnStructure];
pointList, pointListTail: LIST OF AC.Object;
columnList, columnListTail: LIST OF AC.Object ← NIL;
column, dataPoints: SEQ.Sequence;
point: PTS.Point;
pointData: PTS.PointData;
boundingBox: PTS.Point;
outData: CoveringSetData;
xVal, yVal, zVal: REAL;
minX, minY, minZ: REAL ← 1500000.0;
maxX, maxY, maxZ: REAL ← -1500000.0;
IF Rope.Equal[token, "NILCOVERINGSET"] THEN
RETURN[NEW[AC.ObjectRec ← [structure: structure, data: NIL] ] ];
WHILE Rope.Equal[token, "BEGINCOLUMN"] DO
[]← in.SkipWhitespace[];
pointList ← pointListTail ← NIL;
WHILE in.PeekChar[]='( DO
point ← PTS.Read[in, pointStructure];
IF pointList=NIL THEN pointList ← pointListTail ←LIST[point] ELSE
pointListTail ← pointListTail.rest ← LIST[point];
pointData ← NARROW[point.data];
xVal ← NARROW[pointData[1].data, Reals.RealData]^;
IF xVal < minX THEN minX ← xVal;
IF xVal > maxX THEN maxX ← xVal;
IF dimension > 1 THEN {
yVal ← NARROW[pointData[2].data, Reals.RealData]^;
IF yVal < minY THEN minY ← yVal;
IF yVal > maxY THEN maxY ← yVal;
};
IF dimension > 2 THEN {
zVal ← NARROW[pointData[3].data, Reals.RealData]^;
IF zVal < minZ THEN minZ ← zVal;
IF zVal > maxZ THEN maxZ ← zVal;
};
[]← in.SkipWhitespace[];
ENDLOOP;
token ← in.GetID[];
IF NOT Rope.Equal[token, "ENDCOLUMN"] THEN ERROR;
column ← SEQ.MakeSeq[pointList, columnStructure];
IF columnList=NIL THEN columnList ← columnListTail ←LIST[column] ELSE
columnListTail ← columnListTail.rest ← LIST[column];
token ← in.GetID[];
ENDLOOP;
IF NOT Rope.Equal[token, "ENDCOVERINGSET"] THEN ERROR;
dataPoints ← SEQ.MakeSeq[columnList, dataPointsStructure]; -- assumes length >=1
SELECT dimension FROM
1 => boundingBox ← PTS.MakePt[LIST[
Reals.FromREAL[minX], Reals.FromREAL[maxX]
], boundingBoxStructure];
2 => boundingBox ← PTS.MakePt[LIST[
Reals.FromREAL[minX], Reals.FromREAL[maxX],
Reals.FromREAL[minY], Reals.FromREAL[maxY]
], boundingBoxStructure];
3 => boundingBox ← PTS.MakePt[LIST[
Reals.FromREAL[minX], Reals.FromREAL[maxX],
Reals.FromREAL[minY], Reals.FromREAL[maxY],
Reals.FromREAL[minZ], Reals.FromREAL[maxZ]
], boundingBoxStructure];
ENDCASE;
outData ← NEW[CoveringSetDataRec ← [
stepSize: BR.FromLC[0],
numDecimalPlaces: Ints.FromINT[0],
reach: Ints.FromINT[0],
boundingBox: boundingBox,
dataPoints: dataPoints] ];
RETURN[NEW[AC.ObjectRec ← [structure: structure, data: outData] ] ];
};
FromRope: PUBLIC AC.FromRopeOp ~ {
out ← Read[IO.RIS[in], structure];
};
ToIndexRope: AC.ToRopeOp ~ {
out ← "CS";
};
ToRope: PUBLIC AC.ToRopeOp ~ {
inData: CoveringSetData;
pointsData, columnData: SEQ.SequenceData;
IF in = NIL THEN RETURN[NIL];
inData ← NARROW[in.data];
IF inData = NIL THEN RETURN[NIL];
pointsData ← NARROW[inData.dataPoints.data];
out ← "";
out ← Rope.Concat[out, "BEGINCOVERINGSET\n"];
FOR i:NAT IN [1..pointsData.lengthPlus1-1] DO
out ← Rope.Concat[out, "BEGINCOLUMN\n"];
columnData ← NARROW[pointsData[i].data];
FOR j:NAT IN [1..columnData.lengthPlus1-1] DO
point: AC.Object ← NARROW[columnData[j] ];
out ← Rope.Cat[out, point.structure.class.toRope[point], "\n"];
ENDLOOP;
out ← Rope.Concat[out, "ENDCOLUMN\n"];
ENDLOOP;
out ← Rope.Concat[out, "ENDCOVERINGSET\n"];
};
Write: PUBLIC AC.WriteOp ~ {
stream.PutRope[ToRope[in] ]
};
Operations
SetCell: PUBLIC PROC [coveringSet, cell: AC.Object] ~ {
data: CoveringSetData ← NARROW[coveringSet.data];
data.cell ← cell;
};
Cll: PUBLIC AC.UnaryOp ~ {
data: CoveringSetData ← NARROW[arg.data];
RETURN[data.cell];
};
StepSz: PUBLIC AC.UnaryOp ~ {
data: CoveringSetData ← NARROW[arg.data];
RETURN[data.stepSize];
};
NumDecPlc: PUBLIC AC.UnaryOp ~ {
data: CoveringSetData ← NARROW[arg.data];
RETURN[data.numDecimalPlaces];
};
Rch: PUBLIC AC.UnaryOp ~ {
data: CoveringSetData ← NARROW[arg.data];
RETURN[data.reach];
};
BoundBox: PUBLIC AC.UnaryOp ~ {
data: CoveringSetData ← NARROW[arg.data];
RETURN[data.boundingBox];
};
DataPts: PUBLIC AC.UnaryOp ~ {
data: CoveringSetData ← NARROW[arg.data];
RETURN[data.dataPoints];
};
END.