MODULE snailsort;
(* demonstrates the wonderful slowness of the snailsort algorithm *)

FROM BIO IMPORT GetInteger, PutInteger; (* or whatever needed for ElementType *)
FROM BIO IMPORT GetLine, GetCardinal, PutCardinal,
                PutString, PutLine, PutLn;
FROM RND IMPORT RND;




CONST
  N = 1000;

TYPE 
  ElementType = INTEGER; (* or any other ordered type *)
  ArrayType   = ARRAY [1..N] OF ElementType;
  ArraySizeType = [1..N];

VAR
  the_array    : ArrayType;
  array_size   : ArraySizeType;
  i            : ArraySizeType;
  LT_GLOBAL_CLOCK : CARDINAL;
  EQ_GLOBAL_CLOCK : CARDINAL;




PROCEDURE snailsort (VAR array : ArrayType; n : ArraySizeType);
(* task: sorts the given array fantastically slowly and inefficiently *)
(* approximately 0.5 n^4 time typical, best and worst cases also appear to be
    order n^4 !!! ---at least when the elements are all, or mostly, distinct.
    When they're all the same snailsort takes "only" order n^3. *)

  VAR
    workspace             : ArrayType;
    position_in_workspace : [1..N];
    position_in_array     : [1..N];


  PROCEDURE is_smallest_eligible_to_be_copied (x : ElementType) : BOOLEAN;

    VAR
      i : [1..N];

  BEGIN
    FOR i := 1 TO n DO
      IF (no_of_copies_in_workspace(array[i]) < no_of_copies_in_array(array[i]))
          AND LessThan(array[i],x)
      THEN
        RETURN FALSE
      END (* IF *)
    END (* FOR *);
    RETURN no_of_copies_in_workspace(x) < no_of_copies_in_array(x)
  END (* PROCEDURE *) is_smallest_eligible_to_be_copied;


  PROCEDURE no_of_copies_in_workspace (x : ElementType) : CARDINAL;

    VAR
      i : [0..N]; (* really [1..N] but it complains when 1 TO 0 *)
      count : CARDINAL;

  BEGIN
    count := 0;
    FOR i := 1 TO position_in_workspace - 1 DO
      IF Equal(workspace[i], x) THEN INC(count)
      END (* IF *)
    END (* FOR *);
    RETURN count
  END (* PROCEDURE *) no_of_copies_in_workspace;


  PROCEDURE no_of_copies_in_array (x : ElementType) : CARDINAL;

    VAR
      i : [1..N];
      count : CARDINAL;

  BEGIN
    count := 0;
    FOR i := 1 TO n DO
      IF Equal(array[i], x) THEN INC(count)
      END (* IF *)
    END (* FOR *);
    RETURN count
  END (* PROCEDURE *) no_of_copies_in_array;


BEGIN (* PROCEDURE snailsort *)

  FOR position_in_workspace := 1 TO n DO
    (* find smallest array element eligible to be copied over to workspace,
        and copy it *)
    position_in_array := 1;
    WHILE NOT is_smallest_eligible_to_be_copied(array[position_in_array]) DO
      INC(position_in_array)
    END (* WHILE *);
    workspace[position_in_workspace] := array[position_in_array]
  END (* FOR *);

  array := workspace
END (* PROCEDURE *) snailsort;





PROCEDURE GetArray (VAR a : ArrayType; VAR n : ArraySizeType);

  VAR
    i : [1..N];
    silly_mocka_variable : CARDINAL;

BEGIN
  GetCardinal(silly_mocka_variable); n := silly_mocka_variable;
  FOR i := 1 TO n DO
    GetElementType(a[i])
  END (* FOR *);
  GetLine
END (* PROCEDURE *) GetArray;




PROCEDURE PutArray (a : ArrayType; n : ArraySizeType);

  VAR
    i : [1..N];

BEGIN
  PutString("[");
  FOR i := 1 TO n DO
    PutElementType(a[i]);
    IF i<n THEN PutString(",") END (* IF *)
  END (* FOR *);
  PutString("]")
END (* PROCEDURE *) PutArray;




PROCEDURE GetElementType (VAR e : ElementType);

BEGIN
  GetInteger(e) (* or whatever *)
END (* PROCEDURE *) GetElementType;




PROCEDURE PutElementType (e : ElementType);

BEGIN
  PutInteger(e) (* or whatever *)
END (* PROCEDURE *) PutElementType;





PROCEDURE LessThan (a,b : ElementType) : BOOLEAN;

BEGIN
  INC(LT_GLOBAL_CLOCK);
  RETURN a<b (* or whatever *)
END (* PROCEDURE *) LessThan;



PROCEDURE Equal(a,b : ElementType) : BOOLEAN;

BEGIN
  INC(EQ_GLOBAL_CLOCK);
  RETURN a=b (* or whatever *)
END (* PROCEDURE *) Equal;










BEGIN (* main program *)
  (*
  WHILE TRUE DO
    PutString("Enter an unsorted array: ");
    GetArray(the_array,array_size);
    PutString("The unsorted array is ");
    PutArray(the_array,array_size); PutLine;
    LT_GLOBAL_CLOCK := 0;
    EQ_GLOBAL_CLOCK := 0;
    PutLn("sorting now in progress..........");
    snailsort(the_array,array_size);
    PutString("The sorted array is ");
    PutArray(the_array,array_size); PutLine;
    PutString("The sort time was ");
    PutCardinal(LT_GLOBAL_CLOCK); PutString(" LTs, ");
    PutCardinal(EQ_GLOBAL_CLOCK); PutString(" EQs, ");
    PutCardinal(LT_GLOBAL_CLOCK+EQ_GLOBAL_CLOCK); PutLn(" total."); PutLine
  ENDWHILE
  *)
  
  FOR array_size := 10 TO N BY 10 DO
    FOR i := 1 TO array_size DO
      the_array[i] := TRUNC(10000.0*RND())
      (* the_array[i] := array_size - i *)
    END (* FOR *);
    PutString("n=");PutCardinal(array_size);PutLine;
    PutString("unsorted="); PutArray(the_array, array_size); PutLine;
    LT_GLOBAL_CLOCK := 0;
    EQ_GLOBAL_CLOCK := 0;
    snailsort(the_array,array_size);
    PutString("  sorted="); PutArray(the_array, array_size); PutLine;
    PutCardinal(LT_GLOBAL_CLOCK); PutString(" LTs, ");
    PutCardinal(EQ_GLOBAL_CLOCK); PutString(" EQs, ");
    PutCardinal(LT_GLOBAL_CLOCK+EQ_GLOBAL_CLOCK); PutLn(" total."); PutLine
  END (* FOR *)
END (* MAIN MODULE *) snailsort.