(FILECREATED " 4-Dec-85 14:58:19" {QV}<IDL>SOURCES>IDLCONTRASTS.;5
 22254  

      changes to:  (FNS POLY.DECOMPOSE)

      previous date: " 3-Dec-85 23:00:14" {QV}<IDL>SOURCES>IDLCONTRASTS.;4)


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

(PRETTYCOMPRINT IDLCONTRASTSCOMS)

(RPAQQ IDLCONTRASTSCOMS
 ((RECORDS BOUQUET CONTRAST CONTRASTFIT)
	(FNS CONTRAST.COEF CONTRAST.FITCOMPAREFN CONTRAST.FITS CONTRAST.INNERPRODUCT CONTRAST.LABEL 
	     CONTRAST.NOMINATE CONTRAST.NORM CONTRAST.OUTERPRODUCT CONTRAST.RATIOTOSCALE 
	     CONTRAST.REAPBOUQUETS CONTRAST.SCALE CONTRAST.VALUES GETPOLYCONTRASTS LSTMEDIAN 
	     MAKEBOUQUET MAKEORTHOCONTRASTS INVERSENORMAL NORMALIZE PLOTBOUQUET PLOTBOUQUETS 
	     POLY.DECOMPOSE WORKINGVALUES)))
[DECLARE: EVAL@COMPILE 

(DATATYPE BOUQUET
 (
IDLARRAY
 CONTRASTFITS WORKINGVALUES DISPLAYRATIOS SCALE N))

(DATATYPE CONTRAST
 (CDIMS NDIMS COEF IDLARRAY CONTRASTTYPE CONTRASTORDER CONTRASTDIM)
		     (
ACCESSFNS
 (CONTRASTNORM (
CONTRAST.NORM
 (fetch
 (CONTRAST IDLARRAY)
								    of
 DATUM)
								 DATUM))))

(DATATYPE CONTRASTFIT
 (
IDLARRAY
 CONTRAST FIT NORMFIT))
]
(/DECLAREDATATYPE (QUOTE BOUQUET)
		  (QUOTE (POINTER POINTER POINTER POINTER POINTER POINTER))
		  (QUOTE ((BOUQUET 0 POINTER)
			  (BOUQUET 2 POINTER)
			  (BOUQUET 4 POINTER)
			  (BOUQUET 6 POINTER)
			  (BOUQUET 8 POINTER)
			  (BOUQUET 10 POINTER)))
		  (QUOTE 12))
(/DECLAREDATATYPE (QUOTE CONTRAST)
		  (QUOTE (POINTER POINTER POINTER POINTER POINTER POINTER POINTER))
		  (QUOTE ((CONTRAST 0 POINTER)
			  (CONTRAST 2 POINTER)
			  (CONTRAST 4 POINTER)
			  (CONTRAST 6 POINTER)
			  (CONTRAST 8 POINTER)
			  (CONTRAST 10 POINTER)
			  (CONTRAST 12 POINTER)))
		  (QUOTE 14))
(/DECLAREDATATYPE (QUOTE CONTRASTFIT)
		  (QUOTE (POINTER POINTER POINTER POINTER))
		  (QUOTE ((CONTRASTFIT 0 POINTER)
			  (CONTRASTFIT 2 POINTER)
			  (CONTRASTFIT 4 POINTER)
			  (CONTRASTFIT 6 POINTER)))
		  (QUOTE 8))
