home *** CD-ROM | disk | FTP | other *** search
/ Programmer's ROM - The Computer Language Library / programmersrom.iso / ada / piwg / z000022.ada < prev    next >
Encoding:
Text File  |  1988-05-03  |  1.6 KB  |  49 lines
  1. generic  -- SHELLI VERSION  for use with GENSORTSH.ADA
  2.   type ELEMENT is private ;
  3.   type ANY_ARRAY is array ( INTEGER range <> ) of ELEMENT ;
  4.   with function ">" ( DUMMY1 , DUMMY2 : ELEMENT ) return BOOLEAN is <> ;
  5.  
  6. package GENSORTSH is
  7.  
  8.   procedure SHSORT ( ARR1 : in out ANY_ARRAY ) ;
  9.  
  10. end GENSORTSH ;
  11.  
  12. package body GENSORTSH is
  13.  
  14.   procedure SHSORT ( ARR1 : in out ANY_ARRAY ) is
  15.  
  16.     TEMP : ELEMENT ;
  17.     M , I , J , LIMIT : INTEGER ;
  18.     SIZE : INTEGER := ARR1'LENGTH ;
  19.     OFFSET : INTEGER := 1 - ARR1'FIRST ;
  20.   begin
  21.     M := SIZE ;
  22.     while M > 1 loop  -- log base 2 of SIZE times
  23.       M := M / 2 ;  --   through this loop
  24.       LIMIT := SIZE - M ;
  25.       for J in 1 .. LIMIT loop  -- at most SIZE times
  26.         I := J ;  --               through this loop
  27.         while I > 0 loop  -- this loop depends on data,
  28.  
  29. --                           statistically about 2.5
  30. --                           times through this loop
  31. --
  32. -- compare on whatever is being sorted
  33.           if ARR1 ( I + OFFSET ) > ARR1 ( I + M + OFFSET ) then
  34.  
  35. -- interchange,  3 statements for each array
  36. --               being sorted
  37.             TEMP := ARR1 ( I + OFFSET ) ;
  38.             ARR1 ( I + OFFSET ) := ARR1 ( I + M + OFFSET ) ;
  39.             ARR1 ( I + M + OFFSET ) := TEMP ;
  40.             I := I - M ;  -- must check previous entry
  41.           else
  42.             exit ;  -- while I > 0 , previous entries sorted
  43.           end if ;
  44.         end loop ;  -- on while I > 0
  45.       end loop ;  -- on for J in 1..LIMIT
  46.     end loop ;  -- on while M > 1
  47.   end SHSORT ;
  48. end GENSORTSH ;
  49.