home *** CD-ROM | disk | FTP | other *** search
/ Simtel MSDOS 1992 June / SIMTEL_0692.cdr / msdos / snobol4 / aisnobol.arc / HSORT.SPT < prev    next >
Encoding:
Text File  |  1987-10-16  |  2.1 KB  |  88 lines
  1. *  HSORT.SPT - SPITBOL Version
  2. *
  3. *  C.A.R. Hoare's Quicksort algorithm
  4. *
  5. * Sort array A according to predicate P.
  6. *
  7. * Demonstration only:  Remember that SPITBOL has a built-in SORT function.
  8. *
  9. * P(A<I>,A<J>) true for all I < J.
  10. *
  11. * Possible values of P:
  12. *     .LE, .GE, .LLE, .LGE.  Use LE and GE for numeric sort, LLE and LGE
  13. *      for lexical sort.
  14. *
  15. * DO NOT USE:
  16. *     .LT, .GT, .LLT, .LGT
  17. *
  18. *  To run with sample data:
  19. *  spitbol -u "hsort.in" hsort.spt
  20. *
  21.  DEFINE('HSORT(A,I,N,P)J,K,C')
  22.  DEFINE('HSORT.KO(V1,V2)')
  23.  DEFINE('HSORT.OK(V1,V2)')
  24.  DEFINE('HSORT.SWAP(I1,I2)T')              :(HSORT.END)
  25. *
  26. HSORT
  27.       GT(N - I,  1)                        :S(HSORT1)
  28.       GE(I, N)                             :S(RETURN)
  29.       (HSORT.KO(A<I>,A<N>)   HSORT.SWAP(I,N))
  30.          :(RETURN)
  31. *
  32. HSORT1
  33.       C = A<(I + N) / 2>
  34.       J = I - 1
  35.       K = N + 1
  36. *
  37. HSORT2   J = J + 1
  38.       HSORT.OK(C,A<J>)                     :F(HSORT2)
  39. HSORT3   K = K - 1
  40.       HSORT.OK(A<K>,C)                     :F(HSORT3)
  41. *
  42.       (LT(J,K)    HSORT.SWAP(J,K))         :S(HSORT2)
  43. *
  44.       HSORT(A, I, K, P)
  45.       HSORT(A, K + 1, N, P)                :(RETURN)
  46. *
  47. HSORT.SWAP  T = A<I1> ; A<I1> = A<I2> ; A<I2> = T     :(RETURN)
  48. *
  49. HSORT.OK      APPLY(P,V1,V2)               :S(RETURN)F(FRETURN)
  50. *
  51. HSORT.KO      APPLY(P,V1,V2)               :S(FRETURN)F(RETURN)
  52. *
  53. HSORT.END
  54. *
  55. *
  56. * Begin main program *****
  57. *
  58. *
  59.       &TRIM = 1
  60.       INPUT(.INPUT,1,HOST(0))                :S(GO)
  61.       TERMINAL = "Cannot open input file: " HOST(0)  :(END)
  62. GO    SETEXIT(.CONTINUE)
  63.  
  64. * Make two passes through input file -- First to count the number of lines
  65. * in the file to allocate an array of the correct size, second pass to read
  66. * in the values.
  67.  
  68.       N = 0
  69. COUNT
  70.       N = ?INPUT   N + 1      :S(COUNT)
  71. *
  72.       A = ARRAY(N)
  73.       REWIND( 1 )
  74.       I = 0
  75. INPUT.LOOP
  76.       I = LT(I,N) I + 1       :F(INPUT.LOOP.END)
  77.       A<I> = INPUT            :(INPUT.LOOP)
  78. INPUT.LOOP.END
  79. *
  80.    HSORT(A,1,N, .LLE)
  81. *
  82.       I = 0
  83. OUTPUT.LOOP
  84.       I = LT(I,N) I + 1       :F(OUTPUT.LOOP.END)
  85.       OUTPUT = LPAD(I,5) ".   " A<I>    :(OUTPUT.LOOP)
  86. OUTPUT.LOOP.END
  87. END
  88.