home *** CD-ROM | disk | FTP | other *** search
/ NetNews Usenet Archive 1992 #27 / NN_1992_27.iso / spool / alt / sources / 2533 / mergesort.ps < prev   
Encoding:
Text File  |  1992-11-16  |  1.4 KB  |  70 lines
  1. %!
  2.  
  3. % PostScript merge sort
  4. % by Charles Hannum, 16 November 1992
  5.  
  6. % Do the merge sort on a dictionary or array.  `proc' is a comparison
  7. % procedure.  If the second argument is a `dict', it is converted to
  8. % an array of 2-element arrays (containing the key and value) before
  9. % sorting.  Returns the same array, sorted.
  10.  
  11. % proc dict|array  mergesort  array
  12. /mergesort {
  13.   dup type /dicttype eq {
  14.     dup length array 0 3 -1 roll
  15.     {2 array astore
  16.      2 index 2 index 3 -1 roll put
  17.      1 add} forall
  18.     pop
  19.   } if
  20.   dup type /arraytype ne {typecheck} if
  21.   mergesort-recurse
  22.   exch pop
  23. } def
  24.  
  25. % proc array  mergesort-recurse  proc array
  26. /mergesort-recurse {
  27.   dup length
  28.   1 gt {
  29.     dup length dup 2 idiv
  30.     exch 1 index sub
  31.     3 copy getinterval
  32.     4 1 roll pop
  33.     0 exch 2 index 3 1 roll
  34.     getinterval
  35.  
  36.     4 2 roll
  37.     mergesort-recurse
  38.     3 1 roll exch
  39.     mergesort-recurse
  40.     exch 4 1 roll
  41.  
  42. %%  save 5 1 roll
  43.       dup length array copy exch
  44.       dup length array copy exch
  45.     
  46.       dup length 3 -1 roll
  47.       dup length 5 -1 roll
  48.       dup length 6 2 roll
  49.  
  50.       {
  51.         4 copy 1 sub get 3 1 roll 1 sub get
  52.         8 index exec
  53.         {4 2 roll} if
  54.         1 sub 2 copy get
  55.         6 -1 roll 1 sub dup 7 1 roll exch
  56.         7 index 3 1 roll
  57.         put
  58.         dup 0 eq {exit} if
  59.       } loop
  60.       pop pop
  61.       1 sub -1 0 {
  62.         2 copy get
  63.         4 index 3 1 roll
  64.         put
  65.       } for
  66.       pop pop
  67. %%  3 -1 roll restore
  68.   } if
  69. } def
  70.