RosettaCodeData/Task/Set/Simula/set.simula

SIMSET
BEGIN

    ! WE DON'T SUBCLASS HEAD BUT USE COMPOSITION FOR CLASS SET ;
    CLASS SET;
    BEGIN
        PROCEDURE ADD(E); REF(ELEMENT) E;
        BEGIN
            IF NOT ISIN(E, THIS SET) THEN E.CLONE.INTO(H);
        END**OF**ADD;

        BOOLEAN PROCEDURE EMPTY; EMPTY := H.EMPTY;
        REF(LINK) PROCEDURE FIRST; FIRST :- H.FIRST;

        REF(HEAD) H;
        H :- NEW HEAD;
    END**OF**SET;

    ! WE SUBCLASS LINK FOR THE ELEMENTS CONTAINED IN THE SET ;
    LINK CLASS ELEMENT;
    VIRTUAL:
        PROCEDURE ISEQUAL IS
            BOOLEAN PROCEDURE ISEQUAL(OTHER); REF(ELEMENT) OTHER;;
        PROCEDURE REPR IS
            TEXT PROCEDURE REPR;;
        PROCEDURE REPR IS
            REF(ELEMENT) PROCEDURE CLONE;;
    BEGIN
    END**OF**ELEMENT;

    REF(SET) PROCEDURE UNION(S1, S2); REF(SET) S1, S2;
    BEGIN REF(SET) SU, S;
        SU :- NEW SET;
        FOR S :- S1, S2 DO
        BEGIN
            IF NOT S.EMPTY THEN
            BEGIN REF(ELEMENT) E;
                E :- S.FIRST;
                WHILE E =/= NONE DO
                BEGIN SU.ADD(E); E :- E.SUC;
                END;
            END;
        END;
        UNION :- SU;
    END**OF**UNION;

    REF(SET) PROCEDURE INTERSECTION(S1, S2); REF(SET) S1, S2;
    BEGIN REF(SET) SI;
        SI :- NEW SET;
        IF NOT S1.EMPTY THEN
        BEGIN REF(ELEMENT) E;
            E :- S1.FIRST;
            WHILE E =/= NONE DO
            BEGIN IF ISIN(E, S2) THEN SI.ADD(E); E :- E.SUC;
            END;
        END;
        INTERSECTION :- SI;
    END**OF**INTERSECTION;

    REF(SET) PROCEDURE MINUS(S1, S2); REF(SET) S1, S2;
    BEGIN REF(SET) SM;
        SM :- NEW SET;
        IF NOT S1.EMPTY THEN
        BEGIN REF(ELEMENT) E;
            E :- S1.FIRST;
            WHILE E =/= NONE DO
            BEGIN IF NOT ISIN(E, S2) THEN SM.ADD(E); E :- E.SUC;
            END;
        END;
        MINUS :- SM;
    END**OF**MINUS;

    BOOLEAN PROCEDURE ISSUBSET(S1, S2); REF(SET) S1, S2;
    BEGIN BOOLEAN B;
        B := TRUE;
        IF NOT S1.EMPTY THEN
        BEGIN REF(ELEMENT) E;
            E :- S1.FIRST;
            WHILE B AND E =/= NONE DO
            BEGIN
                B := ISIN(E, S2);
                E :- E.SUC;
            END;
        END;
        ISSUBSET := B;
    END**OF**ISSUBSET;

    BOOLEAN PROCEDURE ISEQUAL(S1, S2); REF(SET) S1, S2;
    BEGIN
        ISEQUAL := ISSUBSET(S1, S2) AND THEN ISSUBSET(S2, S1)
    END**OF**ISEQUAL;

    BOOLEAN PROCEDURE ISIN(ELE,S); REF(ELEMENT) ELE; REF(SET) S;
    BEGIN
        REF(ELEMENT) E; BOOLEAN FOUND;
        IF NOT S.EMPTY THEN
        BEGIN
            E :- S.FIRST;
            FOUND := E.ISEQUAL(ELE);
            WHILE NOT FOUND AND E =/= NONE DO
            BEGIN FOUND := E.ISEQUAL(ELE); E :- E.SUC;
            END;
        END;
        ISIN := FOUND
    END**OF**ISIN;

    PROCEDURE OUTSET(S); REF(SET) S;
    BEGIN
        REF(ELEMENT) E;
        OUTCHAR('{');
        IF NOT S.EMPTY THEN
        BEGIN
            E :- S.FIRST; OUTTEXT(E.REPR);
            FOR E :- E.SUC WHILE E =/= NONE DO
            BEGIN OUTTEXT(", "); OUTTEXT(E.REPR);
            END;
        END;
        OUTCHAR('}');
    END**OF**OUTSET;


    COMMENT ============== EXAMPLE USING SETS OF NUMBERS ============== ;


    ELEMENT CLASS NUMBER(N); INTEGER N;
    BEGIN
        BOOLEAN PROCEDURE ISEQUAL(OTHER); REF(ELEMENT) OTHER;
            ISEQUAL := N = OTHER QUA NUMBER.N;
        TEXT PROCEDURE REPR;
        BEGIN TEXT T; INTEGER I;
            T :- BLANKS(20); T.PUTINT(N);
            T.SETPOS(1);
            WHILE T.GETCHAR = ' ' DO;
            REPR :- T.SUB(T.POS - 1, T.LENGTH - T.POS + 2);
        END;
        REF(ELEMENT) PROCEDURE CLONE;
            CLONE :- NEW NUMBER(N);
    END**OF**NUMBER;

    PROCEDURE REPORT(S1, MSG1, S2, MSG2, S3); REF(SET) S1, S2, S3; TEXT MSG1, MSG2;
    BEGIN
        OUTSET(S1);    OUTCHAR(' ');
        OUTTEXT(MSG1); OUTCHAR(' ');
        OUTSET(S2);    OUTCHAR(' ');
        OUTTEXT(MSG2); OUTCHAR(' ');
        OUTSET(S3);
        OUTIMAGE;
    END**OF**REPORT;

    PROCEDURE REPORTBOOL(S1, MSG1, S2, MSG2, B); REF(SET) S1, S2; TEXT MSG1, MSG2; BOOLEAN B;
    BEGIN
        OUTSET(S1);    OUTCHAR(' ');
        OUTTEXT(MSG1); OUTCHAR(' ');
        OUTSET(S2);    OUTCHAR(' ');
        OUTTEXT(MSG2); OUTCHAR(' ');
        OUTTEXT(IF B THEN "T" ELSE "F");
        OUTIMAGE;
    END**OF**REPORTBOOL;

    PROCEDURE REPORTNUMBOOL(N1, MSG1, S1, MSG2, B); REF(ELEMENT) N1; REF(SET) S1; TEXT MSG1, MSG2; BOOLEAN B;
    BEGIN
        OUTTEXT(N1.REPR);    OUTCHAR(' ');
        OUTTEXT(MSG1); OUTCHAR(' ');
        OUTSET(S1);    OUTCHAR(' ');
        OUTTEXT(MSG2); OUTCHAR(' ');
        OUTTEXT(IF B THEN "T" ELSE "F");
        OUTIMAGE;
    END**OF**REPORTNUMBOOL;

    REF(SET) S1, S2, S3, S4, S5;
    REF(ELEMENT) E;
    INTEGER I;

    S1 :- NEW SET; FOR I := 1, 2, 3, 4    DO S1.ADD(NEW NUMBER(I));
    S2 :- NEW SET; FOR I := 3, 4, 5, 6    DO S2.ADD(NEW NUMBER(I));
    S3 :- NEW SET; FOR I := 3, 1          DO S3.ADD(NEW NUMBER(I));
    S4 :- NEW SET; FOR I := 1, 2, 3, 4, 5 DO S4.ADD(NEW NUMBER(I));
    S5 :- NEW SET; FOR I := 4, 3, 2, 1    DO S5.ADD(NEW NUMBER(I));

    REPORT(S1, "UNION", S2, " = ", UNION(S1, S2));

    REPORT(S1, "INTERSECTION", S2, " = ", INTERSECTION(S1, S2));

    REPORT(S1, "MINUS", S2, " = ", MINUS(S1, S2));

    REPORT(S2, "MINUS", S1, " = ", MINUS(S2, S1));

    E :- NEW NUMBER(2);
    REPORTNUMBOOL(E, "IN", S1, " = ", ISIN(E, S1));

    E :- NEW NUMBER(10);
    REPORTNUMBOOL(E, "NOT IN", S1, " = ", NOT ISIN(E, S1));

    REPORTBOOL(S1, "IS SUBSET OF", S1, " = ", ISSUBSET(S1, S1));
    REPORTBOOL(S3, "IS SUBSET OF", S1, " = ", ISSUBSET(S3, S1));
    REPORTBOOL(S4, "IS SUPERSET OF", S1, " = ", ISSUBSET(S1, S4));

    REPORTBOOL(S1, "IS EQUAL TO", S2, " = ", ISEQUAL(S1, S2));
    REPORTBOOL(S2, "IS EQUAL TO", S2, " = ", ISEQUAL(S2, S2));
    REPORTBOOL(S1, "IS EQUAL TO", S5, " = ", ISEQUAL(S1, S5));

END.