(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