home *** CD-ROM | disk | FTP | other *** search
/ Power-Programmierung / CD1.mdf / snobol / aisnobol / hsort.sno < prev    next >
Text File  |  1987-10-16  |  2KB  |  85 lines
  1. *  HSORT.SNO - SNOBOL4+ 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 SNOBOL4 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. *  SNOBOL4 HSORT /I:HSORT
  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.  
  61. * Make two passes through input file -- First to count the number of lines
  62. * in the file to allocate an array of the correct size, second pass to read
  63. * in the values.
  64.  
  65.       N = 0
  66. COUNT
  67.       N = ?INPUT   N + 1      :S(COUNT)
  68. *
  69.       A = ARRAY(N)
  70.       REWIND( 5 )
  71.       I = 0
  72. INPUT.LOOP
  73.       I = LT(I,N) I + 1       :F(INPUT.LOOP.END)
  74.       A<I> = INPUT            :(INPUT.LOOP)
  75. INPUT.LOOP.END
  76. *
  77.    HSORT(A,1,N, .LLE)
  78. *
  79.       I = 0
  80. OUTPUT.LOOP
  81.       I = LT(I,N) I + 1       :F(OUTPUT.LOOP.END)
  82.       OUTPUT = LPAD(I,5) ".   " A<I>    :(OUTPUT.LOOP)
  83. OUTPUT.LOOP.END
  84. END
  85.