(FILECREATED "20-Mar-86 14:26:34" {QV}<PEDERSEN>LISP>ARRAYSORTER.;2 11593
changes to: (MACROS FLOAT.INDEXSWAPELTS FLOATINDEXAREF GENERIC.SWAPELTS INDEXAREF
GENERIC.INDEXSWAPELTS FLOAT.SWAPELTS)
(VARS ARRAYSORTERCOMS)
(FNS FLOAT.INDEXQSFENCE FLOAT.INDEXINSERTIONSORT FLOAT.INDEXQUICKSORT
INDEXFLOATQUICKSORT GENERIC.QSFENCE GENERIC.QUICKSORT GENERIC.INSERTIONSORT
ARRAYSORT FLOATARRAYSORT INDEXARRAYSORT GENERIC.INDEXQSFENCE
GENERIC.INDEXQUICKSORT GENERIC.INDEXINSERTIONSORT ARRAYQUICKSORT
INDEXQUICKSORT FLOAT.QSFENCE FLOAT.INSERTIONSORT FLOAT.QUICKSORT
FLOATARRAYQUICKSORT)
previous date: "18-Mar-86 23:17:31" {QV}<PEDERSEN>LISP>ARRAYSORTER.;1)
(* Copyright (c) 1986 by Xerox Corporation. All rights reserved.)
(PRETTYCOMPRINT ARRAYSORTERCOMS)
(RPAQQ ARRAYSORTERCOMS ((FNS ARRAYSORT GENERIC.INDEXINSERTIONSORT GENERIC.INDEXQSFENCE
GENERIC.INDEXQUICKSORT GENERIC.INSERTIONSORT GENERIC.QSFENCE
GENERIC.QUICKSORT INDEXARRAYSORT)
(MACROS GENERIC.INDEXSWAPELTS GENERIC.SWAPELTS INDEXAREF)))
(DEFINEQ
(ARRAYSORT
[LAMBDA (ARRAY COMPAREFN) (* jop: "20-Mar-86 14:20")
(* * Sort the 1-dimensional CMLArray ARRAY using the ordering given by COMPAREFN. ARRAY is sorted in place, i.e.
destructively. Returns ARRAY.)
(if (NOT (AND (type? ARRAY ARRAY)
(EQL (ARRAY-RANK ARRAY)
1)))
then (HELP "Not 1-Dimensional array" ARRAY))
(if (NULL COMPAREFN)
then (SETQ COMPAREFN (QUOTE LESSP)))
(LET [(LOWER 0)
(UPPER (SUB1 (ARRAY-TOTAL-SIZE ARRAY]
(GENERIC.QUICKSORT ARRAY COMPAREFN LOWER UPPER)
(GENERIC.INSERTIONSORT ARRAY COMPAREFN LOWER UPPER)
ARRAY])
(GENERIC.INDEXINSERTIONSORT
[LAMBDA (ARRAY INDICES COMPAREFN LOWER UPPER) (* jop: "20-Mar-86 14:25")
(* * Sort elements {L..U} of the 1-dimensional CMLArray ARRAY using the ordering given by COMPAREFN.
NO argument checking! Returns the permutation to order ARRAY in INDICES. INTENDED FOR FEWER THAN 20 ELEMENTS, USE
QuickSort FOR LARGER PROBLEMS!)
(bind ITHINDEX ITHELT for I from (ADD1 LOWER) to UPPER
do
(* * Loop Invariant: ARRAY{L..I-1} are correctly ordered.)
(SETQ ITHINDEX (PAREF INDICES I))
(SETQ ITHELT (AREF ARRAY ITHINDEX))
(bind (J ← I)
TEMP while (AND (GREATERP J LOWER)
(NOT (APPLY* COMPAREFN [AREF ARRAY
(SETQ TEMP
(PAREF INDICES
(SUB1 J]
ITHELT)))
do (PASET TEMP INDICES J)
(SETQ J (SUB1 J))
finally (PASET ITHINDEX INDICES J))
finally (RETURN ARRAY])
(GENERIC.INDEXQSFENCE
[LAMBDA (ARRAY INDICES COMPAREFN LOWER UPPER) (* jop: "20-Mar-86 12:29")
(* * Identify the partitioning element as the median-of-three estimate of the median. Reference: Sedgewick, R.
"Implementing Quicksort Programs" CACM vol. 21 no. 10 pp. 847--857.)
(LET ((MIDLU (QUOTIENT (PLUS LOWER UPPER)
2))
(LPLUS1 (ADD1 LOWER))
TEMP)
(GENERIC.INDEXSWAPELTS INDICES MIDLU LPLUS1 TEMP)
(if (NOT (APPLY* COMPAREFN (INDEXAREF ARRAY INDICES LPLUS1)
(INDEXAREF ARRAY INDICES UPPER)))
then (GENERIC.INDEXSWAPELTS INDICES LPLUS1 UPPER TEMP))
(if (NOT (APPLY* COMPAREFN (INDEXAREF ARRAY INDICES LOWER)
(INDEXAREF ARRAY INDICES UPPER)))
then (GENERIC.INDEXSWAPELTS INDICES LOWER UPPER TEMP))
(if (NOT (APPLY* COMPAREFN (INDEXAREF ARRAY INDICES LPLUS1)
(INDEXAREF ARRAY INDICES LOWER)))
then (GENERIC.INDEXSWAPELTS INDICES LPLUS1 LOWER TEMP])
(GENERIC.INDEXQUICKSORT
[LAMBDA (ARRAY INDICES COMPAREFN LOWER UPPER) (* jop: "20-Mar-86 12:30")
(* * Reference: Sedgewick, R. "Implementing Quicksort Programs" CACM vol. 21 no. 10 pp. 847--857.)
(if (GREATERP (DIFFERENCE UPPER LOWER)
10)
then (GENERIC.INDEXQSFENCE ARRAY INDICES COMPAREFN LOWER UPPER)
(* Identify the partitioning element as the
median-of-three estimate of the median.)
(* * Perform the partitioning.)
(bind (I ← (ADD1 LOWER))
(J ← UPPER)
(XL ← (INDEXAREF ARRAY INDICES LOWER))
FINISHED TEMP while (NOT FINISHED)
do (repeatwhile (APPLY* COMPAREFN (INDEXAREF ARRAY INDICES I)
XL)
do (SETQ I (ADD1 I)))
(repeatwhile (NOT (APPLY* COMPAREFN (INDEXAREF ARRAY INDICES J)
XL))
do (SETQ J (SUB1 J)))
(if (LESSP J I)
then (SETQ FINISHED T)
else (GENERIC.INDEXSWAPELTS INDICES I J TEMP))
finally (GENERIC.INDEXSWAPELTS INDICES LOWER J TEMP)
(* Now work recursively on the larger then the smaller
subfile.)
(if (GREATERP (DIFFERENCE J LOWER)
(ADD1 (DIFFERENCE UPPER I)))
then (GENERIC.INDEXQUICKSORT ARRAY INDICES COMPAREFN LOWER
(SUB1 J))
(GENERIC.INDEXQUICKSORT ARRAY INDICES COMPAREFN I UPPER)
else (GENERIC.INDEXQUICKSORT ARRAY INDICES COMPAREFN I UPPER)
(GENERIC.INDEXQUICKSORT ARRAY INDICES COMPAREFN LOWER
(SUB1 J])
(GENERIC.INSERTIONSORT
[LAMBDA (ARRAY COMPAREFN LOWER UPPER) (* jop: "20-Mar-86 14:20")
(* * Sort elements (LOWER .. UPPER) of the 1-dimensional CMLArray ARRAY using the ordering given by COMPAREFN.
ARRAY is sorted in place, i.e. destructively. NO argument checking! Returns ARRAY. INTENDED FOR FEWER THAN 20
ELEMENTS, USE QuickSort FOR LARGER PROBLEMS!)
(for I from (ADD1 LOWER) to UPPER
do
(* * Loop Invariant: ARRAY{L..I-1} are correctly ordered.)
(bind (ITH ← (AREF ARRAY I))
(J ← I)
TEMP while (AND (GREATERP J LOWER)
(NOT (APPLY* COMPAREFN (SETQ TEMP (AREF ARRAY
(SUB1
J)))
ITH)))
do (ASET TEMP ARRAY J)
(SETQ J (SUB1 J))
finally (ASET ITH ARRAY J))
finally (RETURN ARRAY])
(GENERIC.QSFENCE
[LAMBDA (ARRAY COMPAREFN LOWER UPPER) (* jop: "20-Mar-86 12:22")
(* * Identify the partitioning element as the median-of-three estimate of the median. Reference: Sedgewick, R.
"Implementing Quicksort Programs" CACM vol. 21 no. 10 pp. 847--857.)
(LET ((MIDLU (QUOTIENT (PLUS LOWER UPPER)
2))
(LPLUS1 (ADD1 LOWER))
TEMP)
(GENERIC.SWAPELTS ARRAY MIDLU LPLUS1 TEMP)
(if (NOT (APPLY* COMPAREFN (AREF ARRAY LPLUS1)
(AREF ARRAY UPPER)))
then (GENERIC.SWAPELTS ARRAY LPLUS1 UPPER TEMP))
(if (NOT (APPLY* COMPAREFN (AREF ARRAY LOWER)
(AREF ARRAY UPPER)))
then (GENERIC.SWAPELTS ARRAY LOWER UPPER TEMP))
(if (NOT (APPLY* COMPAREFN (AREF ARRAY LPLUS1)
(AREF ARRAY LOWER)))
then (GENERIC.SWAPELTS ARRAY LPLUS1 LOWER TEMP])
(GENERIC.QUICKSORT
[LAMBDA (ARRAY COMPAREFN LOWER UPPER) (* jop: "20-Mar-86 14:18")
(* * Reference: Sedgewick, R. "Implementing Quicksort Programs" CACM vol. 21 no. 10 pp. 847--857.)
(if (GREATERP (DIFFERENCE UPPER LOWER)
10)
then (GENERIC.QSFENCE ARRAY COMPAREFN LOWER UPPER)
(* Identify the partitioning element as the
median-of-three estimate of the median.)
(* * Perform the partitioning.)
(bind (I ← (ADD1 LOWER))
(J ← UPPER)
(XL ← (AREF ARRAY LOWER))
FINISHED TEMP while (NOT FINISHED)
do (repeatwhile (APPLY* COMPAREFN (AREF ARRAY I)
XL)
do (SETQ I (ADD1 I)))
(repeatwhile (NOT (APPLY* COMPAREFN (AREF ARRAY J)
XL))
do (SETQ J (SUB1 J)))
(if (LESSP J I)
then (SETQ FINISHED T)
else (GENERIC.SWAPELTS ARRAY I J TEMP))
finally (GENERIC.SWAPELTS ARRAY LOWER J TEMP)
(* Now work recursively on the larger then the smaller
subarray.)
(if (GREATERP (DIFFERENCE J LOWER)
(ADD1 (DIFFERENCE UPPER I)))
then (GENERIC.QUICKSORT ARRAY COMPAREFN LOWER (SUB1 J))
(GENERIC.QUICKSORT ARRAY COMPAREFN I UPPER)
else (GENERIC.QUICKSORT ARRAY COMPAREFN I UPPER)
(GENERIC.QUICKSORT ARRAY COMPAREFN LOWER (SUB1 J])
(INDEXARRAYSORT
[LAMBDA (ARRAY INDICES COMPAREFN) (* jop: "20-Mar-86 14:25")
(* * Sort the 1-dimensional CMLArray ARRAY using the ordering given by COMPAREFN. INDICES is a vector of elttype T.
Returns the permutation to order ARRAY in INDICES.)
(if (NOT (AND (type? ARRAY ARRAY)
(EQL (ARRAY-RANK ARRAY)
1)))
then (HELP "Not 1-Dimensional array" ARRAY))
(if (NULL INDICES)
then (SETQ INDICES (MAKE-ARRAY (ARRAY-TOTAL-SIZE ARRAY)))
elseif (NOT (AND (type? ARRAY INDICES)
(EQL (ARRAY-RANK INDICES)
1)
(EQL (ARRAY-TOTAL-SIZE INDICES)
(ARRAY-TOTAL-SIZE ARRAY))
(EQ (ARRAY-ELEMENT-TYPE INDICES)
T)))
then (HELP "Illegal Index array" INDICES))
(for I from 0 to (SUB1 (ARRAY-TOTAL-SIZE INDICES)) do (PASET I INDICES I))
(if (NULL COMPAREFN)
then (SETQ COMPAREFN (QUOTE LESSP)))
(LET [(LOWER 0)
(UPPER (SUB1 (ARRAY-TOTAL-SIZE ARRAY]
(GENERIC.INDEXQUICKSORT ARRAY INDICES COMPAREFN LOWER UPPER)
(GENERIC.INDEXINSERTIONSORT ARRAY INDICES COMPAREFN LOWER UPPER)
INDICES])
)
(DECLARE: EVAL@COMPILE
[DEFMACRO GENERIC.INDEXSWAPELTS (INDICES I J &OPTIONAL (TEMP NIL BTEMP))
(* *)
(if BTEMP then (BQUOTE (PROGN (SETQ , TEMP (PAREF , INDICES , I))
(PASET (PAREF , INDICES , J)
, INDICES , I)
(PASET , TEMP , INDICES , J)))
else
(BQUOTE (LET ((TEMP (PAREF , INDICES , I)))
(PASET (PAREF , INDICES , J)
, INDICES , I)
(PASET TEMP , INDICES , J]
[DEFMACRO GENERIC.SWAPELTS (ARRAY I J &OPTIONAL (TEMP NIL BTEMP))
(* *)
(if BTEMP then (BQUOTE (PROGN (SETQ , TEMP (AREF , ARRAY , I))
(ASET (AREF , ARRAY , J)
, ARRAY , I)
(ASET , TEMP , ARRAY , J)))
else
(BQUOTE (LET ((TEMP (AREF , ARRAY , I)))
(ASET (AREF , ARRAY , J)
, ARRAY , I)
(ASET TEMP , ARRAY , J]
[DEFMACRO INDEXAREF (ARRAY INDICES INDEX)
(BQUOTE (AREF (\, ARRAY)
(PAREF (\, INDICES)
(\, INDEX]
)
(PUTPROPS ARRAYSORTER COPYRIGHT ("Xerox Corporation" 1986))
(DECLARE: DONTCOPY
(FILEMAP (NIL (1082 10604 (ARRAYSORT 1092 . 1822) (GENERIC.INDEXINSERTIONSORT 1824 . 2876) (
GENERIC.INDEXQSFENCE 2878 . 3917) (GENERIC.INDEXQUICKSORT 3919 . 5719) (GENERIC.INSERTIONSORT 5721 .
6669) (GENERIC.QSFENCE 6671 . 7623) (GENERIC.QUICKSORT 7625 . 9292) (INDEXARRAYSORT 9294 . 10602)))))
STOP