Re: list strawman

[Jean-Marc Bourguet <jm@bourguet.org>]

Jean-Marc Bourguet <jm@bourguet.org> writes:

> There is a sligth difference with was is presented in Knuth. He use an
> additionnal flag in the record to mark the end of the sublists.  I
> didn't do that and used the fact that a sublist end when there is a
> drop in value.  This has a consequence that sublists may be merged
> inexpectedly and so some care must be taken not to go in O(N^2).

Here is a variant.  Instead of detecting chunks by a drop in value, I
mark the end of chunk with Null and keep the already constructed chunks
in an array.  To keep their number low, I merge them as they are
constructed.

Pure algorithm L is having

procedure Extract_Next_Chunk (Head  : in out Node_Ptr;
			      Chunk :    out Node_Ptr;
		              Slot  :    out Table_Index) is
   Slot := 1;
   Chunk := Head;
   Head := Chunk.Next;
   Chunk.Next := null;
end Extract_Next_Chunk;

instead of what is below.

-- 
Jean-Marc

   ---------------------------------------------------------------------------
   -- Natural List Merge Sort
   -- See D.E. Knuth, The Art Of Computer Programming, Volume 3, Second Edition
   -- Algorithm L section 5.2.4 modified according exercise 12 in the same
   -- section, modified to merge chunks as they are constructed instead of keeping
   -- them.  Already constructed chunks are kept in an array.  They are at most
   -- log_2(N).  Big existing chunk are put at their place in the array, this help
   -- in the presence of nearly sorted input.

   procedure Sort (Head : in out Node_Ptr);
   -- Sort the linked list Head.

   procedure Sort (Head : in out Node_Ptr) is
      
      type Table_Index is range 1 .. 64;

      procedure Extract_Next_Chunk (Head  : in out Node_Ptr;
				    Chunk :    out Node_Ptr;
				    Slot  :    out Table_Index) is
         Last    : Node_Ptr := Head;
         Current : Node_Ptr := Last.Next;
	 Size    : Integer := 1;
	 Next    : Integer := 2;
      begin -- Extract_Next_Chunk
         Chunk := Head;
	 Slot  := 1;
         while Current /= null loop
            pragma Assert (Current = Last.Next);
            if not Ordered (Last.Value, Current.Value) then
	       Last.Next := null;
	       Head := Current;
	       return;
	    end if;
            Last    := Current;
            Current := Last.Next;
	    Size := Size + 1;
	    if Size = Next then
	       Next := 2*Next;
	       Slot := Slot + 1;
	    end if;
         end loop;
	 Head := null;
         pragma Assert (Last.Next = null);
      end Extract_Next_Chunk;
      
      function Merge (L1, L2 : Node_Ptr) return Node_Ptr is
	 Current1 : Node_Ptr := L1;
	 Current2 : Node_Ptr := L2;
	 Last : Node_Ptr := null;
	 Result : Node_Ptr := null;
      begin
	 while Current1 /= null and Current2 /= null loop
	    if Ordered (Current1.Value, Current2.Value) then
	       if Last /= null then
		  Last.Next := Current1;
	       else
		  Result := Current1;
	       end if;
	       Last := Current1;
	       Current1 := Current1.Next;
	    else
	       if Last /= null then
		  Last.Next := Current2;
	       else
		  Result := Current2;
	       end if;
	       Last := Current2;
	       Current2 := Current2.Next;
	    end if;
	 end loop;
	 if Current1 /= null then
	    if Last /= null then
	       Last.Next := Current1;
	    else
	       Result := Current1;
	    end if;
	 elsif Current2 /= null then
	    if Last /= null then
	       Last.Next := Current2;
	    else
	       Result := Current2;
	    end if;
	 end if;
	 return Result;
      end Merge;
      
      type Node_Ptr_Table is array(Table_Index) of Node_Ptr;

      Chunk_Table : Node_Ptr_Table := (others => null);
      -- list pointed by chunk_table(i) as at least 2^(i-1) elements
      
      procedure Merge_With_Other_Chunks (Chunk : Node_Ptr; Slot : Table_Index) is
	 Current : Node_Ptr := Chunk;
	 I : Table_Index := Slot;
      begin -- Merge_With_Other_Chunks
	 while Chunk_Table(I) /= null loop
	    Current := Merge (Current, Chunk_Table(I));
	    Chunk_Table(I) := null;
	    I := I+1;
	 end loop;
	 Chunk_Table(I) := Current;
      end Merge_With_Other_Chunks;
      
      Aux : Node_Ptr;
      Slot : Table_Index;
      
   begin -- Sort
      if Head = null then
         return;
      end if;
      while Head /= null loop
	 Extract_Next_Chunk (Head, Aux, Slot);
	 Merge_With_Other_Chunks (Aux, Slot);
      end loop;
      for I in Table_Index loop
	 Head := Merge (Head, Chunk_Table(I));
      end loop;
   end Sort;