
<<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.