-- MERGESORT.ADB

-- The main component in here is DO_MERGESORT, a procedure
-- which sorts a list of integers with the MERGESORT ("tri
-- par fusion") algorithm.

-- The input and graphical output of the LIST is done by
-- the MYLISTS package.

-- Michael Vorburger, January 1996

with MYLISTS;
use MYLISTS;

with TEXT_IO;
use TEXT_IO;

procedure MERGESORT is
    L   : ILISTS.T_LISTE;

    package IIO is new INTEGER_IO(INTEGER);
    use IIO;
    
    -- GET_FIRST is in fact rather a GET_AND_REMOVE_FIRST: It "returns" the
    -- first element of the list, which is also removed from it.
    -- Important, because MergeSort is ideal for sequential lists.

    procedure GET_FIRST(L: in out ILISTS.T_LISTE; X: out INTEGER) is
    begin
        X:=ILISTS.VALEUR(L,1);
        ILISTS.OTER(L,1);
    end;
    
    
    procedure DO_MERGESORT(L: in out ILISTS.T_LISTE;
                           SHOW_INTERMEDIATE_STEPS : BOOLEAN := FALSE) is

        A,B : ILISTS.T_LISTE; -- The two sublists used for mergesort
        M   : NATURAL := 0;   -- How many "Monotonies" has the current list?
        N   : NATURAL := 1;   -- Cycle counters; just for user information.
        I   : INTEGER;        -- An unimportant (temp) var; see below.

        procedure DISTRIBUTE(L, A, B: in out ILISTS.T_LISTE) is

            -- procedure DISTRIBUTE_ONE_MONOTONY adds elemets of L to X list
            -- until a number smaller than the previous is found.

            procedure DISTRIBUTE_ONE_MONOTONY(X: in out ILISTS.T_LISTE) is

                PREV_NUM : INTEGER := INTEGER'FIRST;    -- previous number 
                CURR_NUM : INTEGER;                     -- current number

                -- By initializing PREV_NUM with the smallest integer, the
                -- condition in the first while loop (see below) is always
                -- fulfilled at the beginning!

            begin -- DISTRIBUTE_ONE_MONOTONY

                GET_FIRST(L,CURR_NUM);

                while CURR_NUM>=PREV_NUM loop
                    ILISTS.AJOUTER(X,CURR_NUM);
                    PREV_NUM:=CURR_NUM;
                    exit when ILISTS.VIDE(L);
                    GET_FIRST(L,CURR_NUM);
                end loop;

                -- If CURR_NUM>=PREV_NUM then we removed one element too much,
                -- and append it therefore again.
                -- This is not a 100% nice solution; the alternative would have
                -- been to use a "look-ahead" thing (Check if the next number
                -- is bigger than the current, and removing if this is the
                -- case.)

                if CURR_NUM<PREV_NUM then ILISTS.AJOUTER(L,CURR_NUM,1); end if;
 
                M:=M+1; -- A monotony was found.

            end DISTRIBUTE_ONE_MONOTONY;

    begin -- DISTRIBUTE

        M:=0;  -- reset number of monotonies to zero

        while not ILISTS.VIDE(L) loop

            DISTRIBUTE_ONE_MONOTONY(A);

            if not ILISTS.VIDE(L) then DISTRIBUTE_ONE_MONOTONY(B); end if;

        end loop;

    end DISTRIBUTE;


    procedure MERGE(A,B,L: in out ILISTS.T_LISTE) is

        CURR_NUM_A, CURR_NUM_B : INTEGER;

    begin

        if not ILISTS.VIDE(A) then
            GET_FIRST(A,CURR_NUM_A);
        else                                -- This means that A was empty!
            while not ILISTS.VIDE(B) loop   --   So, we simply copy the whole B
                GET_FIRST(B,CURR_NUM_B);    --   into L.
                ILISTS.AJOUTER(L,CURR_NUM_B);
            end loop;
            return;
        end if;

        if not ILISTS.VIDE(B) then
            GET_FIRST(B,CURR_NUM_B);
        else                                -- As above; but for B.
            ILISTS.AJOUTER(L,CURR_NUM_A);   -- Value has already been read!
            while not ILISTS.VIDE(A) loop
                GET_FIRST(A,CURR_NUM_A);
                ILISTS.AJOUTER(L,CURR_NUM_A);
            end loop;		    
            return;
        end if;

        loop 
            if CURR_NUM_A>CURR_NUM_B then
                ILISTS.AJOUTER(L,CURR_NUM_B);
                if not ILISTS.VIDE(B) then
                    GET_FIRST(B,CURR_NUM_B);
                else                           -- This means that B is empty!
                    ILISTS.AJOUTER(L,CURR_NUM_A);
                    while not ILISTS.VIDE(A) loop  -- So, we move the remaining 
                        GET_FIRST(A,CURR_NUM_A);   -- remaining A list to L
                        ILISTS.AJOUTER(L,CURR_NUM_A);
                    end loop;
                    exit;                          -- We can leave here.
                end if;
            else
                ILISTS.AJOUTER(L,CURR_NUM_A);
                if not ILISTS.VIDE(A) then
                    GET_FIRST(A,CURR_NUM_A);
                else                           -- Same as above, for A
                    ILISTS.AJOUTER(L,CURR_NUM_B);
                    while not ILISTS.VIDE(B) loop
                        GET_FIRST(B,CURR_NUM_B);
                        ILISTS.AJOUTER(L,CURR_NUM_B);
                    end loop;
                    exit;
                end if;
            end if;

        end loop;
    end MERGE;


    begin -- DO_MERGESORT

        DISTRIBUTE(L,A,B);

        if SHOW_INTERMEDIATE_STEPS and M>1 then
            PUT("First Distribute:"); NEW_LINE;
            PUT("  List A:"); NEW_LINE; SHOWLIST(A);
            PUT("  List B:"); NEW_LINE; SHOWLIST(B);
        end if;

        while M>1 loop

            MERGE(A,B,L);
            if SHOW_INTERMEDIATE_STEPS then
                PUT("After "); PUT(N,3); PUT(". Merge:"); NEW_LINE;
                PUT("  List L: "); NEW_LINE; SHOWLIST(L);
            end if;	    

            N:=N+1;

            DISTRIBUTE(L,A,B);
            if SHOW_INTERMEDIATE_STEPS and M>1 then
                TEXT_IO.NEW_LINE;
                PUT("Hit a key to run next cycle...");
                TEXT_IO.SKIP_LINE;

                PUT("After "); PUT(N,3); PUT(". Distribute: (");
                PUT(M,3); PUT(" monotonies found)"); NEW_LINE;
                PUT("  List A:"); NEW_LINE; SHOWLIST(A);
                PUT("  List B:"); NEW_LINE; SHOWLIST(B);
                NEW_LINE;
            end if;

        end loop;

        -- If L was already sorted, all elements are now in A instead L:

        if ILISTS.VIDE(L) then
            while not ILISTS.VIDE(A) loop
                GET_FIRST(A,I);
                ILISTS.AJOUTER(L,I);
            end loop;
        end if;  
 
    end DO_MERGESORT;
    
    
begin -- of MERGESORT

    PUT("Welcome to a DEMO application of the MERGESORT algorithm."); NEW_LINE;
    GET_KBD_OR_RANDOM(L);

    DO_MERGESORT(L, SHOW_INTERMEDIATE_STEPS => TRUE);

    DRAW_CHART(L);

end MERGESORT;