(DEFINEQ

(CONTRAST.COEF

  [LAMBDA (INDICES CONTRAST)                                 (* jop: " 3-Dec-85 21:07")


          (* *)



    (
PROG
 ((CDIMS (fetch
 (CONTRAST CDIMS) of
 CONTRAST))
	     (NDIMS (fetch
 (CONTRAST NDIMS) of
 CONTRAST))
	     (COEF (fetch
 (CONTRAST COEF) of
 CONTRAST)))
	    (
RETURN
 (
GETRELT
 COEF (if
 (
EQLENGTH
 CDIMS 1)
					  then
 (
CAR
 (
FNTH
 INDICES (
CAR
 CDIMS)))
					else
 (
ADD1
 (for
 CDIM in
 CDIMS as
 NDIM in
 NDIMS
							  sum
 (
ITIMES
 NDIM
									  (
SUB1

									    (
CAR
 (
FNTH
 INDICES 
											   CDIM])

(CONTRAST.FITCOMPAREFN

  [LAMBDA (FIT1 FIT2)                                        (* jop: " 2-Dec-85 22:46")

    (
FLESSP
 (fetch
 (CONTRASTFIT NORMFIT) of
 FIT1)
	      (fetch
 (CONTRASTFIT NORMFIT) of
 FIT2])

(CONTRAST.FITS

  [LAMBDA (
IDLARRAY
 CONTRASTS)                             (* jop: " 3-Dec-85 21:06")


          (* *)



    (bind
 NORM INNERPRODUCT for
 CONTRAST in
 CONTRASTS
       collect
 (
SETQ
 NORM (fetch
 (CONTRAST CONTRASTNORM) of
 CONTRAST))
		 (
SETQ
 INNERPRODUCT (CONTRAST.INNERPRODUCT
 IDLARRAY CONTRAST))
		 (create
 CONTRASTFIT
			   IDLARRAY _ IDLARRAY
			   CONTRAST _ CONTRAST
			   FIT _(
FQUOTIENT
 INNERPRODUCT NORM)
			   NORMFIT _(
FABS
 (
FQUOTIENT
 INNERPRODUCT (
SQRT
 NORM])

(CONTRAST.INNERPRODUCT

  [LAMBDA (
IDLARRAY
 CONTRAST)                              (* jop: " 2-Dec-85 15:16")


          (* *)



    (bind
 (GSB _(
SETUP
 IDLARRAY (
QUOTE
 ROWMAJOR)))
	    (INDICES _(for
 I from
 1 to
 (
IDLARRAYRANK
 IDLARRAY) collect
 1))
	    (LIMITS _(
IDLARRAYDIMS
 IDLARRAY))
	    (PROD _ 0)
	    NEXTELT while
 (
NOT
 (fetch
 (GENSTATEBLOCK DONE) of
 GSB))
       do
 (
SETQ
 NEXTELT (
GETAELT
 IDLARRAY (
NEXT
 GSB)))
	    [
SETQ
 PROD (
PLUS
 PROD (
TIMES
 NEXTELT (CONTRAST.COEF
 INDICES CONTRAST]
	    [bind
 (
INDEX
 _(
LAST
 INDICES))
		    (LIMIT _(
LAST
 LIMITS)) while
 (
AND
 INDEX (
IEQP
 (
CAR
 INDEX)
									  (
CAR
 LIMIT)))
	       do
 (
RPLACA
 INDEX 1)                       (* Work backwards up the list)

		    (
SETQ
 INDEX (
NLEFT
 INDICES 1 INDEX))
		    (
SETQ
 LIMIT (
NLEFT
 LIMITS 1 LIMIT))
	       finally
 (
AND
 INDEX (
RPLACA
 INDEX (
ADD1
 (
CAR
 INDEX]
       finally
 (
RETURN
 PROD])

(CONTRAST.LABEL

  [LAMBDA (CONTRAST)                                         (* jop: " 3-Dec-85 21:28")


          (* *)



    (
PROG
 ((CONTRASTDIM (fetch
 (CONTRAST CONTRASTDIM) of
 CONTRAST))
	     (CONTRASTORDER (fetch
 (CONTRAST CONTRASTORDER) of
 CONTRAST)))
	    (
RETURN
 (
PACK*
 [
PACK
 (for
 CDIM in
 CONTRASTDIM collect
 (if
 (
LITATOM
 CDIM)
										  then
 CDIM
										else
 (
QUOTE

											 DIM]
			       (
PACK
 CONTRASTORDER])

(CONTRAST.NOMINATE

  [LAMBDA (PLOTOBJECT PLOT)                                  (* jop: " 3-Dec-85 21:32")


          (* *)



    (
PROG
 ((BOUQUET (
OBJECTPROP
 PLOTOBJECT (
QUOTE
 BOUQUET)))
	     (CONTRASTFIT (
OBJECTPROP
 PLOTOBJECT (
QUOTE
 CONTRASTFIT)))
	     (BOUQUETS (
PLOTPROP
 PLOT (
QUOTE
 BOUQUETS)))
	     BCURVE BPOINTS TRIMMEDCONTRASTS NOMCONTRAST)
	    [
SETQ
 BCURVE (for
 OBJECT in
 (fetch
 PLOTOBJECTS of
 PLOT)
			      thereis
 (
AND
 (OBJECTSUBTYPE? CURVE OBJECT)
					       (
EQ
 (
OBJECTPROP
 OBJECT (
QUOTE
 BOUQUET))
						     BOUQUET]
	    (
AND
 BCURVE (
DELETEOBJECT
 BCURVE PLOT T T))
	    (
SETQ
 BPOINTS (for
 OBJECT in
 (fetch
 PLOTOBJECTS of
 PLOT)
			       when
 (
AND
 (OBJECTSUBTYPE? POINT OBJECT)
					     (
EQ
 (
OBJECTPROP
 OBJECT (
QUOTE
 BOUQUET))
						   BOUQUET))
			       collect
 OBJECT))
	    (for
 POINT in
 BPOINTS do
 (
DELETEOBJECT
 POINT PLOT T T))
	    (
DREMOVE
 BOUQUET BOUQUETS)
	    (
SETQ
 NOMCONTRAST (fetch
 (CONTRASTFIT CONTRAST) of
 CONTRASTFIT))
	    (
SETQ
 TRIMMEDCONTRASTS (for
 CONTRASTFIT in
 (fetch
 (BOUQUET CONTRASTFITS)
								of
 BOUQUET)
					unless
 (
EQ
 (fetch
 (CONTRASTFIT CONTRAST) of
 
										      CONTRASTFIT)
						       NOMCONTRAST)
					collect
 (fetch
 (CONTRASTFIT CONTRAST) of
 CONTRASTFIT)))
	    (PLOTBOUQUETS
 (
LIST
 (MAKEBOUQUET
 (
LIST
 NOMCONTRAST))
				    (MAKEBOUQUET
 TRIMMEDCONTRASTS))
			    (
LIST
 (fetch
 (POINTDATA SYMBOL) of
 (fetch
 OBJECTDATA
									of
 PLOTOBJECT)))
			    NIL PLOT])

(CONTRAST.NORM

  [LAMBDA (
IDLARRAY
 CONTRAST)                              (* jop: " 3-Dec-85 20:45")


          (* * Computes squared norm based on factor that as a vector CONTRAST as norm 1)



    (
PROG
 ((CDIMS (fetch
 (CONTRAST CDIMS) of
 CONTRAST))
	     (
RANK
 (
IDLARRAYRANK
 IDLARRAY)))
	    (
RETURN
 (if
 (
EQLENGTH
 CDIMS RANK)
			  then
 1
			else
 (for
 I from
 1 to
 RANK as
 DM in
 (
IDLARRAYDIMS
 IDLARRAY)
				  unless
 (
MEMB
 I CDIMS) sum
 DM])

(CONTRAST.OUTERPRODUCT

  [LAMBDA (CONTRAST1 CONTRAST2)                              (* jop: " 3-Dec-85 21:19")


          (* *)



    (if
 (
NEQ
 (fetch
 (CONTRAST IDLARRAY) of
 CONTRAST1)
		 (fetch
 (CONTRAST IDLARRAY) of
 CONTRAST2))
	then
 (
HELP
 "Contrasts not on same array"))
    (
PROG
 ((CDIMS1 (fetch
 (CONTRAST CDIMS) of
 CONTRAST1))
	     (NDIMS1 (fetch
 (CONTRAST NDIMS) of
 CONTRAST1))
	     (COEF1 (fetch
 (CONTRAST COEF) of
 CONTRAST1))
	     (CDIMS2 (fetch
 (CONTRAST CDIMS) of
 CONTRAST2))
	     (NDIMS2 (fetch
 (CONTRAST NDIMS) of
 CONTRAST2))
	     (COEF2 (fetch
 (CONTRAST COEF) of
 CONTRAST2))
	     CDIMSR NDIMSR COEFR)
	    (if
 (
INTERSECTION
 CDIMS1 CDIMS2)
		then
 (
HELP
 "Contrasts have overlapping dims"))
	    (
SETQ
 CDIMSR (
APPEND
 CDIMS1 CDIMS2))
	    (
SETQ
 NDIMSR (
APPEND
 (bind
 (OFFSET _(fetch
 NELTS of
 COEF2)) for
 NDIM
					in
 NDIMS1 collect
 (
ITIMES
 OFFSET NDIM))
				     NDIMS2))
	    [
SETQ
 COEFR (create
 ROWFLOAT
				    NELTS _(
ITIMES
 (fetch
 NELTS of
 COEF1)
						     (fetch
 NELTS of
 COEF2]
	    [bind
 (K _ 1) for
 I from
 1 to
 (fetch
 NELTS of
 COEF1)
	       do
 (for
 J from
 1 to
 (fetch
 NELTS of
 COEF2)
		       do
 (
SETRELT
 COEFR K (
TIMES
 (
GETRELT
 COEF1 I)
							(
GETRELT
 COEF2 J)))
			    (
SETQ
 K (
ADD1
 K]
	    (
RETURN
 (LET* ((
IDLARRAY
 (fetch
 (CONTRAST IDLARRAY) of
 CONTRAST1))
			     (
RANK
 (
IDLARRAYRANK
 IDLARRAY)))
			    (create
 CONTRAST
				      CDIMS _ CDIMSR
				      NDIMS _ NDIMSR
				      COEF _ COEFR
				      IDLARRAY _ IDLARRAY
				      CONTRASTTYPE _(
APPEND
 (fetch
 (CONTRAST CONTRASTTYPE)
								 of
 CONTRAST1)
							      (fetch
 (CONTRAST CONTRASTTYPE)
								 of
 CONTRAST2))
				      CONTRASTORDER _(
APPEND
 (fetch
 (CONTRAST CONTRASTORDER)
								  of
 CONTRAST1)
							       (fetch
 (CONTRAST CONTRASTORDER)
								  of
 CONTRAST2))
				      CONTRASTDIM _(
APPEND
 (fetch
 (CONTRAST CONTRASTDIM)
								of
 CONTRAST1)
							     (fetch
 (CONTRAST CONTRASTDIM)
								of
 CONTRAST2])

(CONTRAST.RATIOTOSCALE

  [LAMBDA (PLOTOBJECT PLOT)                                  (* jop: " 3-Dec-85 16:42")


          (* *)



    (
PROG
 ((BOUQUET (
OBJECTPROP
 PLOTOBJECT (
QUOTE
 BOUQUET)))
	     (DR (
OBJECTPROP
 PLOTOBJECT (
QUOTE
 DISPLAYRATIO)))
	     RATIO FIVEP)
	    (
SETQ
 RATIO (
FQUOTIENT
 DR (fetch
 (BOUQUET SCALE) of
 BOUQUET)))
	    [
SETQ
 FIVEP (
PLUS
 1.38 (
FQUOTIENT
 3.24 (fetch
 (BOUQUET N) of
 BOUQUET]
	    (
PLOTPROMPT
 (if
 (
GREATERP
 RATIO FIVEP)
			      then
 (
CONCAT
 "Ratio to Scale: " RATIO " Sign. at 5%%")
			    else
 (
CONCAT
 "Ratio to Scale: " RATIO))
			  PLOT])

(CONTRAST.REAPBOUQUETS

  [LAMBDA (
PLOT
)                                           (* jop: " 3-Dec-85 17:16")

    (
PROMPTPRINT
 (
CONCAT
 "IT bound to " (
SETQ
 IT (
PLOTPROP
 PLOT (
QUOTE
 BOUQUETS])

(CONTRAST.SCALE

  [LAMBDA (PLOTOBJECT PLOT)                                  (* jop: " 3-Dec-85 16:10")


          (* *)



    (
PROG
 [(BOUQUET (
OBJECTPROP
 PLOTOBJECT (
QUOTE
 BOUQUET]
	    (
PLOTPROMPT
 (
CONCAT
 "Bouquet scale: " (fetch
 (BOUQUET SCALE) of
 BOUQUET))
			  PLOT])

(CONTRAST.VALUES

  [LAMBDA (PLOTOBJECT PLOT)                                  (* jop: " 3-Dec-85 16:11")


          (* *)



    (
PROG
 [(WV (
OBJECTPROP
 PLOTOBJECT (
QUOTE
 WORKINGVALUE)))
	     (DR (
OBJECTPROP
 PLOTOBJECT (
QUOTE
 DISPLAYRATIO]
	    (
PLOTPROMPT
 (
CONCAT
 "Working Value: " WV " Display Ratio: " DR)
			  PLOT])

(GETPOLYCONTRASTS

  [LAMBDA (
IDLARRAY
 DIM)                                   (* jop: " 3-Dec-85 21:16")


          (* *)



    (if
 (
LITATOM
 DIM)
	then
 (
SETQ
 DIM (
GETDIMNUM
 IDLARRAY DIM)))
    (bind
 COEF for
 CONTRAST in
 (
CDR
 (MAKEORTHOCONTRASTS
 (
IDLARRAYDIMENSION
 IDLARRAY DIM)))
       as
 POWER from
 1
       collect
 (
SETQ
 COEF (create
 ROWFLOAT
					NELTS _(
LENGTH
 CONTRAST)))
		 (for
 I from
 1 as
 CN in
 CONTRAST do
 (
SETRELT
 COEF I CN))
		 (create
 CONTRAST
			   CDIMS _(
LIST
 DIM)
			   NDIMS _(
LIST
 1)
			   COEF _ COEF
			   IDLARRAY _ IDLARRAY
			   CONTRASTTYPE _(
LIST
 (
QUOTE
 POLY))
			   CONTRASTORDER _(
LIST
 POWER)
			   CONTRASTDIM _(
LIST
 (
OR
 (
GETDIMLAB
 IDLARRAY DIM)
						      DIM])

(LSTMEDIAN

  [LAMBDA (LST)                                              (* jop: " 3-Dec-85 17:29")


          (* * Assumes that the list LST is sorted)



    (
PROG
 ((SLST (
SORT
 (
COPY
 LST)
			   (
FUNCTION
 LESSP
)))
	     (N (
LENGTH
 LST)))
	    (
RETURN
 (if
 (
ODDP
 N)
			  then
 (
CAR
 (
FNTH
 SLST (
IQUOTIENT
 (
ADD1
 N)
								  2)))
			else
 (LET [(PLST (
FNTH
 SLST (
IQUOTIENT
 N 2]
				    (
FQUOTIENT
 (
PLUS
 (
CAR
 PLST)
							 (
CADR
 PLST))
						 2])

(MAKEBOUQUET

  [LAMBDA (CONTRASTS)                                        (* jop: " 3-Dec-85 21:13")


          (* *)



    (
SETQ
 CONTRASTS (
MKLIST
 CONTRASTS))
    (
PROG
 ((
IDLARRAY
 (fetch
 (CONTRAST IDLARRAY) of
 (
CAR
 CONTRASTS)))
	     CONTRASTFITS WORKINGVALUES DISPLAYRATIOS)
	    (if
 (for
 CONTRAST in
 CONTRASTS thereis
 (
NEQ
 (fetch
 (CONTRAST IDLARRAY)
								     of
 CONTRAST)
								  IDLARRAY))
		then
 (
HELP
 "Contrasts not all on samae array" IDLARRAY))
	    (
SETQ
 CONTRASTFITS (
SORT
 (CONTRAST.FITS
 IDLARRAY CONTRASTS)
					 (
FUNCTION
 CONTRAST.FITCOMPAREFN)))
	    (
SETQ
 WORKINGVALUES (WORKINGVALUES
 (
LENGTH
 CONTRASTS)))
	    (
SETQ
 DISPLAYRATIOS (for
 FIT in
 CONTRASTFITS as
 WV in
 WORKINGVALUES
				     collect
 (
FQUOTIENT
 (fetch
 (CONTRASTFIT NORMFIT)
							       of
 FIT)
							    WV)))
	    (
RETURN
 (create
 BOUQUET
				IDLARRAY _ IDLARRAY
				CONTRASTFITS _ CONTRASTFITS
				WORKINGVALUES _ WORKINGVALUES
				DISPLAYRATIOS _ DISPLAYRATIOS
				SCALE _(LSTMEDIAN
 DISPLAYRATIOS)
				N _(
LENGTH
 CONTRASTFITS])

(MAKEORTHOCONTRASTS

  [LAMBDA (NLEVELS)                                          (* jop: " 2-Dec-85 15:03")


          (* *)



    (
PROG
 ((MEAN (NORMALIZE
 (for
 I from
 1 to
 NLEVELS collect
 1)))
	     [LINEAR (NORMALIZE
 (if
 (
ODDP
 NLEVELS)
				      then
 (for
 I from
 (
IMINUS
 (
IQUOTIENT
 (
SUB1
 NLEVELS)
										    2))
						to
 (
IQUOTIENT
 (
SUB1
 NLEVELS)
								  2)
						collect
 I)
				    else
 (for
 I from
 (
IMINUS
 (
IQUOTIENT
 NLEVELS 2))
					      to
 (
IQUOTIENT
 NLEVELS 2) unless
 (
IEQP
 I 0)
					      collect
 I]
	     POWERS LASTPOWER NPOWER CONTRASTS)
	    (
SETQ
 POWERS (
LIST
 MEAN LINEAR))
	    (
SETQ
 LASTPOWER LINEAR)
	    (
SETQ
 NPOWER 2)
	    (
SETQ
 CONTRASTS (
LIST
 MEAN LINEAR))
	    (bind
 NEXTPOWER NEWCONTRAST PROJECTIONS while
 (
ILESSP
 NPOWER NLEVELS)
	       do
 [
SETQ
 NEXTPOWER (NORMALIZE
 (for
 LI in
 LINEAR as
 LPI in
 LASTPOWER
						      collect
 (
TIMES
 LI LPI]
		    [
SETQ
 PROJECTIONS (for
 CONTRAST in
 CONTRASTS
					   collect
 (for
 NP in
 NEXTPOWER as
 CONT in
 CONTRAST
							sum
 (
TIMES
 NP CONT]
		    [
SETQ
 NEWCONTRAST
		      (NORMALIZE
 (bind
 (TEMP _ NEXTPOWER) for
 CONTRAST in
 CONTRASTS
				      as
 PROJ in
 PROJECTIONS unless
 (
EQP
 PROJ 0)
				      do
 [
SETQ
 TEMP
					     (for
 TP in
 TEMP as
 CONT in
 CONTRAST
						collect
 (
DIFFERENCE
 TP (
TIMES
 PROJ CONT]
				      finally
 (
RETURN
 TEMP]
		    (
NCONC1
 CONTRASTS NEWCONTRAST)
		    (
NCONC1
 POWERS NEXTPOWER)
		    (
SETQ
 LASTPOWER NEXTPOWER)
		    (
SETQ
 NPOWER (
ADD1
 NPOWER)))
	    (
RETURN
 CONTRASTS])

(INVERSENORMAL

  [LAMBDA (P)                                                (* jop: " 2-Dec-85 16:43")


          (* * Inverse Normal CDF -- transcribed from C -- Algorithm AS 11, Applied Sta. (1977), Vol.

	  26, #1)



    (
PROG
 ((SPLIT .42)
	     Q R VALUE)
	    (DECLARE
 (TYPE FLOATP Q R VALUE))
	    (
SETQ
 Q (
FDIFFERENCE
 P .5))
	    [if
 (
LEQ
 (
FABS
 Q)
			 SPLIT)
		then
 (
SETQ
 R (
FTIMES
 Q Q))
		       (
SETQ
 VALUE
			 (
FQUOTIENT
 (
FTIMES
 Q
						(
FPLUS
 (
FTIMES
 (
FPLUS

								     (
FTIMES
 (
FPLUS
 (
FTIMES

											  -25.44106 R)
											41.3912)
									       R)
								     -18.615)
								   R)
							 2.506628))
				      (
FPLUS

					(
FTIMES
 (
FPLUS
 (
FTIMES

							     (
FPLUS
 (
FTIMES
 (
FPLUS

										  (
FTIMES
 3.130829 
											    R)
										  -21.06224)
										R)
								      23.08337)
							     R)
							   -8.473512)
						  R)
					1.0)))
	      else
 (
SETQ
 R P)
		     (if
 (
FGREATERP
 Q 0.0)
			 then
 (
SETQ
 R (
FDIFFERENCE
 1.0 P)))
		     (if
 (
LEQ
 R 0.0)
			 then
                              (* P out of bounds)

				(
SETQ
 VALUE -1.0)
		       else
 [
SETQ
 R (
SQRT
 (
FMINUS
 (
LOG
 R]
			      (
SETQ
 VALUE
				(
FQUOTIENT
 (
FPLUS
 (
FTIMES
 (
FPLUS
 (
FTIMES

									   (
FPLUS
 (
FTIMES
 
											 2.321213 R)
										    4.850141)
									   R)
									 -2.297965)
								R)
						      -2.78719)
					     (
FPLUS
 (
FTIMES
 (
FPLUS
 (
FTIMES
 1.637068 R)
									 3.543889)
								R)
						      1.0)))
			      (if
 (
LESSP
 Q 0.0)
				  then
 (
SETQ
 VALUE (
FMINUS
 VALUE]
	    (
RETURN
 VALUE])

(NORMALIZE

  [LAMBDA (LST)                                              (* jop: " 2-Dec-85 15:06")


          (* *)



    (bind
 [
NORM
 _(
SQRT
 (bind
 (RESULT _ 0) for
 TERM in
 LST declare
 (TYPE FLOATP TERM 
										      RESULT)
				do
 (
SETQ
 RESULT (
FPLUS
 RESULT (
FTIMES
 TERM TERM)))
				finally
 (
RETURN
 RESULT]
       for
 TERM in
 LST collect
 (
FQUOTIENT
 TERM NORM])

(PLOTBOUQUET

  [LAMBDA (
PLOT
 BOUQUET SYMBOL NODRAWFLG)                  (* jop: " 3-Dec-85 21:30")


          (* *)



    [if
 (
NULL
 (
PLOTMENU
 PLOT (
QUOTE
 DRATIO)))
	then
 [
PLOTMENUITEMS
 PLOT (
QUOTE
 DRATIO)
				(
COPY
 (
PLOTMENUITEMS
 PLOT (
QUOTE
 MIDDLE]
	       (
PLOTDELMENUITEMS
 PLOT (
QUOTE
 DRATIO)
				   (
QUOTE
 (Delete)))
	       (
PLOTADDMENUITEMS
 PLOT (
QUOTE
 DRATIO)
				   (
QUOTE
 ((Scale CONTRAST.SCALE)
					      (Ratio-to-scale CONTRAST.RATIOTOSCALE)
					      (Values CONTRAST.VALUES)
					      (Nominate CONTRAST.NOMINATE]
    (
PROG
 ((
CONTRASTFITS
 (fetch
 (BOUQUET CONTRASTFITS) of
 BOUQUET))
	     (WORKINGVALUES
 (fetch
 (BOUQUET WORKINGVALUES) of
 BOUQUET))
	     (
DISPLAYRATIOS
 (fetch
 (BOUQUET DISPLAYRATIOS) of
 BOUQUET))
	     POSITIONS POINTS)
	    (
SETQ
 POSITIONS (for
 DR in
 DISPLAYRATIOS as
 WV in
 WORKINGVALUES
				 collect
 (create
 POSITION
						     XCOORD _ WV
						     YCOORD _ DR)))
	    (if
 (
IGREATERP
 (
LENGTH
 POSITIONS)
			       1)
		then
 (LET ((CURVE (
PLOTCURVE
 PLOT POSITIONS NIL NIL NIL NODRAWFLG)))
			    (
OBJECTPROP
 CURVE (
QUOTE
 BOUQUET)
					  BOUQUET)))
	    (
SETQ
 POINTS (
PLOTPOINTS
 PLOT POSITIONS (for
 FIT in
 CONTRASTFITS
							   collect
 (CONTRAST.LABEL

								       (fetch
 (CONTRASTFIT CONTRAST)
									  of
 FIT)))
					 SYMBOL
					 (
QUOTE
 DRATIO)
					 NODRAWFLG))
	    (for
 POINT in
 POINTS as
 CONTRASTFIT in
 CONTRASTFITS as
 WV in
 WORKINGVALUES
	       as
 DR in
 DISPLAYRATIOS
	       do
 (
OBJECTPROP
 POINT (
QUOTE
 BOUQUET)
				  BOUQUET)
		    (
OBJECTPROP
 POINT (
QUOTE
 CONTRASTFIT)
				  CONTRASTFIT)
		    (
OBJECTPROP
 POINT (
QUOTE
 WORKINGVALUE)
				  WV)
		    (
OBJECTPROP
 POINT (
QUOTE
 DISPLAYRATIO)
				  DR])

(PLOTBOUQUETS

  [LAMBDA (BOUQUETS SYMBOLS LABEL PLOT)                      (* jop: " 3-Dec-85 17:16")


          (* *)



    (
SETQ
 BOUQUETS (
MKLIST
 BOUQUETS))
    (if
 (
NULL
 SYMBOLS)
	then
 (
SETQ
 SYMBOLS (
LIST
 STAR CROSS CIRCLE)))
    (if
 (
NULL
 PLOT)
	then
 (
SETQ
 PLOT (
CREATEPLOT
)))
    (
PLOTLABEL
 PLOT (
QUOTE
 BOTTOM)
		 "Working Values" T)
    (
PLOTLABEL
 PLOT (
QUOTE
 LEFT)
		 "Display Ratio" T)
    (if
 LABEL
	then
 (
PLOTLABEL
 PLOT (
QUOTE
 TOP)
			    LABEL))
    (
PLOTTICS
 PLOT (
QUOTE
 BOTTOM)
		(
QUOTE
 BOTH)
		T)
    (
PLOTTICS
 PLOT (
QUOTE
 LEFT)
		(
QUOTE
 BOTH)
		T)
    (bind
 (SYMBOL _ SYMBOLS) for
 BOUQUET in
 BOUQUETS
       do
 (PLOTBOUQUET
 PLOT BOUQUET (
CAR
 SYMBOL)
			   T)
	    (
SETQ
 SYMBOL (
OR
 (
CDR
 SYMBOL)
				 SYMBOLS)))
    (
RESCALEPLOT
 PLOT NIL T)
    [
PLOTPROP
 PLOT (
QUOTE
 BOUQUETS)
		(
APPEND
 BOUQUETS (
PLOTPROP
 PLOT (
QUOTE
 BOUQUETS]
    [
PLOTADDMENUITEMS
 PLOT (
QUOTE
 RIGHT)
			(
QUOTE
 (("IT _ Bouquets" CONTRAST.REAPBOUQUETS]
    (
OPENPLOTWINDOW
 PLOT])

(POLY.DECOMPOSE

  [LAMBDA (
IDLARRAY
)                                       (* jop: " 4-Dec-85 11:14")


          (* *)



    (
PROG
 ((
RANK
 (
IDLARRAYRANK
 IDLARRAY))
	     (DIMS (
IDLARRAYDIMS
 IDLARRAY))
	     MAINEFFECTS TWOTERM THREETERM)
	    (if
 (
NOT
 (
IEQP
 RANK 3))
		then
 (
HELP
))
	    (
SETQ
 MAINEFFECTS (for
 I from
 1 to
 RANK collect
 (GETPOLYCONTRASTS
 IDLARRAY I))
	      )
	    [
SETQ
 TWOTERM (for
 TMAINEFFECTS on
 MAINEFFECTS while
 (
CDR
 TMAINEFFECTS)
			       join
 (for
 EFFECT in
 (
CDR
 TMAINEFFECTS)
					 collect
 (for
 C1 in
 (
CAR
 TMAINEFFECTS)
						      join
 (for
 C2 in
 EFFECT
								collect
 (CONTRAST.OUTERPRODUCT

									    C1 C2]
	    [
SETQ
 THREETERM (for
 CONTRAST in
 (
CAR
 TWOTERM) join
 (for
 MC
									     in
 (
CADDR
 
										      MAINEFFECTS)
									     collect
 (

									    CONTRAST.OUTERPRODUCT

											 CONTRAST MC]
	    (
RETURN
 (
LIST
 MAINEFFECTS TWOTERM THREETERM])

(WORKINGVALUES

  [LAMBDA (N)                                                (* jop: " 2-Dec-85 16:35")


          (* *)



    (bind
 (3N _(
ITIMES
 3 N))
	    (6N _(
ITIMES
 6 N))
	    PVALUE for
 I from
 1 to
 N
       collect
 (
SETQ
 PVALUE (
FQUOTIENT
 (
PLUS
 (
TIMES
 3 I)
						     3N)
					     (
PLUS
 6N 2)))
		 (INVERSENORMAL
 PVALUE])
)
(PUTPROPS IDLCONTRASTS COPYRIGHT ("Xerox Corporation" 1985))
(DECLARE: DONTCOPY
  (FILEMAP (NIL (1970 22171 (CONTRAST.COEF 1980 . 2618) (CONTRAST.FITCOMPAREFN 2620 . 2854) (
CONTRAST.FITS 2856 . 3411) (CONTRAST.INNERPRODUCT 3413 . 4476) (CONTRAST.LABEL 4478 . 4987) (
CONTRAST.NOMINATE 4989 . 6663) (CONTRAST.NORM 6665 . 7195) (CONTRAST.OUTERPRODUCT 7197 . 9458) (
CONTRAST.RATIOTOSCALE 9460 . 10131) (CONTRAST.REAPBOUQUETS 10133 . 10355) (CONTRAST.SCALE 10357 . 
10669) (CONTRAST.VALUES 10671 . 11030) (GETPOLYCONTRASTS 11032 . 11867) (LSTMEDIAN 11869 . 12403) (
MAKEBOUQUET 12405 . 13575) (MAKEORTHOCONTRASTS 13577 . 15382) (INVERSENORMAL 15384 . 17154) (NORMALIZE
 17156 . 17599) (PLOTBOUQUET 17601 . 19530) (PLOTBOUQUETS 19532 . 20683) (POLY.DECOMPOSE 20685 . 21776
) (WORKINGVALUES 21778 . 22169)))))
STOP