(FILECREATED "23-Jun-86 11:52:47" {QV}<PEDERSEN>LISP>ARRAYSORTER.;4 15375
changes to: (FNS GENERIC.INDEXQUICKSORT ARRAY-KTH-INDEX GENERIC.QUICKSORT ARRAY-KTH-ELT
GENERIC.QSFENCE GENERIC.INSERTIONSORT GENERIC.INDEXINSERTIONSORT
INDEX-ARRAY-SORT)
previous date: "16-Jun-86 18:18:48" {QV}<PEDERSEN>LISP>ARRAYSORTER.;2)
(* Copyright (c) 1986 by Xerox Corporation. All rights reserved.)
(PRETTYCOMPRINT ARRAYSORTERCOMS)
(RPAQQ ARRAYSORTERCOMS ((FNS ARRAY-KTH-ELT ARRAY-KTH-INDEX ARRAY-SORT GENERIC.INDEXINSERTIONSORT
GENERIC.INDEXQSFENCE GENERIC.INDEXQUICKSORT GENERIC.INSERTIONSORT
GENERIC.QSFENCE GENERIC.QUICKSORT INDEX-ARRAY-SORT)
(MACROS GENERIC.SWAPELTS INDEXAREF)
(DECLARE: DONTEVAL@LOAD DOEVAL@COMPILE DONTCOPY (LOCALVARS . T))))
(DEFINEQ
(ARRAY-KTH-ELT
[LAMBDA (X K COMPAREFN) (* jop: "23-Jun-86 10:34")
(* * Partially sort the elements of the 1-dimensional CMLArray X so that the order statistic designated by K is
located correctly in X. K must be a ZERO-BASED FIXNUM INDEX into X. X is sorted in place, i.e. destructively.
Returns X{K})
(if (NOT (EQ (ARRAY-RANK X)
1))
then (ERROR "Array not 1-Dimensional:" X))
(SETQ K (FIX K))
(if [NOT (AND (LEQ 0 K)
(LEQ K (SUB1 (ARRAY-TOTAL-SIZE X]
then (ERROR "K out of bounds" K))
(if (NULL COMPAREFN)
then (SETQ COMPAREFN (QUOTE LESSP)))
(LET [(LOWER 0)
(UPPER (SUB1 (ARRAY-TOTAL-SIZE X]
(bind (I ←(ADD1 LOWER))
(J ← UPPER) while (ILESSP LOWER UPPER)
do (GENERIC.QSFENCE X COMPAREFN LOWER UPPER)
(* Partition using the median-of-three estimate of the
median.)
(bind XI XJ (XL ←(AREF X LOWER))
FINISHED while (NOT FINISHED)
do (while [AND (ILESSP I UPPER)
(NOT (APPLY* COMPAREFN XL (SETQ XI (AREF X I]
do (SETQ I (ADD1 I)))
(while (AND (IGREATERP J LOWER)
(NOT (APPLY* COMPAREFN (SETQ XJ (AREF X J))
XL)))
do (SETQ J (SUB1 J)))
(if (IGREATERP J I)
then (ASET XI X J)
(ASET XJ X I)
else (SETQ FINISHED T)))
(GENERIC.SWAPELTS X LOWER J)
(if (ILEQ K J)
then (SETQ UPPER (SUB1 J))
(SETQ I (ADD1 LOWER)))
(if (IGEQ K J)
then (SETQ LOWER (ADD1 J))
(SETQ I (ADD1 LOWER))
(SETQ J UPPER))
finally (RETURN (AREF X K])
(ARRAY-KTH-INDEX
[LAMBDA (ARRAY K COMPAREFN INDICES) (* jop: "23-Jun-86 11:15")
(* * Partially sort the elements of the 1-dimensional CMLArray ARRAY so that the order statistic designated by K is
located correctly in X. K must be a ZERO-BASED FIXNUM INDEX into X. ARRAY is sorted in place, i.e. destructively.
Returns X{K})
(if (NOT (EQ (ARRAY-RANK ARRAY)
1))
then (ERROR "Array not 1-Dimensional:" ARRAY))
(SETQ K (FIX K))
(if [NOT (AND (LEQ 0 K)
(LEQ K (SUB1 (ARRAY-TOTAL-SIZE ARRAY]
then (ERROR "K out of bounds" K))
(if (NULL COMPAREFN)
then (SETQ COMPAREFN (QUOTE LESSP)))
(if (NULL INDICES)
then (SETQ INDICES (MAKE-ARRAY (ARRAY-TOTAL-SIZE ARRAY)))
elseif [NOT (AND (EQ (ARRAY-RANK INDICES)
1)
(EQ (ARRAY-TOTAL-SIZE INDICES)
(ARRAY-TOTAL-SIZE ARRAY]
then (HELP "Illegal Index array" INDICES))
(for I from 0 to (SUB1 (ARRAY-TOTAL-SIZE INDICES)) do (ASET I INDICES I))
(LET [(LOWER 0)
(UPPER (SUB1 (ARRAY-TOTAL-SIZE ARRAY]
(bind (I ←(ADD1 LOWER))
(J ← UPPER) while (ILESSP LOWER UPPER)
do (GENERIC.INDEXQSFENCE ARRAY INDICES COMPAREFN LOWER UPPER)
(* Partition using the median-of-three estimate of the
median.)
(bind (XL ←(INDEXAREF ARRAY INDICES LOWER))
FINISHED while (NOT FINISHED)
do (while [AND (ILESSP I UPPER)
(NOT (APPLY* COMPAREFN XL (INDEXAREF ARRAY INDICES I]
do (SETQ I (ADD1 I)))
(while (AND (IGREATERP J LOWER)
(NOT (APPLY* COMPAREFN (INDEXAREF ARRAY INDICES J)
XL)))
do (SETQ J (SUB1 J)))
(if (IGREATERP J I)
then (GENERIC.SWAPELTS INDICES I J)
else (SETQ FINISHED T)))
(GENERIC.SWAPELTS INDICES LOWER J)
(if (ILEQ K J)
then (SETQ UPPER (SUB1 J))
(SETQ I (ADD1 LOWER)))
(if (IGEQ K J)
then (SETQ LOWER (ADD1 J))
(SETQ I (ADD1 LOWER))
(SETQ J UPPER))
finally (RETURN (AREF INDICES K])
(ARRAY-SORT
[LAMBDA (ARRAY COMPAREFN) (* jop: "12-Jun-86 12:24")
(* * 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 (CL:ARRAYP ARRAY)
(EQ (ARRAY-RANK ARRAY)
1)))
then (HELP "Not 1-Dimensional array" ARRAY))
(if (NULL COMPAREFN)
then (SETQ COMPAREFN (FUNCTION 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: "12-Jun-86 14:47")
(* * 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 (AREF INDICES I))
(SETQ ITHELT (AREF ARRAY ITHINDEX))
(bind (J ← I)
TEMP while (AND (IGREATERP J LOWER)
(NOT (APPLY* COMPAREFN [AREF ARRAY
(SETQ TEMP
(AREF INDICES
(SUB1 J]
ITHELT)))
do (ASET TEMP INDICES J)
(SETQ J (SUB1 J))
finally (ASET ITHINDEX INDICES J))
finally (RETURN ARRAY])
(GENERIC.INDEXQSFENCE
[LAMBDA (ARRAY INDICES COMPAREFN LOWER UPPER) (* jop: "16-Jun-86 14:18")
(* * 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 INDICES MIDLU LPLUS1 TEMP)
(if (NOT (APPLY* COMPAREFN (INDEXAREF ARRAY INDICES LPLUS1)
(INDEXAREF ARRAY INDICES UPPER)))
then (GENERIC.SWAPELTS INDICES LPLUS1 UPPER TEMP))
(if (NOT (APPLY* COMPAREFN (INDEXAREF ARRAY INDICES LOWER)
(INDEXAREF ARRAY INDICES UPPER)))
then (GENERIC.SWAPELTS INDICES LOWER UPPER TEMP))
(if (NOT (APPLY* COMPAREFN (INDEXAREF ARRAY INDICES LPLUS1)
(INDEXAREF ARRAY INDICES LOWER)))
then (GENERIC.SWAPELTS INDICES LPLUS1 LOWER TEMP])
(GENERIC.INDEXQUICKSORT
[LAMBDA (ARRAY INDICES COMPAREFN LOWER UPPER) (* jop: "23-Jun-86 11:44")
(* * 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 while (NOT FINISHED)
do (while (APPLY* COMPAREFN (INDEXAREF ARRAY INDICES I)
XL)
do (SETQ I (ADD1 I)))
(while (NOT (APPLY* COMPAREFN (INDEXAREF ARRAY INDICES J)
XL))
do (SETQ J (SUB1 J)))
(if (IGREATERP J I)
then (GENERIC.SWAPELTS INDICES I J)
else (SETQ FINISHED T))
finally (GENERIC.SWAPELTS INDICES LOWER J)
(* Now work recursively on the larger then the smaller
subfile.)
(if (IGREATERP (IDIFFERENCE J LOWER)
(ADD1 (IDIFFERENCE 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: "23-Jun-86 10:50")
(* * 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 (IGREATERP 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: "23-Jun-86 11:44")
(* * Reference: Sedgewick, R. "Implementing Quicksort Programs" CACM vol. 21 no. 10 pp. 847--857.)
(if (IGREATERP (IDIFFERENCE 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))
XI XJ FINISHED while (NOT FINISHED)
do (while (APPLY* COMPAREFN (SETQ XI (AREF ARRAY I))
XL)
do (SETQ I (ADD1 I)))
(while (NOT (APPLY* COMPAREFN (SETQ XJ (AREF ARRAY J))
XL))
do (SETQ J (SUB1 J)))
(if (IGREATERP J I)
then (ASET XJ ARRAY I)
(ASET XI ARRAY J)
else (SETQ FINISHED T))
finally (GENERIC.SWAPELTS ARRAY LOWER J)
(* Now work recursively on the larger then the smaller
subarray.)
(if (IGREATERP (IDIFFERENCE J LOWER)
(ADD1 (IDIFFERENCE 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])
(INDEX-ARRAY-SORT
[LAMBDA (ARRAY INDICES COMPAREFN) (* jop: "12-Jun-86 13:35")
(* * 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 (CL:ARRAYP ARRAY)
(EQ (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 (CL:ARRAYP INDICES)
(EQ (ARRAY-RANK INDICES)
1)
(EQ (ARRAY-TOTAL-SIZE INDICES)
(ARRAY-TOTAL-SIZE ARRAY]
then (HELP "Illegal Index array" INDICES))
(for I from 0 to (SUB1 (ARRAY-TOTAL-SIZE INDICES)) do (ASET I INDICES I))
(if (NULL COMPAREFN)
then (SETQ COMPAREFN (FUNCTION 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.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)
(AREF (\, INDICES)
(\, INDEX]
)
(DECLARE: DONTEVAL@LOAD DOEVAL@COMPILE DONTCOPY
(DECLARE: DOEVAL@COMPILE DONTCOPY
(LOCALVARS . T)
)
)
(PUTPROPS ARRAYSORTER COPYRIGHT ("Xerox Corporation" 1986))
(DECLARE: DONTCOPY
(FILEMAP (NIL (804 14684 (ARRAY-KTH-ELT 814 . 2791) (ARRAY-KTH-INDEX 2793 . 5244) (ARRAY-SORT 5246 .
5976) (GENERIC.INDEXINSERTIONSORT 5978 . 7044) (GENERIC.INDEXQSFENCE 7046 . 8065) (
GENERIC.INDEXQUICKSORT 8067 . 9831) (GENERIC.INSERTIONSORT 9833 . 10781) (GENERIC.QSFENCE 10783 .
11735) (GENERIC.QUICKSORT 11737 . 13436) (INDEX-ARRAY-SORT 13438 . 14682)))))
STOP