$ ADA/LIST TEST_SHELLI_SORT
    1 	
    2 	-- This is a demonstration of the SHELLI sort tested as an
    3 	-- embedded procedure. The homework is to create a package
    4 	-- with this sort appropriately modified in the package,
    5 	-- then modify Homework 2 to "with" the package and call
    6 	-- SHELLI
    7 	--
    8 	with TEXT_IO ; use TEXT_IO ;
    9 	
   10 	procedure TEST_SHELLI_SORT is
   11 	
   12 	  package INT_IO is new INTEGER_IO ( INTEGER ) ; use INT_IO ;
   13 	
   14 	  package FLT_IO is new FLOAT_IO ( FLOAT ) ; use FLT_IO ;
   15 	
   16 	  subtype NAMES is STRING ( 1 .. 3 ) ;
   17 	
   18 	--      create user defined type  A_NAMES  (note: the box <> means
   19 	--                                          to be filled in later)
   20 	  type A_NAMES is array ( INTEGER range <> ) of NAMES ;
   21 	
   22 	--      create object  ACCOUNT_NAMES with indicies  1..9, and initialize
   23 	  ACCOUNT_NAMES : A_NAMES ( 1 .. 9 ) := ( "MMM" , "NNN" , "AAA" , "CCC" ,
   24 	     "BBB" , "ZZZ" , "XXX" , "PPP" , "QQQ" ) ;
   25 	
   26 	--      create user defined type  A_BALANCES
   27 	  type A_BALANCES is array ( INTEGER range <> ) of FLOAT ;
   28 	
   29 	--      create object  BALANCES  with indicies  1..9, and initialize
   30 	  BALANCES : A_BALANCES ( 1 .. 9 ) := ( 1.0 , 2.0 , 3.0 , 4.0 , 5.0 , 6.0 ,
   31 	     7.0 , 8.0 , 9.0 ) ;
   32 	
   33 	--
   34 	  OPEN_ACCOUNTS : INTEGER := 9 ;
   35 	
   36 	  procedure PRINT_ACCOUNTS is
   37 	  begin
   38 	    for I in 1 .. OPEN_ACCOUNTS loop
   39 	      PUT ( ACCOUNT_NAMES( I )) ;
   40 	      PUT ( BALANCES( I )) ;
   41 	      PUT_LINE ( "" ) ;
   42 	    end loop ;
   43 	  end PRINT_ACCOUNTS ;
   44 	

   44 	
   45 	-- This is an order N log N sort
   46 	-- It is very efficient on large arrays ( no recursion helps )
   47 	  procedure SHELLI ( SIZE : in INTEGER ;
   48 	                     ARR1 : in out A_NAMES ;
   49 	                     ARR2 : in out A_BALANCES ) is
   50 	    M , I , J , LIMIT : INTEGER ;
   51 	    TEMP2 : FLOAT ;
   52 	    TEMP1 : NAMES ;
   53 	  begin
   54 	    M := SIZE ;
   55 	    while M > 1 loop  -- log base 2 of SIZE times through this loop
   56 	      M := M / 2 ;
   57 	      LIMIT := SIZE - M ;
   58 	      for J in 1 .. LIMIT loop  -- at most SIZE times through this loop
   59 	        I := J ;
   60 	        while I > 0 loop  -- this loop depends on data, about 2.5 times
   61 	
   62 	-- compare on whatever is being sorted
   63 	          if ARR1 ( I ) > ARR1 ( I + M ) then
   64 	
   65 	-- interchange,  3 statements for each array
   66 	--               being sorted
   67 	            TEMP1 := ARR1 ( I ) ;
   68 	            ARR1 ( I ) := ARR1 ( I + M ) ;
   69 	            ARR1 ( I + M ) := TEMP1 ;
   70 	--
   71 	            TEMP2 := ARR2 ( I ) ;
   72 	            ARR2 ( I ) := ARR2 ( I + M ) ;
   73 	            ARR2 ( I + M ) := TEMP2 ;
   74 	            I := I - M ;  -- must check previous entry
   75 	          else
   76 	            exit ;  -- while I > 0 , previous entries sorted
   77 	          end if ;
   78 	        end loop ;  -- on while I > 0
   79 	      end loop ;  -- on for J in 1..LIMIT
   80 	    end loop ;  -- on while M > 1
   81 	  end SHELLI ;  -- return from procedure
   82 	

   82 	
   83 	begin
   84 	  PUT_LINE ( " RAW DATA " ) ;
   85 	  PRINT_ACCOUNTS ;  -- print unsorted data
   86 	  SHELLI ( OPEN_ACCOUNTS , ACCOUNT_NAMES , BALANCES ) ;  -- call the sort
   87 	  PUT_LINE ( " SORTED " ) ;
   88 	  PRINT_ACCOUNTS ;  -- print sorted data
   89 	end TEST_SHELLI_SORT ;

$ ACS LINK TEST_SHELLI_SORT
$ ASSIGN/USER TEST_SHELLI_SORT.OUT ADA$OUTPUT
$ RUN TEST_SHELLI_SORT
$ TYPE TEST_SHELLI_SORT.OUT

 RAW DATA 
MMM 1.00000E+00
NNN 2.00000E+00
AAA 3.00000E+00
CCC 4.00000E+00
BBB 5.00000E+00
ZZZ 6.00000E+00
XXX 7.00000E+00
PPP 8.00000E+00
QQQ 9.00000E+00
 SORTED 
AAA 3.00000E+00
BBB 5.00000E+00
CCC 4.00000E+00
MMM 1.00000E+00
NNN 2.00000E+00
PPP 8.00000E+00
QQQ 9.00000E+00
XXX 7.00000E+00
ZZZ 6.00000E+00