(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