(FILECREATED " 1-Mar-86 16:49:08" {DSK}<LISPFILES>DINDESORT.;11 32872
changes to: (FNS InsertionSort SelectMedian UFInsertionPairSort UFQuickSortFence)
previous date: "23-Feb-86 17:30:04" {DSK}<LISPFILES>DINDESORT.;10)
(* Copyright (c) 1985, 1986 by Massachusetts Institute of Technology. All rights reserved.)
(PRETTYCOMPRINT DINDESORTCOMS)
(RPAQQ DINDESORTCOMS ((FNS InsertionSort InsertionSort1 PartialSort PartialSort1 QuickSort QuickSort1
QuickSortFence QuickSortSwap SelectKth SelectKth1 SelectMax SelectMedian
SelectMin UFInsertionPairSort UFInsertionPairSort1 UFInsertionSort
UFInsertionSort1 UFPartialSort UFPartialSort1 UFQuickPairSort
UFQuickPairSort1 UFQuickPairSortFence UFQuickSort UFQuickSort1
UFQuickSortFence UFQuickSortSwap UFSelectKth UFSelectKth1 UFSelectMax
UFSelectMedian UFSelectMin)
(MACROS QuickSortSwap UFQuickSortSwap)))
(DEFINEQ
(InsertionSort
[LAMBDA (X L U) (* SCP " 1-Mar-86 16:45")
(* * Sort elements {L..U} of the 1-dimensional NUMBERP CMLArray X from smallest to largest. X is sorted in place,
i.e. destructively. L and U default to 0 and (ARRAYTOTALSIZE X) -1 respectively. Returns X. INTENDED FOR FEWER THAN
20 ELEMENTS, USE QuickSort FOR LARGER PROBLEMS!)
(if [NOT (OR (EQP (ARRAYELEMENTTYPE X)
(QUOTE FLONUM))
(EQP (ARRAYELEMENTTYPE X)
(QUOTE FIXNUM]
then (ERROR "Array not NUMBERP:" X))
(if (NOT (EQP (ARRAYRANK X)
1))
then (ERROR "Array not 1-Dimensional:" X))
(if (NULL L)
then (SETQ L 0))
[if (NULL U)
then (SETQ U (SUB1 (ARRAYTOTALSIZE X]
(if (GREATERP L U)
then (ERROR "Bounds out of order:" L U))
(if [OR (LESSP L 0)
(GREATERP U (SUB1 (ARRAYTOTALSIZE X]
then (ERROR "Bounds exceed Array limits:" L U))
(InsertionSort1 X L U])
(InsertionSort1
[LAMBDA (X L U) (* SCP "22-Feb-86 16:15")
(* * Sort elements {L..U} of the 1-dimensional NUMBERP CMLArray X from smallest to largest. X is sorted in place,
i.e. destructively. NO argument checking! Returns X. INTENDED FOR FEWER THAN 20 ELEMENTS, USE QuickSort FOR LARGER
PROBLEMS!)
(for I from (ADD1 L) to U
do
(* * Loop Invariant: X{L..I-1} are correctly ordered.)
(bind (TT ←(AREF X I))
UU
(J ← I) while (AND (GREATERP J L)
(GREATERP (SETQ UU (AREF X (SUB1 J)))
TT))
do (ASET UU X J)
(SETQ J (SUB1 J))
finally (ASET TT X J))
finally (RETURN X])
(PartialSort
[LAMBDA (X Ranks) (* SCP "22-Feb-86 16:24")
(* * Partially sort the elements of the 1-dimensional NUMBERP CMLArray X so that the order statistics designated by
Ranks are located correctly in X. Ranks must be a NUMBERP CMLARRAY or list of numbers which are ZERO-BASED INDEXES
into X. X is sorted in place, i.e. destructively. Returns X.)
(if [NOT (OR (EQP (ARRAYELEMENTTYPE X)
(QUOTE FLONUM))
(EQP (ARRAYELEMENTTYPE X)
(QUOTE FIXNUM]
then (ERROR "Array not NUMBERP:" X))
(if (NOT (EQP (ARRAYRANK X)
1))
then (ERROR "Array not 1-Dimensional:" X))
[if (LISTP Ranks)
then (SETQ Ranks (MAKEARRAY (LENGTH Ranks)
(QUOTE ELEMENTTYPE)
(QUOTE FIXP)
(QUOTE INITIALCONTENTS)
(MAPCAR Ranks (FUNCTION FIX]
(QuickSort Ranks) (* Typechecks Ranks along the way.)
(if [OR (LESSP (FIX (AREF Ranks 0))
0)
(GREATERP [FIX (AREF Ranks (SUB1 (ARRAYTOTALSIZE Ranks]
(SUB1 (ARRAYTOTALSIZE X]
then (ERROR "Ranks out of bounds:" Ranks))
(PartialSort1 X Ranks 0 (SUB1 (ARRAYTOTALSIZE X))
0
(SUB1 (ARRAYTOTALSIZE Ranks])
(PartialSort1
[LAMBDA (X Ranks L U RL RU) (* SCP "22-Feb-86 16:23")
(if (GREATERP (DIFFERENCE U L)
10)
then (QuickSortFence X L U) (* Identify the partitioning element as the
median-of-three estimate of the median.)
(* * Perform the partitioning. (The ugly GO $$OUT is simply a "break" from the outermost loop to its
"finally clause"))
(bind (I ←(ADD1 L))
(J ← U)
(XL ←(AREF X L))
(RI ← RL)
(RJ ← RU)
do (repeatwhile (LESSP (AREF X I)
XL)
do (SETQ I (ADD1 I)))
(repeatwhile (GREATERP (AREF X J)
XL)
do (SETQ J (SUB1 J)))
(if (LESSP J I)
then (GO $$OUT))
(QuickSortSwap X I J)
finally (QuickSortSwap X L J)
(until (OR (GREATERP RI RU)
(AND (GEQ (FIX (AREF Ranks RI))
I)
(LEQ (FIX (AREF Ranks RI))
U)))
do (SETQ RI (ADD1 RI)))
(until [OR (LESSP RJ RL)
(AND (GEQ (FIX (AREF Ranks RJ))
L)
(LEQ (FIX (AREF Ranks RJ))
(SUB1 J]
do (SETQ RJ (SUB1 RJ)))
(if (LEQ RI RU)
then (PartialSort1 X Ranks I U RI RU))
(if (GEQ RJ RL)
then (PartialSort1 X Ranks L (SUB1 J)
RL RJ))
(RETURN X))
else (InsertionSort1 X L U])
(QuickSort
[LAMBDA (X L U) (* SCP "22-Feb-86 16:26")
(* * Sort elements {L..U} of the 1-dimensional NUMBERP CMLArray X from smallest to largest. X is sorted in place,
i.e. destructively. L and U default to 0 and (ARRAYTOTALSIZE X) -1 respectively. Returns X.)
(if [NOT (OR (EQP (ARRAYELEMENTTYPE X)
(QUOTE FLONUM))
(EQP (ARRAYELEMENTTYPE X)
(QUOTE FIXNUM]
then (ERROR "Array not NUMBERP:" X))
(if (NOT (EQP (ARRAYRANK X)
1))
then (ERROR "Array not 1-Dimensional:" X))
(if (NULL L)
then (SETQ L 0))
[if (NULL U)
then (SETQ U (SUB1 (ARRAYTOTALSIZE X]
(if (GREATERP L U)
then (ERROR "Indexes out of order:" L U))
(if [OR (LESSP L 0)
(GREATERP U (SUB1 (ARRAYTOTALSIZE X]
then (ERROR "Bounds exceed Array limits:" L U))
(QuickSort1 X L U)
(InsertionSort1 X L U])
(QuickSort1
[LAMBDA (X L U) (* SCP "13-Nov-85 11:20")
(* * Reference: Sedgewick, R. "Implementing Quicksort Programs" CACM vol. 21 no. 10 pp. 847--857.)
(if (GREATERP (DIFFERENCE U L)
10)
then (QuickSortFence X L U) (* Identify the partitioning element as the
median-of-three estimate of the median.)
(* * Perform the partitioning. (The ugly GO $$OUT is simply a "break" from the outer do loop to its "finally clause"
))
(bind (I ←(ADD1 L))
(J ← U)
(XL ←(AREF X L))
do (repeatwhile (LESSP (AREF X I)
XL)
do (SETQ I (ADD1 I)))
(repeatwhile (GREATERP (AREF X J)
XL)
do (SETQ J (SUB1 J)))
(if (LESSP J I)
then (GO $$OUT))
(QuickSortSwap X I J)
finally (QuickSortSwap X L J) (* Now work recursively on the larger then the smaller
subfile.)
(if (GREATERP (DIFFERENCE J L)
(ADD1 (DIFFERENCE U I)))
then (QuickSort1 X L (SUB1 J))
(QuickSort1 X I U)
else (QuickSort1 X I U)
(QuickSort1 X L (SUB1 J])
(QuickSortFence
[LAMBDA (X L U) (* SCP "22-Feb-86 16: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 L U)
2))
(LPLUS1 (ADD1 L)))
(QuickSortSwap X MIDLU LPLUS1)
(if (GREATERP (AREF X LPLUS1)
(AREF X U))
then (QuickSortSwap X LPLUS1 U))
(if (GREATERP (AREF X L)
(AREF X U))
then (QuickSortSwap X L U))
(if (GREATERP (AREF X LPLUS1)
(AREF X L))
then (QuickSortSwap X LPLUS1 L])
(QuickSortSwap
[LAMBDA (X I J) (* SCP "22-Feb-86 16:34")
(* * (FNS definition, real action is on the compiler DMACRO.))
(LET ((TT (AREF X I)))
(ASET (AREF X J)
X I)
(ASET TT X J])
(SelectKth
[LAMBDA (X K) (* SCP "22-Feb-86 16:37")
(* * Partially sort the elements of the 1-dimensional NUMBERP 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 (OR (EQP (ARRAYELEMENTTYPE X)
(QUOTE FLONUM))
(EQP (ARRAYELEMENTTYPE X)
(QUOTE FIXNUM]
then (ERROR "Array not NUMBERP:" X))
(if (NOT (EQP (ARRAYRANK X)
1))
then (ERROR "Array not 1-Dimensional:" X))
(SETQ K (FIX K))
(if [NOT (AND (LEQ 0 K)
(LEQ K (SUB1 (ARRAYTOTALSIZE X]
then (ERROR "Select: K outside array limits." K))
(if (EQP 0 K)
then (SelectMin X)
elseif (EQP K (SUB1 (ARRAYTOTALSIZE X)))
then (SelectMax X)
else (SelectKth1 X K 0 (SUB1 (ARRAYTOTALSIZE X])
(SelectKth1
[LAMBDA (X K L U) (* SCP "19-Feb-86 15:53")
(* * PreCondition: L <= K <= U. PostCondtion: X{L..K-1} <= X{K} <= X{K+1..U} and X{K} is returned.)
(bind (I ← L)
(J ←(ADD1 U)) while (LESSP L U)
do (QuickSortFence X L U) (* Partition using the median-of-three estimate of the
median.)
(bind XI XJ (XL ←(AREF X L))
do (repeatuntil (OR (GREATERP I U)
(GEQ (SETQ XI (AREF X I))
XL))
do (SETQ I (ADD1 I)))
(repeatuntil (LEQ (SETQ XJ (AREF X J))
XL)
do (SETQ J (SUB1 J)))
(if (LESSP J I)
then (RETURN)
else (ASET XI X J)
(ASET XJ X I)))
(QuickSortSwap X L J)
(if (LEQ K J)
then (SETQ U (SUB1 J))
(SETQ I L))
(if (GEQ K J)
then (SETQ L (ADD1 J))
(SETQ I L)
(SETQ J (ADD1 U)))
finally (RETURN (AREF X K])
(SelectMax
[LAMBDA (X) (* SCP "22-Feb-86 16:39")
(* * comment)
(AREF X (for I from 0 to (SUB1 (ARRAYTOTALSIZE X)) largest (AREF X I])
(SelectMedian
[LAMBDA (X) (* SCP " 1-Mar-86 16:46")
(* * comment)
(LET ((N (ARRAYTOTALSIZE X)))
(if (ODDP N)
then (SelectKth X (QUOTIENT (SUB1 N)
2))
else (LET [(Ranks (CONSTANT (MAKEARRAY 2 (QUOTE ELEMENTTYPE)
(QUOTE FIXNUM]
(ASET (SUB1 (QUOTIENT N 2))
Ranks 0)
(ASET (QUOTIENT N 2)
Ranks 1)
(PartialSort1 X Ranks 0 (SUB1 N)
0 1)
(TIMES (PLUS (AREF X (SUB1 (QUOTIENT N 2)))
(AREF X (QUOTIENT N 2)))
.5])
(SelectMin
[LAMBDA (X) (* SCP "22-Feb-86 16:41")
(* * comment)
(AREF X (for I from 0 to (SUB1 (ARRAYTOTALSIZE X)) smallest (AREF X I])
(UFInsertionPairSort
[LAMBDA (X Y L U) (* SCP " 1-Mar-86 16:47")
(* * Sort elements {L..U} of the 1-dimensional FLOATP CMLArray X from smallest to largest. Carry along the values of
Y, i.e. Y undergoes the same permutaion as X. Use unboxed hacks for speed!! X is sorted in place, i.e.
destructively, so is Y. L and U default to 0 and (ARRAYTOTALSIZE X) -1 respectively. Returns X.
INTENDED FOR FEWER THAN 20 ELEMENTS, USE UFQuickPairSort FOR LARGER PROBLEMS!)
(if (NOT (EQP (ARRAYELEMENTTYPE X)
(QUOTE FLONUM)))
then (ERROR "Array not FLOATP:" X))
(if (NOT (EQP (ARRAYELEMENTTYPE Y)
(QUOTE FLONUM)))
then (ERROR "Array not FLOATP:" Y))
(if (NOT (EQP (ARRAYRANK X)
1))
then (ERROR "Array not 1-Dimensional:" Y))
(if (NOT (EQP (ARRAYRANK Y)
1))
then (ERROR "Array not 1-Dimensional:" Y))
(if (NOT (EQP (ARRAYTOTALSIZE X)
(ARRAYTOTALSIZE Y)))
then (ERROR "Arrays not the same length:" X Y))
(if (NULL L)
then (SETQ L 0))
[if (NULL U)
then (SETQ U (SUB1 (ARRAYTOTALSIZE X]
(if (GREATERP L U)
then (ERROR "Bounds out of order:" L U))
(if [OR (LESSP L 0)
(GREATERP U (SUB1 (ARRAYTOTALSIZE X]
then (ERROR "Bounds exceed Array limits:" L U))
(UFInsertionPairSort1 X Y L U])
(UFInsertionPairSort1
[LAMBDA (X Y L U) (* SCP "22-Feb-86 16:55")
(* * Sort elements {L..U} of the 1-dimensional FLOATP CMLArray X from smallest to largest. Carry along the values of
Y, i.e. Y undergoes the same permutaion as X. Use unboxed hacks for speed!! X is sorted in place, i.e.
destructively, so is Y. Returns X. INTENDED FOR FEWER THAN 20 ELEMENTS, USE UFQuickPairSort FOR LARGER PROBLEMS!)
(for I from (ADD1 L) to U
do
(* * Loop Invariant: X{L..I-1} are correctly ordered.)
(bind (TT ←(\FLOATAREF X I))
(YY ←(\FLOATAREF Y I))
UU
(J ← I) declare (TYPE FLOATP TT YY UU) while (AND (GREATERP J L)
(UFGREATERP (SETQ UU
(\FLOATAREF
X
(SUB1 J)))
TT))
do (\FLOATASET UU X J)
(\FLOATASET (\FLOATAREF Y (SUB1 J))
Y J)
(SETQ J (SUB1 J))
finally (\FLOATASET TT X J)
(\FLOATASET YY Y J))
finally (RETURN X])
(UFInsertionSort
[LAMBDA (X L U) (* SCP "22-Feb-86 17:31")
(* * Sort elements {L..U} of the 1-dimensional FLOATP CMLArray X from smallest to largest. X is sorted in place,
i.e. destructively. L and U default to 0 and (ARRAYTOTALSIZE X) -1 respectively. Returns X. INTENDED FOR FEWER THAN
20 ELEMENTS, USE UFQuickSort FOR LARGER PROBLEMS!)
(if (NOT (EQP (ARRAYELEMENTTYPE X)
(QUOTE FLONUM)))
then (ERROR "Array not FLOATP:" X))
(if (NOT (EQP (ARRAYRANK X)
1))
then (ERROR "Array not 1-Dimensional:" X))
(if (NULL L)
then (SETQ L 0))
[if (NULL U)
then (SETQ U (SUB1 (ARRAYTOTALSIZE X]
(if (GREATERP L U)
then (ERROR "Indexes out of order:" L U))
(if [OR (LESSP L 0)
(GREATERP U (SUB1 (ARRAYTOTALSIZE X]
then (ERROR "Bounds exceed Array limits:" L U))
(UFInsertionSort1 X L U])
(UFInsertionSort1
[LAMBDA (X L U) (* SCP "22-Feb-86 17:00")
(* * Sort elements {L..U} of the 1-dimensional FLOATP CMLArray X from smallest to largest. X is sorted in place,
i.e. destructively. Returns X. INTENDED FOR FEWER THAN 20 ELEMENTS, USE UFQuickSort FOR LARGER PROBLEMS!)
(for I from (ADD1 L) to U
do
(* * Loop Invariant: X{L..I-1} are correctly ordered.)
(bind (TT ←(\FLOATAREF X I))
UU
(J ← I) declare (TYPE FLOATP TT UU) while (AND (GREATERP J L)
(UFGREATERP (SETQ UU
(\FLOATAREF
X
(SUB1 J)))
TT))
do (\FLOATASET UU X J)
(SETQ J (SUB1 J))
finally (\FLOATASET TT X J))
finally (RETURN X])
(UFPartialSort
[LAMBDA (X Ranks) (* SCP "22-Feb-86 17:05")
(* * Partially sort elements {L..U} of the 1-dimensional FLOATP CMLArray X so that the order statistics designated
by Ranks are located correctly in X. Ranks must be a CMLARRAY or list of numbers which are ZERO-BASED INDEXES into
X. X is sorted in place, i.e. destructively. Returns X.)
(if (NOT (EQP (ARRAYELEMENTTYPE X)
(QUOTE FLONUM)))
then (ERROR "Array not FLOATP:" X))
(if (NOT (EQP (ARRAYRANK X)
1))
then (ERROR "Array not 1-Dimensional:" X))
[if (LISTP Ranks)
then (SETQ Ranks (MAKEARRAY (LENGTH Ranks)
(QUOTE ELEMENTTYPE)
(QUOTE FIXP)
(QUOTE INITIALCONTENTS)
(MAPCAR Ranks (FUNCTION FIX]
(QuickSort Ranks) (* Typechecks Ranks along the way.)
(if [OR (LESSP (FIX (AREF Ranks 0))
0)
(GREATERP [FIX (AREF Ranks (SUB1 (ARRAYTOTALSIZE Ranks]
(SUB1 (ARRAYTOTALSIZE X]
then (ERROR "Ranks out of bounds:" Ranks))
(UFPartialSort1 X Ranks 0 (SUB1 (ARRAYTOTALSIZE X))
0
(SUB1 (ARRAYTOTALSIZE Ranks])
(UFPartialSort1
[LAMBDA (X Ranks L U RL RU) (* SCP "22-Feb-86 17:05")
(if (GREATERP (DIFFERENCE U L)
10)
then (UFQuickSortFence X L U) (* Identify the partitioning element as the
median-of-three estimate of the median.)
(* * Perform the partitioning. (The ugly GO $$OUT is simply a "break" from the outermost loop to its
"finally clause"))
(bind (I ←(ADD1 L))
(J ← U)
(XL ←(\FLOATAREF X L))
(RI ← RL)
(RJ ← RU) declare (TYPE FLOATP XL)
do (declare (TYPE FLOATP XL) repeatwhile (UFLESSP (\FLOATAREF X I)
XL)
do (SETQ I (ADD1 I)))
(declare (TYPE FLOATP XL) repeatwhile (UFGREATERP (\FLOATAREF X J)
XL)
do (SETQ J (SUB1 J)))
(if (LESSP J I)
then (GO $$OUT))
(UFQuickSortSwap X I J)
finally (UFQuickSortSwap X L J)
(until (OR (GREATERP RI RU)
(AND (GEQ (FIX (AREF Ranks RI))
I)
(LEQ (FIX (AREF Ranks RI))
U)))
do (SETQ RI (ADD1 RI)))
(until [OR (LESSP RJ RL)
(AND (GEQ (FIX (AREF Ranks RJ))
L)
(LEQ (FIX (AREF Ranks RJ))
(SUB1 J]
do (SETQ RJ (SUB1 RJ)))
(if (LEQ RI RU)
then (UFPartialSort1 X Ranks I U RI RU))
(if (GEQ RJ RL)
then (UFPartialSort1 X Ranks L (SUB1 J)
RL RJ))
(RETURN X))
else (UFInsertionSort1 X L U])
(UFQuickPairSort
[LAMBDA (X Y L U) (* SCP "22-Feb-86 17:08")
(* * Sort elements {L..U} of the 1-dimensional FLOATP CMLArray X from smallest to largest. using unboxed floating
hacks for speed!! Carry along the elements of Y, i.e. Y undergoes the same permutation as X.
X and Y are sorted in place, i.e. destructively. L and U default to 0 and (ARRAYTOTALSIZE X) -1 respectively.
Returns X.)
(if (NOT (EQP (ARRAYELEMENTTYPE X)
(QUOTE FLONUM)))
then (ERROR "Array not FLOATP:" X))
(if (NOT (EQP (ARRAYELEMENTTYPE Y)
(QUOTE FLONUM)))
then (ERROR "Array not FLOATP:" Y))
(if (NOT (EQP (ARRAYRANK X)
1))
then (ERROR "Array not 1-Dimensional:" X))
(if (NOT (EQP (ARRAYRANK Y)
1))
then (ERROR "Array not 1-Dimensional:" Y))
(if (NOT (EQP (ARRAYTOTALSIZE X)
(ARRAYTOTALSIZE Y)))
then (ERROR "Arrays not the same length:" X Y))
(if (NULL L)
then (SETQ L 0))
[if (NULL U)
then (SETQ U (SUB1 (ARRAYTOTALSIZE X]
(if (GREATERP L U)
then (ERROR "Bounds out of order:" L U))
(if [OR (LESSP L 0)
(GREATERP U (SUB1 (ARRAYTOTALSIZE X]
then (ERROR "Bounds exceed Array limits:" L U))
(UFQuickPairSort1 X Y L U)
(UFInsertionPairSort1 X Y L U])
(UFQuickPairSort1
[LAMBDA (X Y L U) (* SCP "18-Feb-86 21:59")
(* * Reference: Sedgewick, R. "Implementing Quicksort Programs" CACM vol. 21 no. 10 pp. 847--857.)
(if (GREATERP (DIFFERENCE U L)
10)
then (UFQuickPairSortFence X Y L U) (* Identify the partitioning element as the
median-of-three estimate of the median.)
(* * Perform the partitioning. (The ugly GO $$OUT is simply a "break" from the outer do loop to its "finally clause"
))
(bind (I ←(ADD1 L))
(J ← U)
(XL ←(\FLOATAREF X L)) declare (TYPE FLOATP XL)
do (declare (TYPE FLOATP XL) repeatwhile (UFLESSP (\FLOATAREF X I)
XL)
do (SETQ I (ADD1 I)))
(declare (TYPE FLOATP XL) repeatwhile (UFGREATERP (\FLOATAREF X J)
XL)
do (SETQ J (SUB1 J)))
(if (LESSP J I)
then (GO $$OUT))
(UFQuickSortSwap X I J)
(UFQuickSortSwap Y I J)
finally (UFQuickSortSwap X L J)
(UFQuickSortSwap Y L J) (* Now work recursively on the larger then the smaller
subfile.)
(if (GREATERP (DIFFERENCE J L)
(ADD1 (DIFFERENCE U I)))
then (UFQuickPairSort1 X Y L (SUB1 J))
(UFQuickPairSort1 X Y I U)
else (UFQuickPairSort1 X Y I U)
(UFQuickPairSort1 X Y L (SUB1 J])
(UFQuickPairSortFence
[LAMBDA (X Y L U) (* SCP "22-Feb-86 17:12")
(* * 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 L U)
2))
(LPLUS1 (ADD1 L)))
(UFQuickSortSwap X MIDLU LPLUS1)
(UFQuickSortSwap Y MIDLU LPLUS1)
(if (UFGREATERP (\FLOATAREF X LPLUS1)
(\FLOATAREF X U))
then (UFQuickSortSwap X LPLUS1 U)
(UFQuickSortSwap Y LPLUS1 U))
(if (UFGREATERP (\FLOATAREF X L)
(\FLOATAREF X U))
then (UFQuickSortSwap X L U)
(UFQuickSortSwap Y L U))
(if (UFGREATERP (\FLOATAREF X LPLUS1)
(\FLOATAREF X L))
then (UFQuickSortSwap X LPLUS1 L)
(UFQuickSortSwap Y LPLUS1 L)) (* The NIL which follows allows this if statement to be
compiled without RETURN context, hence unboxed)
NIL])
(UFQuickSort
[LAMBDA (X L U) (* SCP "22-Feb-86 17:14")
(* * Sort elements {L..U} of the 1-dimensional FLOATP CMLArray X from smallest to largest. X is sorted in place,
i.e. destructively. L and U default to 0 and (ARRAYTOTALSIZE X) -1 respectively. Returns X.)
(if (NOT (EQP (ARRAYELEMENTTYPE X)
(QUOTE FLONUM)))
then (ERROR "Array not FLOATP:" X))
(if (NOT (EQP (ARRAYRANK X)
1))
then (ERROR "Array not 1-Dimensional:" X))
(if (NULL L)
then (SETQ L 0))
[if (NULL U)
then (SETQ U (SUB1 (ARRAYTOTALSIZE X]
(if (GREATERP L U)
then (ERROR "Bounds out of order:" L U))
(if [OR (LESSP L 0)
(GREATERP U (SUB1 (ARRAYTOTALSIZE X]
then (ERROR "Bounds exceed Array limits:" L U))
(UFQuickSort1 X L U)
(UFInsertionSort1 X L U])
(UFQuickSort1
[LAMBDA (X L U) (* SCP "18-Feb-86 20:22")
(* * Reference: Sedgewick, R. "Implementing Quicksort Programs" CACM vol. 21 no. 10 pp. 847--857.)
(if (GREATERP (DIFFERENCE U L)
10)
then (UFQuickSortFence X L U) (* Identify the partitioning element as the
median-of-three estimate of the median.)
(* * Perform the partitioning. (The ugly GO $$OUT is simply a "break" from the outer do loop to its "finally clause"
))
(bind (I ←(ADD1 L))
(J ← U)
(XL ←(\FLOATAREF X L)) declare (TYPE FLOATP XL)
do (declare (TYPE FLOATP XL) repeatwhile (UFLESSP (\FLOATAREF X I)
XL)
do (SETQ I (ADD1 I)))
(declare (TYPE FLOATP XL) repeatwhile (UFGREATERP (\FLOATAREF X J)
XL)
do (SETQ J (SUB1 J)))
(if (LESSP J I)
then (GO $$OUT))
(UFQuickSortSwap X I J)
finally (UFQuickSortSwap X L J) (* Now work recursively on the larger then the smaller
subfile.)
(if (GREATERP (DIFFERENCE J L)
(ADD1 (DIFFERENCE U I)))
then (UFQuickSort1 X L (SUB1 J))
(UFQuickSort1 X I U)
else (UFQuickSort1 X I U)
(UFQuickSort1 X L (SUB1 J])
(UFQuickSortFence
[LAMBDA (X L U) (* SCP " 1-Mar-86 16:48")
(* * 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 L U)
2))
(LPLUS1 (ADD1 L)))
(UFQuickSortSwap X MIDLU LPLUS1)
(if (UFGREATERP (\FLOATAREF X LPLUS1)
(\FLOATAREF X U))
then (UFQuickSortSwap X LPLUS1 U))
(if (UFGREATERP (\FLOATAREF X L)
(\FLOATAREF X U))
then (UFQuickSortSwap X L U))
(if (UFGREATERP (\FLOATAREF X LPLUS1)
(\FLOATAREF X L))
then (UFQuickSortSwap X LPLUS1 L)) (* The NIL which follows allows this if statement to be
compiled without RETURN context, hence unboxed.)
NIL])
(UFQuickSortSwap
[LAMBDA (X I J) (* SCP "22-Feb-86 17:16")
(* * FNS definition, the real action is on the compiler DMACRO.)
(LET ((TT (\FLOATAREF X I)))
(DECLARE (TYPE FLOATP TT))
(\FLOATASET (\FLOATAREF X J)
X I)
(\FLOATASET TT X J])
(UFSelectKth
[LAMBDA (X K) (* SCP "22-Feb-86 17:32")
(* * Partially sort the elements of the 1-dimensional FLOATP 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 (EQP (ARRAYELEMENTTYPE X)
(QUOTE FLONUM)))
then (ERROR "Array not FLOATP:" X))
(if (NOT (EQP (ARRAYRANK X)
1))
then (ERROR "Array not 1-Dimensional:" X))
(SETQ K (FIX K))
(if [NOT (AND (LEQ 0 K)
(LEQ K (SUB1 (ARRAYTOTALSIZE X]
then (ERROR "Select: K outside array limits." K))
(if (EQP 0 K)
then (UFSelectMin X)
elseif (EQP K (SUB1 (ARRAYTOTALSIZE X)))
then (UFSelectMax X)
else (UFSelectKth1 X K 0 (SUB1 (ARRAYTOTALSIZE X])
(UFSelectKth1
[LAMBDA (X K L U) (* SCP "21-Feb-86 21:53")
(* * PreCondition: L <= K <= U. PostCondtion: X{L..K-1} <= X{K} <= X{K+1..U} and X{K} is returned.)
(bind (I ← L)
(J ←(ADD1 U)) while (LESSP L U)
do (UFQuickSortFence X L U) (* Partition using the median-of-three estimate of the
median.)
(bind XI XJ (XL ←(\FLOATAREF X L)) declare (TYPE FLOATP XI XJ XL)
do (declare (TYPE FLOATP XI XJ XL) repeatuntil (OR (GREATERP I U)
(UFGEQ (SETQ XI (\FLOATAREF X I))
XL))
do (SETQ I (ADD1 I)))
(declare (TYPE FLOATP XI XJ XL) repeatuntil (UFLEQ (SETQ XJ (\FLOATAREF X J))
XL)
do (SETQ J (SUB1 J)))
(if (LESSP J I)
then (RETURN)
else (\FLOATASET XI X J)
(\FLOATASET XJ X I)))
(UFQuickSortSwap X L J)
(if (LEQ K J)
then (SETQ U (SUB1 J))
(SETQ I L))
(if (GEQ K J)
then (SETQ L (ADD1 J))
(SETQ I L)
(SETQ J (ADD1 U)))
finally (RETURN (\FLOATAREF X K])
(UFSelectMax
[LAMBDA (X) (* SCP "22-Feb-86 17:22")
(* * comment)
(bind (XMAX ←(\FLOATAREF X 0))
XI declare (TYPE FLOATP XMAX XI) for I from 1 to (SUB1 (ARRAYTOTALSIZE X))
when (UFGREATERP (SETQ XI (\FLOATAREF X I))
XMAX)
do (SETQ XMAX XI) finally (RETURN XMAX])
(UFSelectMedian
[LAMBDA (X) (* SCP "22-Feb-86 17:41")
(* * comment)
(LET ((N (ARRAYTOTALSIZE X)))
(if (ODDP N)
then (UFSelectKth1 X (QUOTIENT (SUB1 N)
2)
0
(SUB1 N))
else (LET ([Ranks (CONSTANT (MAKEARRAY 2 (QUOTE ELEMENTTYPE)
(QUOTE FIXNUM]
Median)
(DECLARE (TYPE FLOATP Median))
(ASET (SUB1 (QUOTIENT N 2))
Ranks 0)
(ASET (QUOTIENT N 2)
Ranks 1)
(UFPartialSort1 X Ranks 0 (SUB1 N)
0 1)
(SETQ Median (TIMES (PLUS (\FLOATAREF X (SUB1 (QUOTIENT N 2)))
(\FLOATAREF X (QUOTIENT N 2)))
.5))
Median])
(UFSelectMin
[LAMBDA (X) (* SCP "22-Feb-86 17:22")
(* * comment)
(bind (XMIN ←(\FLOATAREF X 0))
XI declare (TYPE FLOATP XMIN XI) for I from 1 to (SUB1 (ARRAYTOTALSIZE X))
when (UFLESSP (SETQ XI (\FLOATAREF X I))
XMIN)
do (SETQ XMIN XI) finally (RETURN XMIN])
)
(DECLARE: EVAL@COMPILE
(PUTPROPS QuickSortSwap MACRO (OPENLAMBDA (X I J)
(LET ((TT (AREF X I)))
(ASET (AREF X J)
X I)
(ASET TT X J))))
(PUTPROPS UFQuickSortSwap DMACRO ((X I J)
(LET ((TT (\FLOATAREF X I)))
(DECLARE (TYPE FLOATP TT))
(\FLOATASET (\FLOATAREF X J)
X I)
(\FLOATASET TT X J))))
)
(PUTPROPS DINDESORT COPYRIGHT ("Massachusetts Institute of Technology" 1985 1986))
(DECLARE: DONTCOPY
(FILEMAP (NIL (922 32367 (InsertionSort 932 . 2053) (InsertionSort1 2055 . 2865) (PartialSort 2867 .
4298) (PartialSort1 4300 . 5895) (QuickSort 5897 . 6962) (QuickSort1 6964 . 8315) (QuickSortFence 8317
. 9090) (QuickSortSwap 9092 . 9378) (SelectKth 9380 . 10465) (SelectKth1 10467 . 11610) (SelectMax
11612 . 11855) (SelectMedian 11857 . 12544) (SelectMin 12546 . 12790) (UFInsertionPairSort 12792 .
14345) (UFInsertionPairSort1 14347 . 15449) (UFInsertionSort 15451 . 16502) (UFInsertionSort1 16504 .
17384) (UFPartialSort 17386 . 18743) (UFPartialSort1 18745 . 20449) (UFQuickPairSort 20451 . 21969) (
UFQuickPairSort1 21971 . 23528) (UFQuickPairSortFence 23530 . 24654) (UFQuickSort 24656 . 25649) (
UFQuickSort1 25651 . 27116) (UFQuickSortFence 27118 . 28078) (UFQuickSortSwap 28080 . 28414) (
UFSelectKth 28416 . 29433) (UFSelectKth1 29435 . 30716) (UFSelectMax 30718 . 31133) (UFSelectMedian
31135 . 31947) (UFSelectMin 31949 . 32365)))))
STOP