(FILECREATED "28-Jun-86 15:12:14" {QV}<PEDERSEN>LISP>FLOATARRAYSORTER.;7 24758
changes to: (FNS FLOAT.AINDEXQUICKSORT FLOAT.DINDEXQUICKSORT FLOAT.AQUICKSORT FLOAT.DQUICKSORT)
previous date: "23-Jun-86 11:54:52" {QV}<PEDERSEN>LISP>FLOATARRAYSORTER.;6)
(* Copyright (c) 1986 by Xerox Corporation. All rights reserved.)
(PRETTYCOMPRINT FLOATARRAYSORTERCOMS)
(RPAQQ FLOATARRAYSORTERCOMS ((FNS FLOAT.DINDEXINSERTIONSORT FLOAT.DINDEXQSFENCE
FLOAT.DINDEXQUICKSORT FLOAT.DINSERTIONSORT FLOAT.DQSFENCE
FLOAT.DQUICKSORT FLOAT.AINDEXINSERTIONSORT FLOAT.AINDEXQSFENCE
FLOAT.AINDEXQUICKSORT FLOAT.AINSERTIONSORT FLOAT.AQSFENCE
FLOAT.AQUICKSORT FLOAT-ARRAY-KTH-ELT FLOAT-ARRAY-KTH-INDEX
FLOAT-ARRAY-SORT INDEX-FLOAT-ARRAY-SORT)
(MACROS FLOAT.INDEXSWAPELTS FLOAT.SWAPELTS FLOATINDEXAREF)
(DECLARE: DONTEVAL@LOAD DOEVAL@COMPILE DONTCOPY (LOCALVARS . T))))
(DEFINEQ
(FLOAT.DINDEXINSERTIONSORT
[LAMBDA (FLOATARRAY INDICES LOWER UPPER) (* jop: "12-Jun-86 14:49")
(* *)
(LET ((FLOATARRAYBASE (ARRAYBASE FLOATARRAY)))
(bind ITHINDEX ITHELT for I from (ADD1 LOWER) to UPPER declare (TYPE FLOATP
ITHELT)
do
(* * Loop Invariant: X{L..I-1} are correctly ordered.)
(SETQ ITHINDEX (AREF INDICES I))
(SETQ ITHELT (\GETBASEFLOATP FLOATARRAYBASE (MUL2 ITHINDEX)))
(bind (J ← I)
TEMP while (AND (IGREATERP J LOWER)
(UFLESSP [\GETBASEFLOATP
FLOATARRAYBASE
(MUL2 (SETQ TEMP (AREF INDICES
(SUB1 J]
ITHELT))
do (ASET TEMP INDICES J)
(SETQ J (SUB1 J))
finally (ASET ITHINDEX INDICES J)))
INDICES])
(FLOAT.DINDEXQSFENCE
[LAMBDA (FLOATARRAY INDICES LOWER UPPER) (* jop: "12-Jun-86 13:41")
(* * 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 ((FLOATARRAYBASE (ARRAYBASE FLOATARRAY))
(MIDLU (IQUOTIENT (IPLUS LOWER UPPER)
2))
(LPLUS1 (ADD1 LOWER))
TEMP)
(FLOAT.INDEXSWAPELTS INDICES MIDLU LPLUS1 TEMP)
(if (UFLESSP (FLOATINDEXAREF FLOATARRAYBASE INDICES LPLUS1)
(FLOATINDEXAREF FLOATARRAYBASE INDICES UPPER))
then (FLOAT.INDEXSWAPELTS INDICES LPLUS1 UPPER TEMP))
(if (UFLESSP (FLOATINDEXAREF FLOATARRAYBASE INDICES LOWER)
(FLOATINDEXAREF FLOATARRAYBASE INDICES UPPER))
then (FLOAT.INDEXSWAPELTS INDICES LOWER UPPER TEMP))
(if (UFLESSP (FLOATINDEXAREF FLOATARRAYBASE INDICES LPLUS1)
(FLOATINDEXAREF FLOATARRAYBASE INDICES LOWER))
then (FLOAT.INDEXSWAPELTS INDICES LPLUS1 LOWER TEMP))
NIL])
(FLOAT.DINDEXQUICKSORT
[LAMBDA (FLOATARRAY INDICES LOWER UPPER) (* jop: "28-Jun-86 14:56")
(* * Reference: Sedgewick, R. "Implementing Quicksort Programs" CACM vol. 21 no. 10 pp. 847--857.)
(if (IGREATERP (IDIFFERENCE UPPER LOWER)
10)
then (FLOAT.DINDEXQSFENCE FLOATARRAY INDICES LOWER UPPER)
(* Identify the partitioning element as the
median-of-three estimate of the median.)
(* * Perform the partitioning.)
(LET ((FLOATARRAYBASE (ARRAYBASE FLOATARRAY)))
(bind (XL ←(FLOATINDEXAREF FLOATARRAYBASE INDICES LOWER))
(I ←(ADD1 LOWER))
(J ← UPPER)
FINISHED declare (TYPE FLOATP XL) while (NOT FINISHED)
do (while (UFGREATERP (FLOATINDEXAREF FLOATARRAYBASE INDICES I)
XL)
do (SETQ I (ADD1 I)))
(while (UFLEQ (FLOATINDEXAREF FLOATARRAYBASE INDICES J)
XL)
do (SETQ J (SUB1 J)))
(if (IGREATERP J I)
then (FLOAT.INDEXSWAPELTS INDICES I J)
else (SETQ FINISHED T))
finally (FLOAT.INDEXSWAPELTS INDICES LOWER J)
(* Now work recursively on the larger then the smaller
subfile.)
(if (IGREATERP (IDIFFERENCE J LOWER)
(ADD1 (IDIFFERENCE UPPER I)))
then (FLOAT.DINDEXQUICKSORT FLOATARRAY INDICES LOWER
(SUB1 J))
(FLOAT.DINDEXQUICKSORT FLOATARRAY INDICES I UPPER)
else (FLOAT.DINDEXQUICKSORT FLOATARRAY INDICES I UPPER)
(FLOAT.DINDEXQUICKSORT FLOATARRAY INDICES LOWER
(SUB1 J])
(FLOAT.DINSERTIONSORT
[LAMBDA (FLOATARRAY LOWER UPPER) (* jop: "12-Jun-86 13:20")
(* * Sort elements {L..U} of the 1-dimensional NUMBERP CMLArray FLOATARRAY from smallest to largest.
FLOATARRAY is sorted in place, i.e. destructively. NO argument checking! Returns X. INTENDED FOR FEWER THAN 20
ELEMENTS, USE QuickSort FOR LARGER PROBLEMS!)
(LET ((FLOATARRAYBASE (ARRAYBASE FLOATARRAY)))
(for I from (ADD1 LOWER) to UPPER
do
(* * Loop Invariant: X{L..I-1} are correctly ordered.)
(bind (ITHELT ← (\GETBASEFLOATP FLOATARRAYBASE (MUL2 I)))
(J ← I)
TEMP declare (TYPE FLOATP ITHELT TEMP)
while (AND (IGREATERP J LOWER)
(UFLESSP [SETQ TEMP (\GETBASEFLOATP FLOATARRAYBASE
(MUL2 (SUB1 J]
ITHELT))
do (\PUTBASEFLOATP FLOATARRAYBASE (MUL2 J)
TEMP)
(SETQ J (SUB1 J))
finally (\PUTBASEFLOATP FLOATARRAYBASE (MUL2 J)
ITHELT)))
FLOATARRAY])
(FLOAT.DQSFENCE
[LAMBDA (FLOATARRAY LOWER UPPER) (* jop: "12-Jun-86 13:16")
(* * 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 ((FLOATARRAYBASE (ARRAYBASE FLOATARRAY))
(MIDLU (IQUOTIENT (IPLUS LOWER UPPER)
2))
(LPLUS1 (ADD1 LOWER))
TEMPI)
(DECLARE (TYPE FLOATP TEMPI))
(FLOAT.SWAPELTS FLOATARRAYBASE MIDLU LPLUS1 TEMPI)
(if (UFLESSP (\GETBASEFLOATP FLOATARRAYBASE (MUL2 LPLUS1))
(\GETBASEFLOATP FLOATARRAYBASE (MUL2 UPPER)))
then (FLOAT.SWAPELTS FLOATARRAYBASE LPLUS1 UPPER TEMPI))
(if (UFLESSP (\GETBASEFLOATP FLOATARRAYBASE (MUL2 LOWER))
(\GETBASEFLOATP FLOATARRAYBASE (MUL2 UPPER)))
then (FLOAT.SWAPELTS FLOATARRAYBASE LOWER UPPER TEMPI))
(if (UFLESSP (\GETBASEFLOATP FLOATARRAYBASE (MUL2 LPLUS1))
(\GETBASEFLOATP FLOATARRAYBASE (MUL2 LOWER)))
then (FLOAT.SWAPELTS FLOATARRAYBASE LPLUS1 LOWER TEMPI))
NIL])
(FLOAT.DQUICKSORT
[LAMBDA (FLOATARRAY LOWER UPPER) (* jop: "28-Jun-86 14:57")
(* * Reference: Sedgewick, R. "Implementing Quicksort Programs" CACM vol. 21 no. 10 pp. 847--857.)
(if (IGREATERP (IDIFFERENCE UPPER LOWER)
10)
then (FLOAT.DQSFENCE FLOATARRAY LOWER UPPER) (* Identify the partitioning element as the
median-of-three estimate of the median.)
(* * Perform the partitioning.)
(LET ((FLOATARRAYBASE (ARRAYBASE FLOATARRAY)))
(bind (I ←(ADD1 LOWER))
(J ← UPPER)
(XL ←(\GETBASEFLOATP FLOATARRAYBASE (MUL2 LOWER)))
XI XJ FINISHED declare (TYPE FLOATP XL XI XJ) while (NOT FINISHED)
do (while (UFGREATERP (SETQ XI (\GETBASEFLOATP FLOATARRAYBASE
(MUL2 I)))
XL)
do (SETQ I (ADD1 I)))
(while (UFLEQ (SETQ XJ (\GETBASEFLOATP FLOATARRAYBASE
(MUL2 J)))
XL)
do (SETQ J (SUB1 J)))
(if (IGREATERP J I)
then (\PUTBASEFLOATP FLOATARRAYBASE (MUL2 I)
XJ)
(\PUTBASEFLOATP FLOATARRAYBASE (MUL2 J)
XI)
else (SETQ FINISHED T))
finally (FLOAT.SWAPELTS FLOATARRAYBASE LOWER J)
(* Now work recursively on the larger then the smaller
subfile.)
(if (IGREATERP (IDIFFERENCE J LOWER)
(ADD1 (IDIFFERENCE UPPER I)))
then (FLOAT.DQUICKSORT FLOATARRAY LOWER (SUB1 J))
(FLOAT.DQUICKSORT FLOATARRAY I UPPER)
else (FLOAT.DQUICKSORT FLOATARRAY I UPPER)
(FLOAT.DQUICKSORT FLOATARRAY LOWER (SUB1 J])
(FLOAT.AINDEXINSERTIONSORT
[LAMBDA (FLOATARRAY INDICES LOWER UPPER) (* jop: "12-Jun-86 14:49")
(* *)
(LET ((FLOATARRAYBASE (ARRAYBASE FLOATARRAY)))
(bind ITHINDEX ITHELT for I from (ADD1 LOWER) to UPPER declare (TYPE FLOATP
ITHELT)
do
(* * Loop Invariant: X{L..I-1} are correctly ordered.)
(SETQ ITHINDEX (AREF INDICES I))
(SETQ ITHELT (\GETBASEFLOATP FLOATARRAYBASE (MUL2 ITHINDEX)))
(bind (J ← I)
TEMP while (AND (IGREATERP J LOWER)
(UFGREATERP [\GETBASEFLOATP
FLOATARRAYBASE
(MUL2 (SETQ TEMP (AREF INDICES
(SUB1
J]
ITHELT))
do (ASET TEMP INDICES J)
(SETQ J (SUB1 J))
finally (ASET ITHINDEX INDICES J)))
INDICES])
(FLOAT.AINDEXQSFENCE
[LAMBDA (FLOATARRAY INDICES LOWER UPPER) (* jop: "12-Jun-86 13:41")
(* * 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 ((FLOATARRAYBASE (ARRAYBASE FLOATARRAY))
(MIDLU (IQUOTIENT (IPLUS LOWER UPPER)
2))
(LPLUS1 (ADD1 LOWER))
TEMP)
(FLOAT.INDEXSWAPELTS INDICES MIDLU LPLUS1 TEMP)
(if (UFGREATERP (FLOATINDEXAREF FLOATARRAYBASE INDICES LPLUS1)
(FLOATINDEXAREF FLOATARRAYBASE INDICES UPPER))
then (FLOAT.INDEXSWAPELTS INDICES LPLUS1 UPPER TEMP))
(if (UFGREATERP (FLOATINDEXAREF FLOATARRAYBASE INDICES LOWER)
(FLOATINDEXAREF FLOATARRAYBASE INDICES UPPER))
then (FLOAT.INDEXSWAPELTS INDICES LOWER UPPER TEMP))
(if (UFGREATERP (FLOATINDEXAREF FLOATARRAYBASE INDICES LPLUS1)
(FLOATINDEXAREF FLOATARRAYBASE INDICES LOWER))
then (FLOAT.INDEXSWAPELTS INDICES LPLUS1 LOWER TEMP))
NIL])
(FLOAT.AINDEXQUICKSORT
[LAMBDA (FLOATARRAY INDICES LOWER UPPER) (* jop: "28-Jun-86 14:54")
(* * Reference: Sedgewick, R. "Implementing Quicksort Programs" CACM vol. 21 no. 10 pp. 847--857.)
(if (IGREATERP (IDIFFERENCE UPPER LOWER)
10)
then (FLOAT.AINDEXQSFENCE FLOATARRAY INDICES LOWER UPPER)
(* Identify the partitioning element as the
median-of-three estimate of the median.)
(* * Perform the partitioning.)
(LET ((FLOATARRAYBASE (ARRAYBASE FLOATARRAY)))
(bind (XL ←(FLOATINDEXAREF FLOATARRAYBASE INDICES LOWER))
(I ←(ADD1 LOWER))
(J ← UPPER)
FINISHED declare (TYPE FLOATP XL) while (NOT FINISHED)
do (while (UFLESSP (FLOATINDEXAREF FLOATARRAYBASE INDICES I)
XL)
do (SETQ I (ADD1 I)))
(while (UFGEQ (FLOATINDEXAREF FLOATARRAYBASE INDICES J)
XL)
do (SETQ J (SUB1 J)))
(if (IGREATERP J I)
then (FLOAT.INDEXSWAPELTS INDICES I J)
else (SETQ FINISHED T))
finally (FLOAT.INDEXSWAPELTS INDICES LOWER J)
(* Now work recursively on the larger then the smaller
subfile.)
(if (IGREATERP (IDIFFERENCE J LOWER)
(ADD1 (IDIFFERENCE UPPER I)))
then (FLOAT.AINDEXQUICKSORT FLOATARRAY INDICES LOWER
(SUB1 J))
(FLOAT.AINDEXQUICKSORT FLOATARRAY INDICES I UPPER)
else (FLOAT.AINDEXQUICKSORT FLOATARRAY INDICES I UPPER)
(FLOAT.AINDEXQUICKSORT FLOATARRAY INDICES LOWER
(SUB1 J])
(FLOAT.AINSERTIONSORT
[LAMBDA (FLOATARRAY LOWER UPPER) (* jop: "12-Jun-86 13:13")
(* * Sort elements {L..U} of the 1-dimensional NUMBERP CMLArray FLOATARRAY from smallest to largest.
FLOATARRAY is sorted in place, i.e. destructively. NO argument checking! Returns X. INTENDED FOR FEWER THAN 20
ELEMENTS, USE QuickSort FOR LARGER PROBLEMS!)
(LET ((FLOATARRAYBASE (ARRAYBASE FLOATARRAY)))
(for I from (ADD1 LOWER) to UPPER
do
(* * Loop Invariant: X{L..I-1} are correctly ordered.)
(bind (ITHELT ←(\GETBASEFLOATP FLOATARRAYBASE (MUL2 I)))
(J ← I)
TEMP declare (TYPE FLOATP ITHELT TEMP)
while (AND (IGREATERP J LOWER)
(UFGREATERP [SETQ TEMP (\GETBASEFLOATP FLOATARRAYBASE
(MUL2 (SUB1 J]
ITHELT))
do (\PUTBASEFLOATP FLOATARRAYBASE (MUL2 J)
TEMP)
(SETQ J (SUB1 J))
finally (\PUTBASEFLOATP FLOATARRAYBASE (MUL2 J)
ITHELT)))
FLOATARRAY])
(FLOAT.AQSFENCE
[LAMBDA (FLOATARRAY LOWER UPPER) (* jop: "12-Jun-86 13: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 ((FLOATARRAYBASE (ARRAYBASE FLOATARRAY))
(MIDLU (IQUOTIENT (IPLUS LOWER UPPER)
2))
(LPLUS1 (ADD1 LOWER))
TEMPI)
(DECLARE (TYPE FLOATP TEMPI))
(FLOAT.SWAPELTS FLOATARRAYBASE MIDLU LPLUS1 TEMPI)
(if (UFGREATERP (\GETBASEFLOATP FLOATARRAYBASE (MUL2 LPLUS1))
(\GETBASEFLOATP FLOATARRAYBASE (MUL2 UPPER)))
then (FLOAT.SWAPELTS FLOATARRAYBASE LPLUS1 UPPER TEMPI))
(if (UFGREATERP (\GETBASEFLOATP FLOATARRAYBASE (MUL2 LOWER))
(\GETBASEFLOATP FLOATARRAYBASE (MUL2 UPPER)))
then (FLOAT.SWAPELTS FLOATARRAYBASE LOWER UPPER TEMPI))
(if (UFGREATERP (\GETBASEFLOATP FLOATARRAYBASE (MUL2 LPLUS1))
(\GETBASEFLOATP FLOATARRAYBASE (MUL2 LOWER)))
then (FLOAT.SWAPELTS FLOATARRAYBASE LPLUS1 LOWER TEMPI))
NIL])
(FLOAT.AQUICKSORT
[LAMBDA (FLOATARRAY LOWER UPPER) (* jop: "28-Jun-86 14:56")
(* * Reference: Sedgewick, R. "Implementing Quicksort Programs" CACM vol. 21 no. 10 pp. 847--857.)
(if (IGREATERP (IDIFFERENCE UPPER LOWER)
10)
then (FLOAT.AQSFENCE FLOATARRAY LOWER UPPER) (* Identify the partitioning element as the
median-of-three estimate of the median.)
(* * Perform the partitioning.)
(LET ((FLOATARRAYBASE (ARRAYBASE FLOATARRAY)))
(bind (I ←(ADD1 LOWER))
(J ← UPPER)
(XL ←(\GETBASEFLOATP FLOATARRAYBASE (MUL2 LOWER)))
XI XJ FINISHED declare (TYPE FLOATP XL XI XJ) while (NOT FINISHED)
do (while (UFLESSP (SETQ XI (\GETBASEFLOATP FLOATARRAYBASE
(MUL2 I)))
XL)
do (SETQ I (ADD1 I)))
(while (UFGEQ (SETQ XJ (\GETBASEFLOATP FLOATARRAYBASE
(MUL2 J)))
XL)
do (SETQ J (SUB1 J)))
(if (IGREATERP J I)
then (\PUTBASEFLOATP FLOATARRAYBASE (MUL2 I)
XJ)
(\PUTBASEFLOATP FLOATARRAYBASE (MUL2 J)
XI)
else (SETQ FINISHED T))
finally (FLOAT.SWAPELTS FLOATARRAYBASE LOWER J)
(* Now work recursively on the larger then the smaller
subfile.)
(if (IGREATERP (IDIFFERENCE J LOWER)
(ADD1 (IDIFFERENCE UPPER I)))
then (FLOAT.AQUICKSORT FLOATARRAY LOWER (SUB1 J))
(FLOAT.AQUICKSORT FLOATARRAY I UPPER)
else (FLOAT.AQUICKSORT FLOATARRAY I UPPER)
(FLOAT.AQUICKSORT FLOATARRAY LOWER (SUB1 J])
(FLOAT-ARRAY-KTH-ELT
[LAMBDA (FLOATVECTOR K) (* jop: "23-Jun-86 11:49")
(* * Find Kth elt is ascending order)
(if [NOT (AND (EQ (ARRAY-RANK FLOATVECTOR)
1)
(EQ (ARRAY-ELEMENT-TYPE FLOATVECTOR)
(QUOTE SINGLE-FLOAT]
then (ERROR "Array not 1-Dimensional float vector:" FLOATVECTOR))
(SETQ K (FIX K))
(if [NOT (AND (ILEQ 0 K)
(ILEQ K (SUB1 (ARRAY-TOTAL-SIZE FLOATVECTOR]
then (ERROR "K out of bounds" K))
(LET [(LOWER 0)
(UPPER (SUB1 (ARRAY-TOTAL-SIZE FLOATVECTOR]
(bind (VECTORBASE ←(ARRAYBASE FLOATVECTOR))
(I ←(ADD1 LOWER))
(J ← UPPER) while (ILESSP LOWER UPPER)
do (FLOAT.AQSFENCE FLOATVECTOR LOWER UPPER)
(bind XI XJ (XL ←(\GETBASEFLOATP VECTORBASE (MUL2 LOWER)))
FINISHED declare (TYPE FLOATP XI XJ XL) while (NOT FINISHED)
do (while (AND (ILESSP I UPPER)
(UFLEQ (SETQ XI (\GETBASEFLOATP VECTORBASE
(MUL2 I)))
XL))
do (SETQ I (ADD1 I)))
(while (AND (IGREATERP J LOWER)
(UFGEQ (SETQ XJ (\GETBASEFLOATP VECTORBASE
(MUL2 J)))
XL))
do (SETQ J (SUB1 J)))
(if (IGREATERP J I)
then (\PUTBASEFLOATP VECTORBASE (MUL2 J)
XI)
(\PUTBASEFLOATP VECTORBASE (MUL2 I)
XJ)
else (SETQ FINISHED T)))
(FLOAT.SWAPELTS VECTORBASE 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 (\GETBASEFLOATP VECTORBASE (MUL2 K])
(FLOAT-ARRAY-KTH-INDEX
[LAMBDA (FLOATVECTOR K INDICES) (* jop: "23-Jun-86 11:49")
(* *)
(if [NOT (AND (EQ (ARRAY-RANK FLOATVECTOR)
1)
(EQ (ARRAY-ELEMENT-TYPE FLOATVECTOR)
(QUOTE SINGLE-FLOAT]
then (ERROR "Array not 1-Dimensional float vector:" FLOATVECTOR))
(SETQ K (FIX K))
(if [NOT (AND (LEQ 0 K)
(LEQ K (SUB1 (ARRAY-TOTAL-SIZE FLOATVECTOR]
then (ERROR "K out of bounds" K))
(if (NULL INDICES)
then (SETQ INDICES (MAKE-ARRAY (ARRAY-TOTAL-SIZE FLOATVECTOR)))
elseif [NOT (AND (EQ (ARRAY-RANK INDICES)
1)
(EQ (ARRAY-TOTAL-SIZE INDICES)
(ARRAY-TOTAL-SIZE FLOATVECTOR]
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 FLOATVECTOR]
(bind (VECTORBASE ←(ARRAYBASE FLOATVECTOR))
(I ←(ADD1 LOWER))
(J ← UPPER) while (ILESSP LOWER UPPER)
do (FLOAT.AINDEXQSFENCE FLOATVECTOR INDICES LOWER UPPER)
(bind (XL ←(\GETBASEFLOATP VECTORBASE (MUL2 LOWER)))
FINISHED declare (TYPE FLOATP XL) while (NOT FINISHED)
do (while (AND (ILESSP I UPPER)
(UFLEQ (FLOATINDEXAREF VECTORBASE INDICES I)
XL))
do (SETQ I (ADD1 I)))
(while (AND (IGREATERP J LOWER)
(UFGEQ (FLOATINDEXAREF VECTORBASE INDICES J)
XL))
do (SETQ J (SUB1 J)))
(if (IGREATERP J I)
then (FLOAT.INDEXSWAPELTS INDICES I J)
else (SETQ FINISHED T)))
(FLOAT.INDEXSWAPELTS 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])
(FLOAT-ARRAY-SORT
[LAMBDA (FLOATARRAY DESCENDINGFLG) (* jop: "12-Jun-86 12:48")
(* * Sort elements {L..U} of the 1-dimensional FLOAT CMLArray FLOATARRAY from smallest to largest.
FLOATARRAY is sorted in place, i.e. destructively. Returns FLOATARRAY)
(if [NOT (AND (CL:ARRAYP FLOATARRAY)
(EQ (ARRAY-RANK FLOATARRAY)
1)
(EQ (ARRAY-ELEMENT-TYPE FLOATARRAY)
(QUOTE SINGLE-FLOAT]
then (HELP "Not 1-Dimensional float array" FLOATARRAY))
(LET [(LOWER 0)
(UPPER (SUB1 (ARRAY-TOTAL-SIZE FLOATARRAY]
(if DESCENDINGFLG
then (FLOAT.DQUICKSORT FLOATARRAY LOWER UPPER)
(FLOAT.DINSERTIONSORT FLOATARRAY LOWER UPPER)
else (FLOAT.AQUICKSORT FLOATARRAY LOWER UPPER)
(FLOAT.AINSERTIONSORT FLOATARRAY LOWER UPPER))
FLOATARRAY])
(INDEX-FLOAT-ARRAY-SORT
[LAMBDA (FLOATARRAY INDICES DESCENDINGFLG) (* jop: "12-Jun-86 13:36")
(* *)
(if [NOT (AND (CL:ARRAYP FLOATARRAY)
(EQ (ARRAY-RANK FLOATARRAY)
1)
(EQ (ARRAY-ELEMENT-TYPE FLOATARRAY)
(QUOTE SINGLE-FLOAT]
then (HELP "Not 1-Dimensional float array" FLOATARRAY))
(if (NULL INDICES)
then (SETQ INDICES (MAKE-ARRAY (ARRAY-TOTAL-SIZE FLOATARRAY)))
elseif [NOT (AND (CL:ARRAYP INDICES)
(EQ (ARRAY-RANK INDICES)
1)
(EQ (ARRAY-TOTAL-SIZE INDICES)
(ARRAY-TOTAL-SIZE FLOATARRAY]
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 FLOATARRAY]
(if DESCENDINGFLG
then (FLOAT.DINDEXQUICKSORT FLOATARRAY INDICES LOWER UPPER)
(FLOAT.DINDEXINSERTIONSORT FLOATARRAY INDICES LOWER UPPER)
else (FLOAT.AINDEXQUICKSORT FLOATARRAY INDICES LOWER UPPER)
(FLOAT.AINDEXINSERTIONSORT FLOATARRAY INDICES LOWER UPPER))
INDICES])
)
(DECLARE: EVAL@COMPILE
[DEFMACRO FLOAT.INDEXSWAPELTS (INDICES I J &OPTIONAL TEMP)
(* *)
(if TEMP then (BQUOTE (PROGN (SETQ , TEMP (AREF , INDICES , I))
(ASET (AREF , INDICES , J)
, INDICES , I)
(ASET , TEMP , INDICES , J)))
else
(BQUOTE (LET ((TEMP (AREF , INDICES , I)))
(ASET (AREF , INDICES , J)
, INDICES , I)
(ASET TEMP , INDICES , J]
[DEFMACRO FLOAT.SWAPELTS (FLOATARRAYBASE I J &OPTIONAL TEMPI)
(* *)
(if TEMPI then (BQUOTE (PROGN (SETQ , TEMPI (\GETBASEFLOATP , FLOATARRAYBASE
(MUL2 , I)))
(\PUTBASEFLOATP , FLOATARRAYBASE (MUL2 , I)
(\GETBASEFLOATP , FLOATARRAYBASE
(MUL2 , J)))
(\PUTBASEFLOATP , FLOATARRAYBASE (MUL2 , J)
, TEMPI)))
else
(BQUOTE (LET [(TEMPI (\GETBASEFLOATP , FLOATARRAYBASE (MUL2 , I]
(DECLARE (TYPE FLOATP TEMPI))
(\PUTBASEFLOATP , FLOATARRAYBASE (MUL2 , I)
(\GETBASEFLOATP , FLOATARRAYBASE (MUL2 , J)))
(\PUTBASEFLOATP , FLOATARRAYBASE (MUL2 , J)
TEMPI]
[DEFMACRO FLOATINDEXAREF (FLOATARRAYBASE INDICES INDEX)
(BQUOTE (\GETBASEFLOATP , FLOATARRAYBASE (MUL2 (AREF , INDICES , INDEX]
)
(DECLARE: DONTEVAL@LOAD DOEVAL@COMPILE DONTCOPY
(DECLARE: DOEVAL@COMPILE DONTCOPY
(LOCALVARS . T)
)
)
(PUTPROPS FLOATARRAYSORTER COPYRIGHT ("Xerox Corporation" 1986))
(DECLARE: DONTCOPY
(FILEMAP (NIL (918 23379 (FLOAT.DINDEXINSERTIONSORT 928 . 1827) (FLOAT.DINDEXQSFENCE 1829 . 2948) (
FLOAT.DINDEXQUICKSORT 2950 . 4806) (FLOAT.DINSERTIONSORT 4808 . 5911) (FLOAT.DQSFENCE 5913 . 7101) (
FLOAT.DQUICKSORT 7103 . 8969) (FLOAT.AINDEXINSERTIONSORT 8971 . 9891) (FLOAT.AINDEXQSFENCE 9893 .
11030) (FLOAT.AINDEXQUICKSORT 11032 . 12882) (FLOAT.AINSERTIONSORT 12884 . 13981) (FLOAT.AQSFENCE
13983 . 15189) (FLOAT.AQUICKSORT 15191 . 17055) (FLOAT-ARRAY-KTH-ELT 17057 . 19005) (
FLOAT-ARRAY-KTH-INDEX 19007 . 21192) (FLOAT-ARRAY-SORT 21194 . 22109) (INDEX-FLOAT-ARRAY-SORT 22111 .
23377)))))
STOP