RosettaCodeData/Task/AVL-tree/Simula/avl-tree-1.simula

CLASS AVL;
BEGIN

    ! AVL TREE ADAPTED FROM JULIENNE WALKER'S PRESENTATION AT ;
    ! HTTP://ETERNALLYCONFUZZLED.COM/TUTS/DATASTRUCTURES/JSW_TUT_AVL.ASPX. ;
    ! THIS PORT USES SIMILAR INDENTIFIER NAMES. ;

    ! THE KEY INTERFACE MUST BE SUPPORTED BY DATA STORED IN THE AVL TREE. ;
    CLASS KEY;
    VIRTUAL:
        PROCEDURE LESS  IS BOOLEAN PROCEDURE LESS (K); REF(KEY) K;;
        PROCEDURE EQUAL IS BOOLEAN PROCEDURE EQUAL(K); REF(KEY) K;;
    BEGIN
    END KEY;

    ! NODE IS A NODE IN AN AVL TREE. ;
    CLASS NODE(DATA); REF(KEY) DATA;  ! ANYTHING COMPARABLE WITH LESS AND EQUAL. ;
    BEGIN
        INTEGER  BALANCE;             ! BALANCE FACTOR ;
        REF(NODE) ARRAY LINK(0:1);    ! CHILDREN, INDEXED BY "DIRECTION", 0 OR 1. ;
    END NODE;

    ! A LITTLE READABILITY FUNCTION FOR RETURNING THE OPPOSITE OF A DIRECTION, ;
    ! WHERE A DIRECTION IS 0 OR 1. ;
    ! WHERE JW WRITES !DIR, THIS CODE HAS OPP(DIR). ;
    INTEGER PROCEDURE OPP(DIR); INTEGER DIR;
    BEGIN
        OPP := 1 - DIR;
    END OPP;

    ! SINGLE ROTATION ;
    REF(NODE) PROCEDURE SINGLE(ROOT, DIR); REF(NODE) ROOT; INTEGER DIR;
    BEGIN
        REF(NODE) SAVE;
        SAVE :- ROOT.LINK(OPP(DIR));
        ROOT.LINK(OPP(DIR)) :- SAVE.LINK(DIR);
        SAVE.LINK(DIR) :- ROOT;
        SINGLE :- SAVE;
    END SINGLE;

    ! DOUBLE ROTATION ;
    REF(NODE) PROCEDURE DOUBLE(ROOT, DIR); REF(NODE) ROOT; INTEGER DIR;
    BEGIN
        REF(NODE) SAVE;
        SAVE :- ROOT.LINK(OPP(DIR)).LINK(DIR);

        ROOT.LINK(OPP(DIR)).LINK(DIR) :- SAVE.LINK(OPP(DIR));
        SAVE.LINK(OPP(DIR)) :- ROOT.LINK(OPP(DIR));
        ROOT.LINK(OPP(DIR)) :- SAVE;

        SAVE :- ROOT.LINK(OPP(DIR));
        ROOT.LINK(OPP(DIR)) :- SAVE.LINK(DIR);
        SAVE.LINK(DIR) :- ROOT;
        DOUBLE :- SAVE;
    END DOUBLE;

    ! ADJUST BALANCE FACTORS AFTER DOUBLE ROTATION ;
    PROCEDURE ADJUSTBALANCE(ROOT, DIR, BAL); REF(NODE) ROOT; INTEGER DIR, BAL;
    BEGIN
        REF(NODE) N, NN;
        N :- ROOT.LINK(DIR);
        NN :- N.LINK(OPP(DIR));
        IF NN.BALANCE = 0   THEN BEGIN ROOT.BALANCE := 0;    N.BALANCE := 0;   END ELSE
        IF NN.BALANCE = BAL THEN BEGIN ROOT.BALANCE := -BAL; N.BALANCE := 0;   END
                            ELSE BEGIN ROOT.BALANCE := 0;    N.BALANCE := BAL; END;
        NN.BALANCE := 0;
    END ADJUSTBALANCE;

    REF(NODE) PROCEDURE INSERTBALANCE(ROOT, DIR); REF(NODE) ROOT; INTEGER DIR;
    BEGIN REF(NODE) N;  INTEGER BAL;
        N :- ROOT.LINK(DIR);
        BAL := 2*DIR - 1;
        IF N.BALANCE = BAL THEN
        BEGIN
            ROOT.BALANCE := 0;
            N.BALANCE := 0;
            INSERTBALANCE :- SINGLE(ROOT, OPP(DIR));
        END ELSE
        BEGIN
            ADJUSTBALANCE(ROOT, DIR, BAL);
            INSERTBALANCE :- DOUBLE(ROOT, OPP(DIR));
        END;
    END INSERTBALANCE;

    CLASS TUPLE(N,B); REF(NODE) N; BOOLEAN B;;

    REF(TUPLE) PROCEDURE INSERTR(ROOT, DATA); REF(NODE) ROOT; REF(KEY) DATA;
    BEGIN
        IF ROOT == NONE THEN
            INSERTR :- NEW TUPLE(NEW NODE(DATA), FALSE)
        ELSE
        BEGIN
            REF(TUPLE) T;  BOOLEAN DONE;  INTEGER DIR;
            DIR := 0;
            IF ROOT.DATA.LESS(DATA) THEN
                DIR := 1;
            T :- INSERTR(ROOT.LINK(DIR), DATA);
            ROOT.LINK(DIR) :- T.N;
            DONE := T.B;
            IF DONE THEN INSERTR :- NEW TUPLE(ROOT, TRUE) ELSE
            BEGIN
                ROOT.BALANCE := ROOT.BALANCE + 2*DIR - 1;
                IF ROOT.BALANCE = 0 THEN
                    INSERTR :- NEW TUPLE(ROOT, TRUE) ELSE
                IF ROOT.BALANCE = 1 OR ROOT.BALANCE = -1 THEN
                    INSERTR :- NEW TUPLE(ROOT, FALSE)
                ELSE
                    INSERTR :- NEW TUPLE(INSERTBALANCE(ROOT, DIR), TRUE);
            END;
        END;
    END INSERTR;

    ! INSERT A NODE INTO THE AVL TREE. ;
    ! DATA IS INSERTED EVEN IF OTHER DATA WITH THE SAME KEY ALREADY EXISTS. ;
    PROCEDURE INSERT(TREE, DATA); NAME TREE; REF(NODE) TREE; REF(KEY) DATA;
    BEGIN
        REF(TUPLE) T;
        T :- INSERTR(TREE, DATA);
        TREE :- T.N;
    END INSERT;

    REF(TUPLE) PROCEDURE REMOVEBALANCE(ROOT, DIR); REF(NODE) ROOT; INTEGER DIR;
    BEGIN REF(NODE) N;  INTEGER BAL;
        N :- ROOT.LINK(OPP(DIR));
        BAL := 2*DIR - 1;

        IF N.BALANCE = -BAL THEN
        BEGIN ROOT.BALANCE := 0; N.BALANCE := 0;
            REMOVEBALANCE :- NEW TUPLE(SINGLE(ROOT, DIR), FALSE);
        END ELSE

        IF N.BALANCE = BAL THEN
        BEGIN ADJUSTBALANCE(ROOT, OPP(DIR), -BAL);
            REMOVEBALANCE :- NEW TUPLE(DOUBLE(ROOT, DIR), FALSE);
        END ELSE

        BEGIN ROOT.BALANCE := -BAL; N.BALANCE := BAL;
            REMOVEBALANCE :- NEW TUPLE(SINGLE(ROOT, DIR), TRUE);
        END
    END REMOVEBALANCE;

    REF(TUPLE) PROCEDURE REMOVER(ROOT, DATA); REF(NODE) ROOT; REF(KEY) DATA;
    BEGIN INTEGER DIR; BOOLEAN DONE; REF(TUPLE) T;

        IF ROOT == NONE THEN
            REMOVER :- NEW TUPLE(NONE, FALSE)
        ELSE
        IF ROOT.DATA.EQUAL(DATA) THEN
        BEGIN
            IF ROOT.LINK(0) == NONE THEN
            BEGIN
                REMOVER :- NEW TUPLE(ROOT.LINK(1), FALSE);
                GOTO L;
            END

            ELSE IF ROOT.LINK(1) == NONE THEN
            BEGIN
                REMOVER :- NEW TUPLE(ROOT.LINK(0), FALSE);
                GOTO L;
            END

            ELSE
            BEGIN REF(NODE) HEIR;
                HEIR :- ROOT.LINK(0);
                WHILE HEIR.LINK(1) =/= NONE DO
                    HEIR :- HEIR.LINK(1);
                ROOT.DATA :- HEIR.DATA;
                DATA :- HEIR.DATA;
            END;
        END;
        DIR := 0;
        IF ROOT.DATA.LESS(DATA) THEN
            DIR := 1;
        T :- REMOVER(ROOT.LINK(DIR), DATA); ROOT.LINK(DIR) :- T.N; DONE := T.B;
        IF DONE THEN
        BEGIN
            REMOVER :- NEW TUPLE(ROOT, TRUE);
            GOTO L;
        END;
        ROOT.BALANCE := ROOT.BALANCE + 1 - 2*DIR;
        IF ROOT.BALANCE = 1 OR ROOT.BALANCE = -1 THEN
            REMOVER :- NEW TUPLE(ROOT, TRUE)

        ELSE IF ROOT.BALANCE = 0 THEN
            REMOVER :- NEW TUPLE(ROOT, FALSE)

        ELSE
            REMOVER :- REMOVEBALANCE(ROOT, DIR);
    L:
    END REMOVER;

    ! REMOVE A SINGLE ITEM FROM AN AVL TREE. ;
    ! IF KEY DOES NOT EXIST, FUNCTION HAS NO EFFECT. ;
    PROCEDURE REMOVE(TREE, DATA); NAME TREE; REF(NODE) TREE; REF(KEY) DATA;
    BEGIN REF(TUPLE) T;
        T :- REMOVER(TREE, DATA);
        TREE :- T.N;
    END REMOVEM;

END.