(FILECREATED "23-Jun-86 14:27:27" {QV}<PEDERSEN>LISP>MEDIANPOLISH.;1
 2871   

      changes to:  (VARS MEDIANPOLISHCOMS FOO DATA-LIST)
		   (FNS MEDPOL))


(* Copyright (c) 1986 by Xerox Corporation. All rights reserved.)

(PRETTYCOMPRINT MEDIANPOLISHCOMS)

(RPAQQ MEDIANPOLISHCOMS
 ((VARS DATA-LIST)
			   (FNS MEDPOL)))

(RPAQQ DATA-LIST
 (8.7 9.8 21.7 34.7 48.5 58.4 64.0 36.2 37.1 45.3 54.4 64.7 73.4 77.30001 57.6 61.9 
			68.4 75.9 81.2 85.8 87.7))
(DEFINEQ

(MEDPOL

  [LAMBDA (EMATRIX HALF-STEPS START-ON-COLS Residual)        (* jop: "23-Jun-86 13:54")


          (* *)



    (if
 (
NULL
 HALF-STEPS)
	then
 (
SETQ
 HALF-STEPS 8))
    [if
 (
NULL
 Residual)
	then
 (
SETQ
 Residual (
MAKE-ARRAY
 (
EARRAY-DIMENSIONS
 EMATRIX)
					      (
QUOTE
 :ELEMENT-TYPE)
					      (
EARRAY-ELEMENT-TYPE
 EMATRIX]
    (
EARRAY-BLT
 EMATRIX NIL Residual)
    (bind
 (RowEffects ←(
MAKE-ARRAY
 (
EARRAY-DIMENSION
 EMATRIX 0)
				       (
QUOTE
 :ELEMENT-TYPE)
				       (
EARRAY-ELEMENT-TYPE
 EMATRIX)
				       (
QUOTE
 :INITIAL-ELEMENT)
				       0.0))
	    (ColEffects ←(
MAKE-ARRAY
 (
EARRAY-DIMENSION
 EMATRIX 1)
				       (
QUOTE
 :ELEMENT-TYPE)
				       (
EARRAY-ELEMENT-TYPE
 EMATRIX)
				       (
QUOTE
 :INITIAL-ELEMENT)
				       0.0))
	    (RTemp ←(
MAKE-ARRAY
 (
EARRAY-DIMENSION
 EMATRIX 0)
				  (
QUOTE
 :ELEMENT-TYPE)
				  (
EARRAY-ELEMENT-TYPE
 EMATRIX)))
	    (CTemp ←(
MAKE-ARRAY
 (
EARRAY-DIMENSION
 EMATRIX 1)
				  (
QUOTE
 :ELEMENT-TYPE)
				  (
EARRAY-ELEMENT-TYPE
 EMATRIX)))
	    GrandMedian Temp first
 (if
 START-ON-COLS
					 then
 (
EARRAY-MEDIAN-REDUCE
 Residual 0 CTemp)
						(
EARRAY-SWEEP
 (
FUNCTION
 DIFFERENCE)
								Residual CTemp 0 Residual)
						(
EARRAY-PLUS
 ColEffects CTemp ColEffects)
						(
SETQ
 HALF-STEPS (
SUB1
 HALF-STEPS)))
       for
 Step from
 1 to
 HALF-STEPS by
 2
       do
 (
EARRAY-MEDIAN-REDUCE
 Residual 1 RTemp)
	    (
EARRAY-SWEEP
 (
FUNCTION
 DIFFERENCE)
			    Residual RTemp 1 Residual)
	    (
EARRAY-PLUS
 RowEffects RTemp RowEffects)
	    (
EARRAY-MEDIAN-REDUCE
 Residual 0 CTemp)
	    (
EARRAY-SWEEP
 (
FUNCTION
 DIFFERENCE)
			    Residual CTemp 0 Residual)
	    (
EARRAY-PLUS
 ColEffects CTemp ColEffects)
       finally
 (
SETQ
 Temp (
EARRAY-MEDIAN-REDUCE
 RowEffects))
		 (
EARRAY-DIFFERENCE
 RowEffects Temp RowEffects)
		 (
SETQ
 GrandMedian Temp)
		 (
SETQ
 Temp (
EARRAY-MEDIAN-REDUCE
 ColEffects))
		 (
EARRAY-DIFFERENCE
 ColEffects Temp ColEffects)
		 (
SETQ
 GrandMedian (
PLUS
 GrandMedian Temp))
		 (
RETURN
 (
EARRAY-ADJOIN
 (
EARRAY-ADJOIN
 Residual ColEffects 0)
					    (
EARRAY-ADJOIN
 RowEffects GrandMedian 0])
)
(PUTPROPS MEDIANPOLISH COPYRIGHT ("Xerox Corporation" 1986))
(DECLARE: DONTCOPY
  (FILEMAP (NIL (467 2788 (MEDPOL 477 . 2786)))))
STOP