(FILECREATED " 1-Jun-86 14:13:45" {QV}<IDL>SOURCES>IDLPLOT.;38 88502
changes to: (FNS BARPLOT.DRAW BARPLOT BARPLOT.TICFN BARPLOT.CHANGELABEL)
(VARS IDLPLOTCOMS)
previous date: "27-May-86 15:50:18" {QV}<IDL>SOURCES>IDLPLOT.;37)
(* Copyright (c) 1985, 1986 by Xerox Corporation. All rights reserved.)
(PRETTYCOMPRINT IDLPLOTCOMS)
(RPAQQ IDLPLOTCOMS [(FNS ADDCURVESTOPLOT ADDCURVETOPLOT ADDFILLEDRECTANGLESTOPLOT ADDLINESTOPLOT
ADDPOINTSTOPLOT ADDPOLYGONSTOPLOT ADDPOLYGONTOPLOT BARPLOT
BARPLOT.CHANGELABEL BARPLOT.DRAW BARPLOT.TICFN BOXPLOTS BOXPLOT.COMPAREFN
BOXPLOT.COMPUTETICS BOXPLOT.DELETE BOXPLOT.LABEL BOXPLOT.MOVE
BOXPLOT.WHENADDEDFN BOXPLOT.WHENDELETEDFN BOXPLOT.HISTOGRAM
BOXPLOT.MAKEBOX BOXPLOT.SUMMARY COPYBOXPLOT COPYHISTOGRAM COPYSCATTERPLOT
FIRSTHIDDENLEVLABEL FLIPBOX GETHIDDENLEVLABELS GETLETTERVALUES
GETSUMMARYWINDOW GETVALUEATDEPTH HISTOGRAM HISTOGRAM.BOXSUMMARY
HISTOGRAM.CHANGEBINS HISTOGRAM.COMPUTEMULT HISTOGRAM.DELETEQUANTILES
HISTOGRAM.DISPLAYQUANTILES HISTOGRAM.DRAW HISTOGRAM.INTSCALEFN
HISTOGRAM.INTTICFN HISTOGRAM.MAKEBININTERVAL HISTOGRAM.RESET
HISTOGRAM.SUMMARY HISTOGRAM.TICFN HISTOGRAM.VALUES LETTER.VALUE.DISPLAY
MAKEBOXOBJECT SCATTERPLOT SCATTERPLOT.POINTCOORDS
SCATTERPLOT.POINTSORCURVES SCATTERPLOT.REGRESS SCATTERPLOT.REGRESSSUMMARY
SCATTERPLOT.RUNNINGAVERAGE SCATTERPLOT.RUNNINGREGRESS
SCATTERPLOT.SMOOTHEDVALUE SCATTERPLOT.WORLDCOORD SUMMARY.REPAINTFN
SUMMARY.RESHAPEFN SUMMARYWINDOW.PRINT)
(RECORDS HISTOGRAM.BINS LETTERVALUES)
(DECLARE: DONTEVAL@LOAD DOEVAL@COMPILE DONTCOPY COMPILERVARS (ADDVARS (NLAMA)
(NLAML)
(LAMA BOXPLOTS])
(DEFINEQ
(ADDCURVESTOPLOT
[ULAMBDA ((PLOT PLOT)
(Y (ONEOF VECTOR MATRIX))
(X (ONEOF NIL VECTOR MATRIX))
(CURVELABEL (ONEOF NIL LABEL STRINGP))
(CURVEWIDTH (ONEOF NIL FIXP))
(CURVEMENU (ONEOF NIL LITATOM LISTP MENU))
(NODRAWFLG (MEMQ T NIL)))
(* jop: "13-Feb-86 22:48")
(PROG (CURVEOBJECTS)
(DECLARE (SPECVARS CURVEOBJECTS))
(EAPPLY* (FUNCTION ADDCURVETOPLOT)
(QUOTE (NIL VECTOR VECTOR NIL NIL NIL NIL))
PLOT Y X CURVELABEL CURVEWIDTH CURVEMENU NODRAWFLG)
(RETURN (DREVERSE CURVEOBJECTS)))])
(ADDCURVETOPLOT
[DLAMBDA ((PLOT PLOT)
(Y VECTOR)
(X (ONEOF NIL VECTOR))
(CURVELABEL (ONEOF NIL LABEL STRINGP))
(CURVEWIDTH (ONEOF NIL FIXP))
(CURVEMENU (ONEOF NIL LITATOM LISTP MENU))
(NODRAWFLG (MEMQ T NIL)))
(* jop: "13-Feb-86 22:48")
(* If (NULL X) then Plots vector Y against 1->N)
(LET* [(YROW (CONV.ROWSCALAR Y))
(XROW (if (NULL X)
then (GENROW 1 (fetch NELTS of YROW))
else (CONV.ROWSCALAR X]
(if (HASNILS YROW)
then (UERROR "NIL in Y vector"))
(if (HASNILS XROW)
then (UERROR "NIL in X vector"))
(if (NOT (IEQP (fetch NELTS of XROW)
(fetch NELTS of YROW)))
then (UERROR "Unequal length vectors"))
(push CURVEOBJECTS (LET* ((L (fetch NELTS of YROW))
(YLAB (if (type? SELARRAY Y)
then (FIRSTHIDDENLEVLABEL Y)
else (GETDIMLAB Y 1)))
[XLAB (if X
then (if (type? SELARRAY X)
then (FIRSTHIDDENLEVLABEL X)
else (GETDIMLAB X 1]
[POSITIONS (for I to L collect (create POSITION
XCOORD ←(
GETRELT
XROW I)
YCOORD ←(
GETRELT
YROW I]
(LABEL (OR CURVELABEL YLAB XLAB)))
(PLOTCURVE PLOT POSITIONS LABEL CURVEWIDTH CURVEMENU NODRAWFLG)
))
NIL)])
(ADDFILLEDRECTANGLESTOPLOT
[ULAMBDA ((PLOT PLOT)
(RECTANGLES (ONEOF VECTOR MATRIX))
(RECTANGLELABELS (ONEOF NIL LABEL STRINGP LISTP))
(RECTANGLEWIDTH (ONEOF NIL FIXP))
(RECTANGLETEXTURE [ONEOF NIL (FIXP (SATISFIES (TEXTUREP RECTANGLETEXTURE])
(RECTANGLEMENU (ONEOF NIL LITATOM LISTP MENU))
(NODRAWFLG (MEMQ T NIL)))
(* jop: "13-Feb-86 22:50")
[PROG ((RECTANGLEKEEPS (OR (CAR (fetch KEEPS of RECTANGLES))
1))
(RECTANGLESHAPE (fetch SHAPE of RECTANGLES)))
(if (type? VECTOR RECTANGLES)
then (if (NOT (EQP (GETRELT RECTANGLESHAPE 1)
4))
then (UERROR "MUST BE A VECTOR OF LENGTH 4"))
else (if (OR (AND (EQP RECTANGLEKEEPS 1)
(NOT (EQP (GETRELT RECTANGLESHAPE 2)
4)))
(NOT (EQP (GETRELT RECTANGLESHAPE 1)
4)))
then (UERROR "MUST HAVE LENGTH 4 IN THE UNKEPT DIMEMSION")))
(RETURN (bind NEXTVECTOR VECTORLABEL for I from 1
to (if (type? VECTOR RECTANGLES)
then 1
elseif (EQP RECTANGLEKEEPS 1)
then (GETRELT (fetch SHAPE of RECTANGLES)
1)
else (GETRELT (fetch SHAPE of RECTANGLES)
2))
collect [SETQ NEXTVECTOR (if (type? VECTOR RECTANGLES)
then RECTANGLES
elseif (EQP RECTANGLEKEEPS 1)
then (AT RECTANGLES (LIST I ALL))
else (AT RECTANGLES (LIST ALL I]
[SETQ VECTORLABEL (OR (if (LISTP RECTANGLELABELS)
then (CAR RECTANGLELABELS)
else RECTANGLELABELS)
(if (type? SELARRAY NEXTVECTOR)
then (FIRSTHIDDENLEVLABEL
NEXTVECTOR]
(if (LISTP RECTANGLELABELS)
then (SETQ RECTANGLELABELS (CDR RECTANGLELABELS)))
(LET* ((ROWVECTOR (CONV.ROWSCALAR NEXTVECTOR))
(LEFT (GETRELT ROWVECTOR 1))
(BOTTOM (GETRELT ROWVECTOR 2))
(WIDTH (GETRELT ROWVECTOR 3))
(HEIGHT (GETRELT ROWVECTOR 4)))
(PLOTFILLEDRECTANGLE PLOT LEFT BOTTOM WIDTH HEIGHT
VECTORLABEL RECTANGLETEXTURE
RECTANGLEWIDTH RECTANGLEMENU
NODRAWFLG]])
(ADDLINESTOPLOT
[ULAMBDA ((PLOT PLOT)
(LINES (ONEOF VECTOR MATRIX))
(LINELABELS (ONEOF NIL LABEL STRINGP LISTP))
(LINEWIDTH (ONEOF NIL FIXP))
(LINEMENU (ONEOF NIL LITATOM LISTP MENU))
(NODRAWFLG (MEMQ T NIL)))
(* jop: "13-Feb-86 22:51")
[PROG ((LINEKEEPS (OR (CAR (fetch KEEPS of LINES))
1))
(LINESHAPE (fetch SHAPE of LINES)))
(if (type? VECTOR LINES)
then (if (NOT (EQP (GETRELT LINESHAPE 1)
2))
then (UERROR "MUST BE A VECTOR OF LENGTH 2"))
else (if (OR (AND (EQP LINEKEEPS 1)
(NOT (EQP (GETRELT LINESHAPE 2)
2)))
(NOT (EQP (GETRELT LINESHAPE 1)
2)))
then (UERROR "MUST HAVE LENGTH 2 IN THE UNKEPT DIMEMSION")))
(RETURN (bind NEXTVECTOR VECTORLABEL for I from 1
to (if (type? VECTOR LINES)
then 1
elseif (EQP LINEKEEPS 1)
then (GETRELT (fetch SHAPE of LINES)
1)
else (GETRELT (fetch SHAPE of LINES)
2))
collect [SETQ NEXTVECTOR (if (type? VECTOR LINES)
then LINES
elseif (EQP LINEKEEPS 1)
then (AT LINES (LIST I ALL))
else (AT LINES (LIST ALL I]
[SETQ VECTORLABEL (OR (if (LISTP LINELABELS)
then (CAR LINELABELS)
else LINELABELS)
(if (type? SELARRAY NEXTVECTOR)
then (FIRSTHIDDENLEVLABEL
NEXTVECTOR]
(if (LISTP LINELABELS)
then (SETQ LINELABELS (CDR LINELABELS)))
(PROG ((ROWVECTOR (CONV.ROWSCALAR NEXTVECTOR))
SLOPE CONSTANT)
(SETQ SLOPE (GETRELT ROWVECTOR 1))
(SETQ CONSTANT (GETRELT ROWVECTOR 2))
(if (NULL CONSTANT)
then (UERROR "CONSTANT must be a number"))
(RETURN (PLOTLINE PLOT SLOPE CONSTANT VECTORLABEL
LINEWIDTH LINEMENU NODRAWFLG]])
(ADDPOINTSTOPLOT
[ULAMBDA ((PLOT PLOT)
(Y VECTOR)
(X (ONEOF NIL VECTOR))
(POINTSYMBOL (ONEOF NIL BITMAP))
(POINTLABELS (ONEOF NIL LABEL STRINGP LISTP))
(POINTMENU (ONEOF NIL LITATOM LISTP MENU))
(NODRAWFLG (MEMQ NIL T)))
(* jop: "13-Feb-86 22:52")
(* If (NULL X) then Plots vector YROW against 1->N)
(LET* [(YROW (CONV.ROWSCALAR Y))
(XROW (if (NULL X)
then (GENROW 1 (fetch NELTS of YROW))
else (CONV.ROWSCALAR X]
(if (ZEROP (fetch NELTS of YROW))
then (UERROR "Empty input sequence"))
(if (HASNILS YROW)
then (UERROR "NIL in Y vector"))
(if (HASNILS XROW)
then (UERROR "NIL in X vector"))
(if (NOT (IEQP (fetch NELTS of XROW)
(fetch NELTS of YROW)))
then (UERROR "Unequal length vectors"))
(LET* [(L (fetch NELTS of YROW))
[POSITIONS (for I to L collect (create POSITION
XCOORD ←(GETRELT XROW I)
YCOORD ←(GETRELT YROW I]
(LABELS (OR POINTLABELS (for I to L
collect (OR (GETLEVLAB Y 1 I)
(if X
then (GETLEVLAB X 1 I))
I]
(PLOTPOINTS PLOT POSITIONS LABELS POINTSYMBOL POINTMENU NODRAWFLG)))])
(ADDPOLYGONSTOPLOT
[ULAMBDA ((PLOT PLOT)
(Y (ONEOF VECTOR MATRIX))
(X (ONEOF NIL VECTOR MATRIX))
(POLYGONLABEL (ONEOF NIL LABEL STRINGP))
(POLYGONWIDTH (ONEOF NIL FIXP))
(POLYGONMENU (ONEOF NIL LITATOM LISTP MENU))
(NODRAWFLG (MEMQ T NIL)))
(* jop: "13-Feb-86 22:54")
(PROG (POLYGONOBJECTS)
(DECLARE (SPECVARS POLYGONOBJECTS))
(EAPPLY* (FUNCTION ADDPOLYGONTOPLOT)
(QUOTE (NIL VECTOR VECTOR NIL NIL NIL NIL))
PLOT Y X POLYGONLABEL POLYGONWIDTH POLYGONMENU NODRAWFLG)
(RETURN (DREVERSE POLYGONOBJECTS)))])
(ADDPOLYGONTOPLOT
[DLAMBDA ((PLOT PLOT)
(Y VECTOR)
(X (ONEOF NIL VECTOR))
(POLYGONLABEL (ONEOF NIL LABEL STRINGP))
(POLYGONWIDTH (ONEOF NIL FIXP))
(POLYGONMENU (ONEOF NIL LITATOM LISTP MENU))
(NODRAWFLG (MEMQ T NIL)))
(* jop: "13-Feb-86 23:05")
(* If (NULL X) then Plots vector Y against 1->N)
(LET* [(YROW (CONV.ROWSCALAR Y))
(XROW (if (NULL X)
then (GENROW 1 (fetch NELTS of YROW))
else (CONV.ROWSCALAR X]
(if (HASNILS YROW)
then (UERROR "NIL in Y vector"))
(if (HASNILS XROW)
then (UERROR "NIL in X vector"))
(if (NOT (IEQP (fetch NELTS of XROW)
(fetch NELTS of YROW)))
then (UERROR "Unequal length vectors"))
(push POLYGONOBJECTS (LET* ((L (fetch NELTS of YROW))
(YLAB (if (type? SELARRAY Y)
then (FIRSTHIDDENLEVLABEL Y)
else (GETDIMLAB Y 1)))
[XLAB (if X
then (if (type? SELARRAY X)
then (FIRSTHIDDENLEVLABEL X)
else (GETDIMLAB X 1]
[POSITIONS (for I to L collect (create POSITION
XCOORD ←(
GETRELT
XROW I)
YCOORD ←(
GETRELT
YROW I]
(LABEL (OR POLYGONLABEL YLAB XLAB)))
(PLOTPOLYGON PLOT POSITIONS LABEL POLYGONWIDTH POLYGONMENU
NODRAWFLG)))
NIL)])
(BARPLOT
[ULAMBDA ((BATCH VECTOR)
SHADE)
(* edited: " 1-Jun-86 14:05")
(* *)
(RESETLST (RESETSAVE (SETCURSOR WAITINGCURSOR)
(LIST (FUNCTION SETCURSOR)
DEFAULTCURSOR))
(LET* [(BARPLOT (CREATEPLOT))
(N (GETRELT (fetch SHAPE of BATCH)
1))
(XLABEL (CONCAT "ARRAY " (SERIALNUMBER BATCH)))
(YLABEL (if (type? SELARRAY BATCH)
then (FIRSTHIDDENLEVLABEL BATCH)))
(PTITLE (CONCAT "Barplot of " XLABEL))
(BARMENUITEMS (LIST (LIST (QUOTE Label)
(FUNCTION BARPLOT.CHANGELABEL)
"Change label for this bar"]
(PLOTPROP BARPLOT (QUOTE N)
N)
(PLOTPROP BARPLOT (QUOTE SHADE)
(OR SHADE SHADE3))
(PLOTPROP BARPLOT (QUOTE BATCH)
BATCH)
(PLOTTICS BARPLOT (QUOTE BOTTOM)
T T)
(PLOTTICS BARPLOT (QUOTE LEFT)
T T)
(PLOTLABEL BARPLOT (QUOTE BOTTOM)
XLABEL T)
(PLOTLABEL BARPLOT (QUOTE LEFT)
YLABEL T)
(PLOTLABEL BARPLOT (QUOTE TOP)
PTITLE T)
(PLOTTICMETHOD BARPLOT (QUOTE BOTTOM)
(FUNCTION BARPLOT.TICFN)
T)
(PLOTMENUITEMS BARPLOT (QUOTE BARMENU)
BARMENUITEMS)
(BARPLOT.DRAW BARPLOT)
BARPLOT))])
(BARPLOT.CHANGELABEL
[DLAMBDA ((BOX FILLEDRECTANGLEOBJECT)
(BARPLOT PLOT))
(* edited: " 1-Jun-86 13:49")
(* *)
(LET* ((LABEL (PLOTOBJECTPROP BOX (QUOTE OBJECTLABEL)))
(PLOTPROMPT (fetch (PLOT PLOTPROMPTWINDOW) of BARPLOT)))
(TERPRI PLOTPROMPT)
[SETQ LABEL (PROMPTFORWORD "Type a new label: " LABEL "Type a label" PLOTPROMPT NIL NIL
(CHARCODE (EOL LF ESCAPE TAB]
(if LABEL
then (PLOTOBJECTPROP BOX (QUOTE OBJECTLABEL)
LABEL)
(REDRAWPLOTWINDOW BARPLOT)))])
(BARPLOT.DRAW
[DLAMBDA ((BARPLOT PLOT))
(* edited: " 1-Jun-86 14:01")
(* *)
(LET* [(SHADE (PLOTPROP BARPLOT (QUOTE SHADE)))
(N (PLOTPROP BARPLOT (QUOTE N)))
(BATCH (PLOTPROP BARPLOT (QUOTE BATCH]
(bind RECTANGLE for I from 1 to N as LOWMARK from .1 by 1.0
do (SETQ RECTANGLE (PLOTFILLEDRECTANGLE BARPLOT LOWMARK 0 .8
(GETAELT BATCH (AELTPTR1 BATCH I))
(OR (GETLEVLAB BATCH 1 I)
I)
SHADE NIL (QUOTE BARMENU)
T))
(PLOTOBJECTPROP RECTANGLE (QUOTE BOXLEFT)
LOWMARK)
(PLOTOBJECTPROP RECTANGLE (QUOTE BOXRIGHT)
(FPLUS LOWMARK .8)))
(RESCALEPLOT BARPLOT (QUOTE BOTH)
T)
(REDRAWPLOTWINDOW BARPLOT))])
(BARPLOT.TICFN
[DLAMBDA ((MARGIN LITATOM)
(PLOTSCALE PLOTSCALE)
(BARPLOT PLOT))
(* edited: " 1-Jun-86 13:41")
(* * comment)
[for BOX in (PLOTPROP BARPLOT (QUOTE PLOTOBJECTS)) when (PLOTOBJECTSUBTYPE?
FILLEDRECTANGLE BOX)
collect (CONS (FQUOTIENT (FPLUS (PLOTOBJECTPROP BOX (QUOTE BOXRIGHT))
(PLOTOBJECTPROP BOX (QUOTE BOXLEFT)))
2)
(PLOTOBJECTPROP BOX (QUOTE OBJECTLABEL]])
(BOXPLOTS
[LAMBDA BATCHES (* jop: " 2-Apr-86 16:16")
(* * Made NO SPREAD to accomodate batches of unequal size)
(if [for I from 1 to BATCHES thereis (NOT (type? VECTOR (ARG BATCHES I]
then (HELP "All arguments must be VECTORS"))
(RESETLST (RESETSAVE (SETCURSOR WAITINGCURSOR)
(LIST (FUNCTION SETCURSOR)
DEFAULTCURSOR))
(LET* ((BOXPLOT (CREATEPLOT))
(BOXMENU (LIST (LIST (QUOTE Summary)
(FUNCTION BOXPLOT.SUMMARY)
"Printout quantile summary for this batch"
(LIST (QUOTE SUBITEMS)
(LIST (QUOTE Long)
(LIST (FUNCTION BOXPLOT.SUMMARY)
T)
"Long summary outout")
(LIST (QUOTE Short)
(FUNCTION BOXPLOT.SUMMARY)
"Short summary output")))
(LIST (QUOTE Label)
(FUNCTION BOXPLOT.LABEL)
"Change label for this batch")
(LIST (QUOTE Histogram)
(FUNCTION BOXPLOT.HISTOGRAM)
"Generate a histogram for this batch")
(LIST (QUOTE Move)
(FUNCTION BOXPLOT.MOVE)
"Move boxplot")
(LIST (QUOTE Delete)
(FUNCTION BOXPLOT.DELETE)
"Delete boxplot from batch")))
(XLABEL "Batches")
(PTITLE "Boxplots")
BOXES)
(PLOTMENUITEMS BOXPLOT (QUOTE BOXMENU)
BOXMENU)
(PLOTTICMETHOD BOXPLOT (QUOTE BOTTOM)
(QUOTE BOXPLOT.COMPUTETICS)
T)
(PLOTTICMETHOD BOXPLOT (QUOTE TOP)
(QUOTE BOXPLOT.COMPUTETICS)
T)
(PLOTTICS BOXPLOT (QUOTE BOTTOM)
T T)
(PLOTTICS BOXPLOT (QUOTE LEFT)
T T)
(PLOTLABEL BOXPLOT (QUOTE BOTTOM)
XLABEL T)
(PLOTLABEL BOXPLOT (QUOTE TOP)
PTITLE T)
(SETQ BOXES (bind (BOXLEFT ← .2)
(BOXRIGHT ← .8)
BOX for I from 1 to BATCHES
collect (SETQ BOX (BOXPLOT.MAKEBOX (ARG BATCHES I)
BOXLEFT BOXRIGHT
(CONCAT "BATCH " I))
)
(SETQ BOXLEFT (PLUS BOXLEFT 1))
(SETQ BOXRIGHT (PLUS BOXRIGHT 1))
BOX))
(for BOX in BOXES do (ADDPLOTOBJECT BOX BOXPLOT T))
(REDRAWPLOTWINDOW BOXPLOT)
BOXPLOT])
(BOXPLOT.COMPAREFN
[LAMBDA (BOX1 BOX2) (* jop: "13-Feb-86 18:31")
(* T if BOX1 is "less" then BOX2)
(LESSP (PLOTOBJECTPROP BOX1 (QUOTE BOXLEFT))
(PLOTOBJECTPROP BOX2 (QUOTE BOXLEFT])
(BOXPLOT.COMPUTETICS
[DLAMBDA ((MARGIN LITATOM)
(PLOTSCALE PLOTSCALE)
(BOXPLOT PLOT))
(* edited: " 2-Apr-86 23:45")
(* * comment)
[for BOX in (PLOTPROP BOXPLOT (QUOTE PLOTOBJECTS)) when (AND (PLOTOBJECTSUBTYPE?
COMPOUND BOX)
(EQ (COMPOUNDSUBTYPE
BOX)
(QUOTE BOX)))
collect (CONS (FQUOTIENT (FPLUS (PLOTOBJECTPROP BOX (QUOTE BOXRIGHT))
(PLOTOBJECTPROP BOX (QUOTE BOXLEFT)))
2)
(PLOTOBJECTPROP BOX (QUOTE OBJECTLABEL]])
(BOXPLOT.DELETE
[DLAMBDA ((BOX COMPOUNDOBJECT)
(BOXPLOT PLOT))
(* edited: " 2-Apr-86 23:45")
(PROG ((BOXES (for OBJECT in (PLOTPROP BOXPLOT (QUOTE PLOTOBJECTS))
when (AND (PLOTOBJECTSUBTYPE? COMPOUND OBJECT)
(EQ (COMPOUNDSUBTYPE OBJECT)
(QUOTE BOX)))
collect OBJECT)))
[SETQ BOXES (DREMOVE BOX (SORT BOXES (FUNCTION BOXPLOT.COMPAREFN]
(* DELETE BOX from display list of BOXPLOT)
(first (DELETEPLOTOBJECT BOX BOXPLOT T T) for POINT
in (APPEND (PLOTOBJECTPROP BOX (QUOTE LOWEROUTSIDE))
(PLOTOBJECTPROP BOX (QUOTE UPPEROUTSIDE)))
do (DELETEPLOTOBJECT POINT BOXPLOT T T))
(bind (LEFTCOUNTER ← .2)
DX for BOXOBJECT in BOXES
do (if [NOT (EQP LEFTCOUNTER (PLOTOBJECTPROP BOXOBJECT (QUOTE BOXLEFT]
then [SETQ DX (DIFFERENCE LEFTCOUNTER (PLOTOBJECTPROP BOXOBJECT
(QUOTE
BOXLEFT]
(TRANSLATEPLOTOBJECT BOXOBJECT DX 0.0 BOXPLOT T)
(for POINT in (PLOTOBJECTPROP BOXOBJECT (QUOTE LOWEROUTSIDE))
do (TRANSLATEPLOTOBJECT POINT DX 0.0 BOXPLOT T))
(for POINT in (PLOTOBJECTPROP BOXOBJECT (QUOTE UPPEROUTSIDE))
do (TRANSLATEPLOTOBJECT POINT DX 0.0 BOXPLOT T))
(PLOTOBJECTPROP BOXOBJECT (QUOTE BOXLEFT)
LEFTCOUNTER)
(PLOTOBJECTPROP BOXOBJECT (QUOTE BOXRIGHT)
(PLUS LEFTCOUNTER .6)))
(fadd LEFTCOUNTER 1.0))
(RESCALEPLOT BOXPLOT (QUOTE X)
T)
(REDRAWPLOTWINDOW BOXPLOT))])
(BOXPLOT.LABEL
[DLAMBDA ((BOX COMPOUNDOBJECT)
(BOXPLOT PLOT))
(* edited: "16-Feb-86 17:54")
(LET* ((LABEL (PLOTOBJECTPROP BOX (QUOTE OBJECTLABEL)))
(PLOTPROMPT (fetch PLOTPROMPTWINDOW of BOXPLOT)))
(TERPRI PLOTPROMPT)
[SETQ LABEL (PROMPTFORWORD "Type a new label: " LABEL "Type a label" PLOTPROMPT NIL NIL
(CHARCODE (EOL LF ESCAPE TAB]
(if LABEL
then (PLOTOBJECTPROP BOX (QUOTE OBJECTLABEL)
LABEL)
(REDRAWPLOTWINDOW BOXPLOT)))])
(BOXPLOT.MOVE
[DLAMBDA ((BOX COMPOUNDOBJECT)
(BOXPLOT PLOT))
(* edited: " 2-Apr-86 23:46")
(* *)
(PROG ((FIRSTBOX BOX)
(BOXES (for OBJECT in (PLOTPROP BOXPLOT (QUOTE PLOTOBJECTS))
when (AND (PLOTOBJECTSUBTYPE? COMPOUND OBJECT)
(EQ (COMPOUNDSUBTYPE OBJECT)
(QUOTE BOX)))
collect OBJECT))
NEWXPOSITION SECONDBOX SENSELEFT SWAPPEDBOXES)
(SORT BOXES (FUNCTION BOXPLOT.COMPAREFN))
(PLOTPROMPT "Select a new position" BOXPLOT)
(SETQ NEWXPOSITION (STREAMTOWORLDX (fetch XCOORD of (GETPOSITION (fetch
PLOTWINDOW
of BOXPLOT))
)
(fetch PLOTWINDOWVIEWPORT of BOXPLOT)))
[SETQ SECONDBOX (OR (for BOXOBJ in BOXES thereis (GEQ (PLOTOBJECTPROP
BOXOBJ
(QUOTE BOXRIGHT))
NEWXPOSITION))
(CAR (LAST BOXES]
(if (NEQ FIRSTBOX SECONDBOX)
then (SETQ SENSELEFT (LESSP NEWXPOSITION (FQUOTIENT
(FPLUS (PLOTOBJECTPROP SECONDBOX
(QUOTE BOXRIGHT))
(PLOTOBJECTPROP SECONDBOX
(QUOTE BOXLEFT)))
2)))
[SETQ SWAPPEDBOXES (LET* ([FIRSTLEFTOFSECOND (LESSP (PLOTOBJECTPROP
FIRSTBOX
(QUOTE BOXLEFT))
(PLOTOBJECTPROP
SECONDBOX
(QUOTE BOXLEFT]
(LESSPAIR (if FIRSTLEFTOFSECOND
then FIRSTBOX
else SECONDBOX))
(GREATERPAIR (if FIRSTLEFTOFSECOND
then SECONDBOX
else FIRSTBOX))
(FIRSTPART (for BOXOBJ in BOXES
while (LESSP
(PLOTOBJECTPROP
BOXOBJ
(QUOTE BOXLEFT))
(PLOTOBJECTPROP
LESSPAIR
(QUOTE BOXLEFT)))
collect BOXOBJ))
(SECONDPART (for BOXOBJ
in (CDR (MEMB LESSPAIR BOXES))
while (LESSP
(PLOTOBJECTPROP
BOXOBJ
(QUOTE BOXLEFT))
(PLOTOBJECTPROP
GREATERPAIR
(QUOTE BOXLEFT)))
collect BOXOBJ))
(THIRDPART (for BOXOBJ
in (CDR (MEMB GREATERPAIR
BOXES))
collect BOXOBJ)))
(if FIRSTLEFTOFSECOND
then (APPEND FIRSTPART SECONDPART
(if SENSELEFT
then (LIST FIRSTBOX
SECONDBOX)
else (LIST SECONDBOX
FIRSTBOX))
THIRDPART)
else (APPEND FIRSTPART
(if SENSELEFT
then (LIST FIRSTBOX
SECONDBOX)
else (LIST SECONDBOX
FIRSTBOX))
SECONDPART THIRDPART]
(bind (LEFTCOUNTER ← .2)
DX for BOXOBJ in SWAPPEDBOXES
do (if [NOT (EQP LEFTCOUNTER (PLOTOBJECTPROP BOXOBJ (QUOTE
BOXLEFT]
then [SETQ DX (DIFFERENCE LEFTCOUNTER (PLOTOBJECTPROP
BOXOBJ
(QUOTE BOXLEFT]
(TRANSLATEPLOTOBJECT BOXOBJ DX 0.0 BOXPLOT T)
(for POINT in (PLOTOBJECTPROP BOXOBJ (QUOTE
LOWEROUTSIDE))
do (TRANSLATEPLOTOBJECT POINT DX 0.0 BOXPLOT T))
(for POINT in (PLOTOBJECTPROP BOXOBJ (QUOTE
UPPEROUTSIDE))
do (TRANSLATEPLOTOBJECT POINT DX 0.0 BOXPLOT T))
(PLOTOBJECTPROP BOXOBJ (QUOTE BOXLEFT)
LEFTCOUNTER)
(PLOTOBJECTPROP BOXOBJ (QUOTE BOXRIGHT)
(PLUS LEFTCOUNTER .6)))
(fadd LEFTCOUNTER 1.0))
(REDRAWPLOTWINDOW BOXPLOT)))])
(BOXPLOT.WHENADDEDFN
[LAMBDA (BOX PLOT NODRAWFLG) (* jop: " 2-Apr-86 16:16")
(* *)
(PROG [(LOWEROUTSIDE (PLOTOBJECTPROP BOX (QUOTE LOWEROUTSIDE)))
(UPPEROUTSIDE (PLOTOBJECTPROP BOX (QUOTE UPPEROUTSIDE]
(for POINT in LOWEROUTSIDE do (ADDPLOTOBJECT POINT PLOT NODRAWFLG))
(for POINT in UPPEROUTSIDE do (ADDPLOTOBJECT POINT PLOT NODRAWFLG])
(BOXPLOT.WHENDELETEDFN
[LAMBDA (BOX PLOT NODRAWFLG) (* jop: " 2-Apr-86 16:18")
(* *)
(PROG [(LOWEROUTSIDE (PLOTOBJECTPROP BOX (QUOTE LOWEROUTSIDE)))
(UPPEROUTSIDE (PLOTOBJECTPROP BOX (QUOTE UPPEROUTSIDE]
(for POINT in LOWEROUTSIDE do (DELETEPLOTOBJECT POINT PLOT NODRAWFLG T))
(for POINT in UPPEROUTSIDE do (DELETEPLOTOBJECT POINT PLOT NODRAWFLG T])
(BOXPLOT.HISTOGRAM
[DLAMBDA ((BOX COMPOUNDOBJECT)
(BOXPLOT PLOT))
(* jop: "13-Feb-86 18:11")
(HISTOGRAM (PLOTOBJECTPROP BOX (QUOTE BATCH)))])
(BOXPLOT.MAKEBOX
[DLAMBDA ((BATCH VECTOR)
(BOXLEFT FLOATP)
(BOXRIGHT FLOATP)
(DEFAULTLABEL (ONEOF NIL ATOM STRINGP))
(RBATCH (ONEOF NIL ROWSCALAR))
(OBATCH (ONEOF NIL ROWINT)))
(* jop: "13-Feb-86 22:24")
(* *)
(if (OR (NULL RBATCH)
(NULL OBATCH))
then (SETQ RBATCH (CONV.ROWSCALAR BATCH))
(SETQ OBATCH (ORDERROW RBATCH)))
(LET* ((LETTERVALUES (GETLETTERVALUES RBATCH OBATCH))
(N (fetch N of LETTERVALUES))
(BOXMIDDLE (FQUOTIENT (PLUS BOXLEFT BOXRIGHT)
2))
[LINNERFENCE (FDIFFERENCE (fetch LOWERFOURTH of LETTERVALUES)
(TIMES 1.5 (fetch FOURTHSPREAD of LETTERVALUES]
[UINNERFENCE (FPLUS (fetch UPPERFOURTH of LETTERVALUES)
(TIMES 1.5 (fetch FOURTHSPREAD of LETTERVALUES]
[LADJACENT (for I from (PLOT.CEILING (fetch FOURTHDEPTH of LETTERVALUES))
to 1 by -1 until (LESSP (GETRELT RBATCH (GETRELT OBATCH I))
LINNERFENCE)
finally (RETURN (ADD1 I]
[UADJACENT (for I from [PLOT.FLOOR (PLUS 1 (DIFFERENCE N (fetch FOURTHDEPTH
of LETTERVALUES]
to N until (GREATERP (GETRELT RBATCH (GETRELT OBATCH I))
UINNERFENCE)
finally (RETURN (SUB1 I]
[LABEL (OR (if (type? SELARRAY BATCH)
then (FIRSTHIDDENLEVLABEL BATCH))
DEFAULTLABEL
(CONCAT "Array " (SERIALNUMBER BATCH]
(BOXOBJECT (MAKEBOXOBJECT BOXLEFT BOXRIGHT (GETRELT RBATCH (GETRELT OBATCH LADJACENT)
)
(GETRELT RBATCH (GETRELT OBATCH UADJACENT))
LETTERVALUES LABEL)))
(PLOTOBJECTPROP BOXOBJECT (QUOTE BATCH)
BATCH)
(PLOTOBJECTPROP BOXOBJECT (QUOTE BOXLEFT)
BOXLEFT)
(PLOTOBJECTPROP BOXOBJECT (QUOTE BOXRIGHT)
BOXRIGHT)
(PLOTOBJECTPROP BOXOBJECT (QUOTE LETTERVALUES)
LETTERVALUES)
(PLOTOBJECTPROP BOXOBJECT (QUOTE LADJACENT)
(GETRELT RBATCH (GETRELT OBATCH LADJACENT)))
(PLOTOBJECTPROP BOXOBJECT (QUOTE UADJACENT)
(GETRELT RBATCH (GETRELT OBATCH UADJACENT)))
[PLOTOBJECTPROP BOXOBJECT (QUOTE LOWEROUTSIDE)
(for I from (SUB1 LADJACENT) to 1 by -1
collect (CREATEPOINT (create POSITION
XCOORD ← BOXMIDDLE
YCOORD ←(GETRELT RBATCH
(GETRELT
OBATCH I)))
(OR (GETLEVLAB BATCH 1 (GETRELT OBATCH
I))
(GETRELT OBATCH I]
[PLOTOBJECTPROP BOXOBJECT (QUOTE UPPEROUTSIDE)
(bind POINT for I from (ADD1 UADJACENT) to N
collect (CREATEPOINT (create POSITION
XCOORD ← BOXMIDDLE
YCOORD ←(GETRELT RBATCH
(GETRELT
OBATCH I)))
(OR (GETLEVLAB BATCH 1 (GETRELT OBATCH
I))
(GETRELT OBATCH I]
(PLOTOBJECTPROP BOXOBJECT (QUOTE COPYFN)
(FUNCTION COPYBOXPLOT))
(PLOTOBJECTPROP BOXOBJECT (QUOTE WHENADDEDFN)
(FUNCTION BOXPLOT.WHENADDEDFN))
(PLOTOBJECTPROP BOXOBJECT (QUOTE WHENDELETEDFN)
(FUNCTION BOXPLOT.WHENDELETEDFN))
BOXOBJECT)])
(BOXPLOT.SUMMARY
[DLAMBDA ((OBJECT COMPOUNDOBJECT)
(BOXPLOT PLOT)
(LONGFLG (MEMQ T NIL)))
(* jop: "13-Feb-86 17:58")
(SUMMARYWINDOW.PRINT BOXPLOT (LIST (CONCAT "Batch " (PLOTOBJECTPROP OBJECT (QUOTE
OBJECTLABEL)))
(LIST (FUNCTION LETTER.VALUE.DISPLAY)
(PLOTOBJECTPROP OBJECT (QUOTE LETTERVALUES))
LONGFLG)))])
(COPYBOXPLOT
[DLAMBDA ((NEWBOX COMPOUNDOBJECT)
(OLDBOX COMPOUNDOBJECT)
(BOXPLOT PLOT)
(PROPNAME LITATOM))
(* jop: "13-Feb-86 22:29")
(* * Copies the prop list of OLDBOX to NEWBOX)
(SELECTQ PROPNAME
(BATCH (PLOTOBJECTPROP OLDBOX (QUOTE BATCH)))
(LETTERVALUES (PLOTOBJECTPROP OLDBOX (QUOTE LETTERVALUES)))
NIL)])
(COPYHISTOGRAM
[DLAMBDA ((NEWHIST PLOT)
(OLDHIST PLOT)
(PROPNAME LITATOM))
(* jop: "13-Feb-86 22:21")
(* * Copies the prop PROPNAME of OLDHIST to NEWHIST)
(SELECTQ PROPNAME
(N (PLOTPROP OLDHIST (QUOTE N)))
(NBINS (PLOTPROP OLDHIST (QUOTE NBINS)))
(BATCH (* OK to share the original array)
(PLOTPROP OLDHIST (QUOTE BATCH)))
(RBATCH (PLOTPROP OLDHIST (QUOTE RBATCH)))
(OBATCH (PLOTPROP OLDHIST (QUOTE OBATCH)))
(LETTERVALUES (PLOTPROP OLDHIST (QUOTE LETTERVALUES)))
(BININTERVAL (PLOTPROP OLDHIST (QUOTE BININTERVAL)))
(BINEDNUMBERS (PLOTPROP OLDHIST (QUOTE BINEDNUMBERS)))
(MARKS (PLOTPROP OLDHIST (QUOTE MARKS)))
(QUANTILEDISPLAY (PLOTPROP OLDHIST (QUOTE QUANTILEDISPLAY)))
NIL)])
(COPYSCATTERPLOT
[DLAMBDA ((NEWSCATTERPLOT PLOT)
(OLDSCATTERPLOT PLOT)
(PROPNAME LITATOM))
(* jop: " 2-Sep-85 13:59")
(* * Copies the prop list of OLDSCATTERPLOT to NEWSCATTERPLOT)
(SELECTQ PROPNAME
[REGRESSLINE (LET [(OLDREGRESS (PLOTPROP OLDSCATTERPLOT (QUOTE REGRESSLINE]
(if OLDREGRESS
then (for NEWOBJECT in (fetch PLOTOBJECTS of NEWSCATTERPLOT)
as OLDOBJECT in (fetch PLOTOBJECTS of OLDSCATTERPLOT)
thereis (EQ OLDREGRESS OLDOBJECT]
NIL)])
(FIRSTHIDDENLEVLABEL
[DLAMBDA ((A SELARRAY)
(RETURNS LABEL))
(* jop: "11-Mar-85 14:43")
(* * Picks out first non-integer hiddenlevellabel from the list returned by GETHIDDENLEVELLABELS)
(* jop: "25-Feb-85 14:33")
(DPROG ((PAIRS (GETHIDDENLEVLABELS A) LST)
(LAB NIL LABEL)
(RETURNS LABEL))
[for P in PAIRS until (if (LITATOM (CDR P))
then (SETQ LAB (CDR P]
(RETURN LAB))])
(FLIPBOX
[LAMBDA (BOX) (* edited: " 2-Apr-86 23:47")
(* * DESTRUCTIVELY FLIPS X and Y coordinates of BOX)
(bind OBJECTDATA for OBJECT in (fetch COMPONENTS of (fetch OBJECTDATA of BOX))
do (SETQ OBJECTDATA (fetch OBJECTDATA of OBJECT))
(bind X for POINT in (if (PLOTOBJECTSUBTYPE? CURVE OBJECT)
then (fetch CURVEPOINTS of OBJECTDATA)
else (fetch POLYGONPOINTS of OBJECTDATA))
do (SETQ X (fetch XCOORD of POINT))
(replace XCOORD of POINT with (fetch YCOORD of POINT))
(replace YCOORD of POINT with X)))
(bind X POSITION for POINT in (APPEND (PLOTOBJECTPROP BOX (QUOTE LOWEROUTSIDE))
(PLOTOBJECTPROP BOX (QUOTE UPPEROUTSIDE)))
do (SETQ POSITION (fetch POINTPOSITION of (fetch OBJECTDATA of POINT)))
(SETQ X (fetch XCOORD of POSITION))
(replace XCOORD of POSITION with (fetch YCOORD of POSITION))
(replace YCOORD of POSITION with X)) (* Do surgury on the object prop list to remove
unneeded props)
(bind (PROPLST ←(fetch (PLOTOBJECT OBJECTUSERDATA) of BOX))
PTR PROPNAME PROPVALUE for PROP in (QUOTE (BATCH BOXLEFT BOXRIGHT LETTERVALUES))
do (SETQ PTR (MEMB PROP PROPLST))
(if PTR
then (SETQ PROPNAME (CAR PTR))
(SETQ PROPVALUE (CADR PTR))
(DREMOVE PROPNAME PROPLST)
(DREMOVE PROPVALUE PROPLST)))
BOX])
(GETHIDDENLEVLABELS
[DLAMBDA ((A SELARRAY)
(RETURNS LST))
(* jop: "25-Feb-85 13:54" posted: " 1-DEC-78 16:48")
(* * Looks for integer selections on the base array and returns a list of pairs (dim . lev), where dim and/or lev
may be labels or integers)
(DPROG ((AB (fetch BASEARRAY of A) SIMARRAY)
(TT (fetch TTAB of A) ROWPTR)
(TTE NIL TTELT)
(PAIRS NIL LST)
(RETURNS LST))
[for I to (fetch NELTS of TT)
do (SETQ TTE (GETRELT TT I))
(if (EQ (TTELTTYPE TTE)
(QUOTE INTEGER))
then (SETQ PAIRS (CONS (CONS (OR (GETDIMLAB AB I)
I)
(OR (GETLEVLAB AB I TTE)
TTE))
PAIRS]
(RETURN PAIRS))])
(GETLETTERVALUES
[DLAMBDA ((BATCH ROWSCALAR)
(ORDEREDBATCH (ONEOF NIL ROWINT))
(RETURNS LETTERVALUES))
(* jop: "13-Apr-85 20:22")
(* * COMPUTE the Median, Hinges, Eigths, and Extremes of BATCH)
(if (NULL ORDEREDBATCH)
then (SETQ ORDEREDBATCH (ORDERROW BATCH)))
(DPROG ((N (fetch NELTS of BATCH) FIXP)
THEN (DEPTH (FQUOTIENT (ADD1 N)
2) FLOATP)
(LETTERVALUES (create LETTERVALUES
N ← N) LETTERVALUES))
[bind UPPERCODE LOWERCODE CODEDEPTH
first (replace MEDIAN of LETTERVALUES with (GETVALUEATDEPTH BATCH ORDEREDBATCH DEPTH))
(replace MEDIANDEPTH of LETTERVALUES with DEPTH)
for CODE in (QUOTE (FOURTH EIGHTH))
do (SETQ DEPTH (FQUOTIENT (ADD1 (FIX DEPTH))
2))
(SETQ UPPERCODE (PACK* (QUOTE UPPER)
CODE))
(SETQ LOWERCODE (PACK* (QUOTE LOWER)
CODE))
(SETQ CODEDEPTH (PACK* CODE (QUOTE DEPTH)))
(RECORDACCESS LOWERCODE LETTERVALUES NIL (QUOTE REPLACE)
(GETVALUEATDEPTH BATCH ORDEREDBATCH DEPTH))
[RECORDACCESS UPPERCODE LETTERVALUES NIL (QUOTE REPLACE)
(GETVALUEATDEPTH BATCH ORDEREDBATCH (PLUS 1 (FDIFFERENCE N (FIX DEPTH]
(RECORDACCESS CODEDEPTH LETTERVALUES NIL (QUOTE REPLACE)
DEPTH)
finally (replace LOWEREXTREME of LETTERVALUES with (GETRELT BATCH (GETRELT ORDEREDBATCH 1)
))
(replace UPPEREXTREME of LETTERVALUES with (GETRELT BATCH (GETRELT ORDEREDBATCH N]
(RETURN LETTERVALUES))])
(GETSUMMARYWINDOW
[DLAMBDA ((CHARHEIGHT FIXP)
(RETURNS WINDOW))
(* jop: "13-Feb-86 16:32")
(* * RETURNS a summary window CHARHEIGHT characters (in GACHA 10) high)
(PROG ((SUMMARYWINDOW (DECODE.WINDOW.ARG (create POSITION
XCOORD ← 0
YCOORD ← 0)
100
(ITIMES CHARHEIGHT (FONTPROP
(QUOTE (GACHA 10))
(QUOTE HEIGHT)))
"SUMMARY WINDOW" NIL T)))
(WINDOWADDPROP SUMMARYWINDOW (QUOTE REPAINTFN)
(FUNCTION SUMMARY.REPAINTFN))
(WINDOWADDPROP SUMMARYWINDOW (QUOTE RESHAPEFN)
(FUNCTION SUMMARY.RESHAPEFN))
(WINDOWPROP SUMMARYWINDOW (QUOTE SCROLLFN)
(FUNCTION SCROLLBYREPAINTFN))
[WINDOWPROP SUMMARYWINDOW (QUOTE MINSIZE)
(CONS 0 (fetch HEIGHT of (WINDOWPROP SUMMARYWINDOW (QUOTE REGION]
[WINDOWPROP SUMMARYWINDOW (QUOTE MAXSIZE)
(CONS MAX.SMALLP (fetch HEIGHT of (WINDOWPROP SUMMARYWINDOW
(QUOTE REGION]
(RETURN SUMMARYWINDOW))])
(GETVALUEATDEPTH
[DLAMBDA ((ROW ROWSCALAR)
(ORDEREDROW ROWINT)
(DEPTH FLOATP)
(RETURNS SCALAR))
(* jop: "23-Sep-85 15:24")
(if (EQP (PLOT.FLOOR DEPTH)
DEPTH)
then (GETRELT ROW (GETRELT ORDEREDROW (FIX DEPTH)))
else (FQUOTIENT [PLUS (GETRELT ROW (GETRELT ORDEREDROW (PLOT.FLOOR DEPTH)))
(GETRELT ROW (GETRELT ORDEREDROW (PLOT.CEILING DEPTH]
2))])
(HISTOGRAM
[ULAMBDA ((BATCH VECTOR)
(NBINS (ONEOF NIL FIXP))
SHADE)
(* jop: " 2-Apr-86 22:24")
(RESETLST (RESETSAVE (SETCURSOR WAITINGCURSOR)
(LIST (FUNCTION SETCURSOR)
DEFAULTCURSOR))
(LET* ((HISTOGRAM (CREATEPLOT))
(BINMENU (LIST (LIST (QUOTE Values)
(FUNCTION HISTOGRAM.VALUES)
"Output values in bin")))
(RIGHTMENUITEMS (LIST (LIST (QUOTE Change% bins)
(FUNCTION HISTOGRAM.CHANGEBINS)
"Change number of bins"
(LIST (QUOTE SUBITEMS)
(LIST (QUOTE Reset)
(LIST
(FUNCTION HISTOGRAM.RESET)
T)
"Reset range and bin interval to original value")))
(LIST (QUOTE Summary)
(FUNCTION HISTOGRAM.SUMMARY)
"Attach quantile summary"
(LIST (QUOTE SUBITEMS)
(LIST (QUOTE Long)
(LIST
(FUNCTION
HISTOGRAM.SUMMARY)
T)
"Long summary")
(LIST (QUOTE Short)
(FUNCTION HISTOGRAM.SUMMARY)
"Short summary")))
(LIST (QUOTE Display% quantiles)
(FUNCTION HISTOGRAM.DISPLAYQUANTILES)
"Overlay graph of some quantiles")))
(N (GETRELT (fetch SHAPE of BATCH)
1))
(INTFLG (EQ (QUOTE INTEGER)
(AELTTYPE BATCH)))
(RBATCH (CONV.ROWSCALAR BATCH))
(OBATCH (if (HASNILS RBATCH)
then (UERROR "Batch has missing values")
else (ORDERROW RBATCH)))
[XLABEL (if (type? SELARRAY BATCH)
then (FIRSTHIDDENLEVLABEL BATCH)
else (CONCAT "ARRAY " (SERIALNUMBER BATCH]
(YLABEL "Frequency")
(PTITLE (CONCAT "Histogram of " XLABEL)))
[if (NULL NBINS)
then (SETQ NBINS (if (LESSP N 20)
then (FIX (TIMES 2 (SQRT N)))
else (FIX (TIMES 10 (PLOT.LOG10 N]
(if (NULL SHADE)
then (SETQ SHADE SHADE3))
(PLOTPROP HISTOGRAM (QUOTE N)
N)
(PLOTPROP HISTOGRAM (QUOTE NBINS)
NBINS)
(PLOTPROP HISTOGRAM (QUOTE INTFLG)
INTFLG)
(PLOTPROP HISTOGRAM (QUOTE SHADE)
(OR SHADE SHADE3))
(PLOTPROP HISTOGRAM (QUOTE BATCH)
BATCH)
(PLOTPROP HISTOGRAM (QUOTE RBATCH)
RBATCH)
(PLOTPROP HISTOGRAM (QUOTE OBATCH)
OBATCH)
(PLOTPROP HISTOGRAM (QUOTE LETTERVALUES)
(GETLETTERVALUES RBATCH OBATCH))
(* Bin the BATCH)
(PLOTTICS HISTOGRAM (QUOTE BOTTOM)
T T)
(PLOTTICS HISTOGRAM (QUOTE LEFT)
T T)
(PLOTLABEL HISTOGRAM (QUOTE BOTTOM)
XLABEL T)
(PLOTLABEL HISTOGRAM (QUOTE LEFT)
YLABEL T)
(PLOTLABEL HISTOGRAM (QUOTE TOP)
PTITLE T)
(PLOTADDMENUITEMS HISTOGRAM (QUOTE RIGHT)
RIGHTMENUITEMS)
(PLOTMENUITEMS HISTOGRAM (QUOTE BINMENU)
BINMENU)
(if INTFLG
then (PLOTTICFN HISTOGRAM (QUOTE X)
(FUNCTION HISTOGRAM.INTTICFN)
T)
(PLOTSCALEFN HISTOGRAM (QUOTE X)
(FUNCTION HISTOGRAM.INTSCALEFN)
T)
else (PLOTTICFN HISTOGRAM (QUOTE X)
(FUNCTION HISTOGRAM.TICFN)))
(HISTOGRAM.DRAW HISTOGRAM)
(PLOTPROP HISTOGRAM (QUOTE COPYFN)
(FUNCTION COPYHISTOGRAM))
HISTOGRAM))])
(HISTOGRAM.BOXSUMMARY
[DLAMBDA ((BOX COMPOUNDOBJECT)
(HISTOGRAM PLOT))
(* jop: "13-Feb-86 22:04")
(LET* [(STRING (ALLOCSTRING 40))
(STRINGSTREAM (OPENSTRINGSTREAM STRING (QUOTE OUTPUT)))
(FFMT (QUOTE (FLOAT 10 NIL NIL NIL 3]
(PRINTOUT STRINGSTREAM "Adjacent values" .SP 1 .N FFMT (PLOTOBJECTPROP BOX (QUOTE
LADJACENT))
.N FFMT (PLOTOBJECTPROP BOX (QUOTE UADJACENT))
T)
(SUMMARYWINDOW.PRINT HISTOGRAM (LIST (LIST (FUNCTION LETTER.VALUE.DISPLAY)
(PLOTPROP HISTOGRAM (QUOTE
LETTERVALUES)))
STRING)))])
(HISTOGRAM.CHANGEBINS
[DLAMBDA ((HISTOGRAM PLOT))
(* jop: " 2-Apr-86 22:20")
(LET* ((PRMTW (fetch PLOTPROMPTWINDOW of HISTOGRAM))
(INTFLG (PLOTPROP HISTOGRAM (QUOTE INTFLG)))
(BININTERVAL (PLOTPROP HISTOGRAM (QUOTE BININTERVAL)))
(INC (fetch (HISTOGRAM.BINS BININC) of BININTERVAL))
(START (fetch (HISTOGRAM.BINS BINMIN) of BININTERVAL))
(END (fetch (HISTOGRAM.BINS BINMAX) of BININTERVAL))
NBINS)
(TERPRI PRMTW)
[SETQ START (READ (OPENSTRINGSTREAM (PROMPTFORWORD "From " START
"Type start point of bin sequence"
PRMTW)
(QUOTE INPUT]
(SETQ START (if INTFLG
then (PLOT.FLOOR START)
else (FLOAT START)))
[SETQ END (READ (OPENSTRINGSTREAM (PROMPTFORWORD " TO " END
"TYPE END POINT OF BIN SEQUENCE"
PRMTW)
(QUOTE INPUT]
(SETQ END (if INTFLG
then (PLOT.CEILING END)
else (FLOAT END)))
[SETQ INC (READ (OPENSTRINGSTREAM (PROMPTFORWORD " BY " INC "TYPE AN INCREMENT"
PRMTW)
(QUOTE INPUT]
(SETQ INC (if INTFLG
then (PLOT.CEILING INC)
else (FLOAT INC)))
(SETQ NBINS (PLOT.CEILING (FQUOTIENT (DIFFERENCE END START)
INC)))
(SETQ END (PLUS START (TIMES INC NBINS)))
(if INTFLG
then (SETQ NBINS (ADD1 NBINS)))
(PLOTPROMPT (CONCAT "Using: from " START " To " END " By " INC)
HISTOGRAM)
(RESETLST (RESETSAVE (SETCURSOR WAITINGCURSOR)
(LIST (FUNCTION SETCURSOR)
DEFAULTCURSOR))
(PLOTPROP HISTOGRAM (QUOTE BININTERVAL)
(create HISTOGRAM.BINS
BINMIN ← START
BINMAX ← END
BININC ← INC
NBINS ← NBINS))
(PLOTPROP HISTOGRAM (QUOTE NBINS)
NBINS)
(HISTOGRAM.DRAW HISTOGRAM)))])
(HISTOGRAM.COMPUTEMULT
[LAMBDA (MIN MAX INC MUTIPLE) (* jop: "25-Feb-86 12:15")
(* *)
(LET* [(NEWINC (TIMES INC MUTIPLE))
(MINMULT (PLOT.FLOOR (QUOTIENT MIN NEWINC)))
(MAXMULT (PLOT.CEILING (QUOTIENT MAX NEWINC]
(create TICINFO
TICMIN ←(TIMES MINMULT NEWINC)
TICMAX ←(TIMES MAXMULT NEWINC)
TICINC ← NEWINC
NTICS ←(ADD1 (DIFFERENCE MAXMULT MINMULT])
(HISTOGRAM.DELETEQUANTILES
[DLAMBDA ((BOX COMPOUNDOBJECT)
(HISTOGRAM PLOT)
NODRAWFLG)
(* jop: " 2-Apr-86 16:18")
(* * DELETE QUANTILE DISPLAY)
(if BOX
then (DELETEPLOTOBJECT BOX HISTOGRAM NODRAWFLG)
(PLOTPROP HISTOGRAM (QUOTE QUANTILEDISPLAY)
NIL)
(RESCALEPLOT HISTOGRAM (QUOTE Y)
NODRAWFLG))])
(HISTOGRAM.DISPLAYQUANTILES
[DLAMBDA ((HISTOGRAM PLOT)
NODRAWFLG)
(* jop: " 2-Apr-86 22:46")
(* * DISPLAY QUANTILES GRAPHICALLY)
[if (NOT (PLOTMENUITEMS HISTOGRAM (QUOTE BOXMENU)))
then (PLOTMENUITEMS HISTOGRAM (QUOTE BOXMENU)
(LIST (LIST (QUOTE Summary)
(FUNCTION HISTOGRAM.BOXSUMMARY)
"Printout summary statistics")
(LIST (QUOTE Delete)
(FUNCTION HISTOGRAM.DELETEQUANTILES)
"Delete boxplot"]
[if (NULL (PLOTPROP HISTOGRAM (QUOTE QUANTILEDISPLAY)))
then (LET* ((NBINS (PLOTPROP HISTOGRAM (QUOTE NBINS)))
(MAXHEIGHT (PLOTPROP HISTOGRAM (QUOTE MAXFREQ)))
(LINETOP (PLUS MAXHEIGHT 1.5))
(LINEBOTTOM (PLUS MAXHEIGHT .5)))
(PLOTPROP HISTOGRAM (QUOTE QUANTILEDISPLAY)
(FLIPBOX (BOXPLOT.MAKEBOX (PLOTPROP HISTOGRAM (QUOTE BATCH))
LINEBOTTOM LINETOP "Boxplot summary"
(PLOTPROP HISTOGRAM (QUOTE RBATCH))
(PLOTPROP HISTOGRAM (QUOTE OBATCH]
(ADDPLOTOBJECT (PLOTPROP HISTOGRAM (QUOTE QUANTILEDISPLAY))
HISTOGRAM NODRAWFLG)])
(HISTOGRAM.DRAW
[DLAMBDA ((HISTOGRAM PLOT))
(* edited: " 2-Apr-86 23:48")
(* *)
(LET* ((SHADE (PLOTPROP HISTOGRAM (QUOTE SHADE)))
(INTFLG (PLOTPROP HISTOGRAM (QUOTE INTFLG)))
(N (PLOTPROP HISTOGRAM (QUOTE N)))
(RBATCH (PLOTPROP HISTOGRAM (QUOTE RBATCH)))
(OBATCH (PLOTPROP HISTOGRAM (QUOTE OBATCH)))
(BININTERVAL (OR (PLOTPROP HISTOGRAM (QUOTE BININTERVAL))
(LET ((NEWINTERVAL (HISTOGRAM.MAKEBININTERVAL (GETRELT
RBATCH
(GETRELT OBATCH 1))
(GETRELT
RBATCH
(GETRELT OBATCH N))
(PLOTPROP
HISTOGRAM
(QUOTE NBINS))
INTFLG)))
(PLOTPROP HISTOGRAM (QUOTE BININTERVAL)
NEWINTERVAL)
NEWINTERVAL)))
(BINMIN (fetch (HISTOGRAM.BINS BINMIN) of BININTERVAL))
(BINMAX (fetch (HISTOGRAM.BINS BINMAX) of BININTERVAL))
(BININC (fetch (HISTOGRAM.BINS BININC) of BININTERVAL))
(NBINS (fetch (HISTOGRAM.BINS NBINS) of BININTERVAL))
(QUANTILEDISPLAY (PLOTPROP HISTOGRAM (QUOTE QUANTILEDISPLAY)))
BINS MAXFREQ) (* Erase the old image, if any)
(for OBJECT in (COPY (fetch PLOTOBJECTS of HISTOGRAM))
when (AND (PLOTOBJECTSUBTYPE? FILLEDRECTANGLE OBJECT)
(PLOTOBJECTPROP OBJECT (QUOTE FROMHISTOGRAM?)))
do (DELETEPLOTOBJECT OBJECT HISTOGRAM T T))
(if INTFLG
then (SETQ BINMIN (DIFFERENCE BINMIN .5))
(SETQ BINMAX (PLUS BINMAX .5)))
(SETQ BINS (bind (I ← 1)
FREQ for BIN from 1 to NBINS as MARK from (PLUS BINMIN
BININC)
by BININC when (NEQ (SETQ FREQ
(bind (CNT ← 0)
while (AND (ILEQ I N)
(LESSP (GETRELT
RBATCH
(GETRELT OBATCH
I))
MARK))
do (SETQ I (ADD1 I))
(SETQ CNT (ADD1 CNT))
finally (RETURN CNT)))
0)
collect (CONS MARK FREQ))) (* An optimization to speed up adding rectangles to
the plot -- extends the scale once)
[PLOTPROP HISTOGRAM (QUOTE MAXFREQ)
(SETQ MAXFREQ (CDR (for BIN in BINS largest (CDR BIN]
(ADJUSTSCALE? (create EXTENT
MINX ← BINMIN
MAXX ← BINMAX
MINY ← 0
MAXY ← MAXFREQ)
HISTOGRAM) (* Construct the new image)
(RESETLST [RESETSAVE (FLTFMT (QUOTE (FLOAT NIL NIL NIL NIL 5]
(* Round to five significant figures)
(RESETSAVE PRXFLG T)
(bind RECTANGLE LOWMARK HIGHMARK FREQ for BIN in BINS
do (SETQ HIGHMARK (CAR BIN))
(SETQ LOWMARK (DIFFERENCE HIGHMARK BININC))
(SETQ FREQ (CDR BIN))
(SETQ RECTANGLE
(PLOTFILLEDRECTANGLE HISTOGRAM LOWMARK 0 BININC FREQ
(if INTFLG
then (LET ((ILOWMARK (PLOT.CEILING
LOWMARK))
(IHIGHMARK (PLOT.FLOOR
HIGHMARK)))
(if (IEQP ILOWMARK
IHIGHMARK)
then (CONCAT FREQ
" Obs. at "
ILOWMARK)
else (CONCAT FREQ
" Obs. between "
ILOWMARK
" and "
IHIGHMARK)))
else (CONCAT FREQ " Obs. between "
LOWMARK " and " HIGHMARK))
SHADE NIL (QUOTE BINMENU)
T))
(PLOTOBJECTPROP RECTANGLE (QUOTE FROMHISTOGRAM?)
T)
(PLOTOBJECTPROP RECTANGLE (QUOTE LOWMARK)
LOWMARK)
(PLOTOBJECTPROP RECTANGLE (QUOTE HIGHMARK)
HIGHMARK)))
(* Rescale the Histogram)
(if QUANTILEDISPLAY
then (HISTOGRAM.DELETEQUANTILES QUANTILEDISPLAY HISTOGRAM T))
(RESCALEPLOT HISTOGRAM (QUOTE BOTH)
T)
(if QUANTILEDISPLAY
then (HISTOGRAM.DISPLAYQUANTILES HISTOGRAM T))
(* refresh the image)
(REDRAWPLOTWINDOW HISTOGRAM))])
(HISTOGRAM.INTSCALEFN
[LAMBDA (MIN MAX TICINFO) (* jop: " 2-Apr-86 22:50")
(with TICINFO TICINFO (create AXISINTERVAL
MIN ←(DIFFERENCE TICMIN .5)
MAX ←(PLUS TICMAX .5])
(HISTOGRAM.INTTICFN
[LAMBDA (MIN MAX) (* jop: "12-Feb-86 22:38")
(* *)
(LET* ((INTMAX (PLOT.FLOOR MAX))
(INTMIN (PLOT.CEILING MIN))
(TICINFO (DEFAULTTICFN INTMIN INTMAX))
NEWMAX NEWMIN INC NTICS)
[SETQ NEWMIN (IMIN INTMIN (PLOT.CEILING (fetch (TICINFO TICMIN) of TICINFO]
(SETQ INC (PLOT.CEILING (fetch (TICINFO TICINC) of TICINFO)))
[SETQ NTICS (ADD1 (PLOT.CEILING (FQUOTIENT (DIFFERENCE INTMAX NEWMIN)
INC]
[SETQ NEWMAX (IPLUS NEWMIN (ITIMES INC (SUB1 NTICS]
(create TICINFO
TICMIN ← NEWMIN
TICMAX ← NEWMAX
TICINC ← INC
NTICS ← NTICS])
(HISTOGRAM.MAKEBININTERVAL
[LAMBDA (BATCHMIN BATCHMAX NBINS INTFLG) (* jop: "13-Feb-86 16:04")
(* *)
(if INTFLG
then (LET ((NINT (ADD1 (IDIFFERENCE BATCHMAX BATCHMIN)))
MULT)
(if (IGEQ NBINS NINT)
then (create HISTOGRAM.BINS
BINMIN ← BATCHMIN
BINMAX ← BATCHMAX
BININC ← 1
NBINS ← NINT)
else (SETQ MULT (PLOT.CEILING (FQUOTIENT (DIFFERENCE BATCHMAX
BATCHMIN)
NBINS)))
(create HISTOGRAM.BINS
BINMIN ← BATCHMIN
BINMAX ←(PLUS BATCHMIN (TIMES MULT NBINS))
BININC ← MULT
NBINS ← NBINS)))
else (LET [(TICINFO (SCALE BATCHMIN BATCHMAX (ADD1 NBINS]
(create HISTOGRAM.BINS
BINMIN ←(fetch (TICINFO TICMIN) of TICINFO)
BINMAX ←(fetch (TICINFO TICMAX) of TICINFO)
BININC ←(fetch (TICINFO TICINC) of TICINFO)
NBINS ← NBINS])
(HISTOGRAM.RESET
[DLAMBDA ((HISTOGRAM PLOT))
(* jop: " 2-Apr-86 22:20")
(PROG [(N (PLOTPROP HISTOGRAM (QUOTE N]
(RESETLST (RESETSAVE (SETCURSOR WAITINGCURSOR)
(LIST (FUNCTION SETCURSOR)
DEFAULTCURSOR))
[PLOTPROP HISTOGRAM (QUOTE NBINS)
(if (LESSP N 20)
then (FIX (TIMES 2 (SQRT N)))
else (FIX (TIMES 10 (PLOT.LOG10 N]
(PLOTPROP HISTOGRAM (QUOTE BININTERVAL)
NIL)
(HISTOGRAM.DRAW HISTOGRAM)))])
(HISTOGRAM.SUMMARY
[DLAMBDA ((HISTOGRAM PLOT)
(LONGFLG (MEMQ T NIL)))
(* jop: "27-May-85 17:34")
(SUMMARYWINDOW.PRINT HISTOGRAM (LIST (PLOTLABEL HISTOGRAM (QUOTE BOTTOM))
(LIST (FUNCTION LETTER.VALUE.DISPLAY)
(PLOTPROP HISTOGRAM (QUOTE LETTERVALUES))
LONGFLG)))])
(HISTOGRAM.TICFN
[LAMBDA (MIN MAX HISTOGRAM) (* jop: " 2-Apr-86 22:35")
(* *)
(LET* ((RANGE (DIFFERENCE MAX MIN))
(BININTERVAL (PLOTPROP HISTOGRAM (QUOTE BININTERVAL)))
(BININC (fetch (HISTOGRAM.BINS BININC) of BININTERVAL))
(NBINS (fetch (HISTOGRAM.BINS NBINS) of BININTERVAL)))
(bind (MININTERVALLENGTH ← MAX.FLOAT)
MININTERVAL INTERVAL INTERVALLENGTH for MULTIPLE
from (PLOT.CEILING (QUOTIENT RANGE (TIMES BININC 9)))
to (PLOT.CEILING (QUOTIENT RANGE BININC))
do (SETQ INTERVAL (HISTOGRAM.COMPUTEMULT MIN MAX BININC MULTIPLE))
(SETQ INTERVALLENGTH (fetch (TICINFO TICINTERVALLENGTH) of INTERVAL))
(if (LESSP INTERVALLENGTH MININTERVALLENGTH)
then (SETQ MININTERVAL INTERVAL)
(SETQ MININTERVALLENGTH INTERVALLENGTH))
finally (RETURN MININTERVAL])
(HISTOGRAM.VALUES
[DLAMBDA ((RECTANGLE FILLEDRECTANGLEOBJECT)
(HISTOGRAM PLOT))
(* jop: "13-Feb-86 15:45")
(PROG ((N (PLOTPROP HISTOGRAM (QUOTE N)))
(BATCH (PLOTPROP HISTOGRAM (QUOTE BATCH)))
(RBATCH (PLOTPROP HISTOGRAM (QUOTE RBATCH)))
(LOWMARK (PLOTOBJECTPROP RECTANGLE (QUOTE LOWMARK)))
(HIGHMARK (PLOTOBJECTPROP RECTANGLE (QUOTE HIGHMARK)))
SELECTION)
(SETQ SELECTION (LIST (for I from 1 to N when (AND (GEQ (GETRELT RBATCH
I)
LOWMARK)
(LESSP (GETRELT
RBATCH I)
HIGHMARK))
collect I)))
(SUMMARYWINDOW.PRINT HISTOGRAM (AT BATCH SELECTION)))])
(LETTER.VALUE.DISPLAY
[DLAMBDA ((STREAM (SATISFIES (OR (EQ T STREAM)
(EQ NIL STREAM)
(STREAMP STREAM)
(WINDOWP STREAM))))
(LETTERVALUES LETTERVALUES)
(LONGFLG (MEMQ T NIL)))
(* jop: "13-Feb-86 16:50")
(* * Outputs a Letter value summary to stream)
(if (NULL STREAM)
then (SETQ STREAM (OUTPUT)))
(PROG [(MEDIANDEPTH (if (EQP (PLOT.FLOOR (fetch MEDIANDEPTH of LETTERVALUES))
(fetch MEDIANDEPTH of LETTERVALUES))
then (FIX (fetch MEDIANDEPTH of LETTERVALUES))
else (fetch MEDIANDEPTH of LETTERVALUES)))
(FOURTHDEPTH (if (EQP (PLOT.FLOOR (fetch FOURTHDEPTH of LETTERVALUES))
(fetch FOURTHDEPTH of LETTERVALUES))
then (FIX (fetch FOURTHDEPTH of LETTERVALUES))
else (fetch FOURTHDEPTH of LETTERVALUES)))
(EIGHTHDEPTH (if (EQP (PLOT.FLOOR (fetch EIGHTHDEPTH of LETTERVALUES))
(fetch EIGHTHDEPTH of LETTERVALUES))
then (FIX (fetch EIGHTHDEPTH of LETTERVALUES))
else (fetch EIGHTHDEPTH of LETTERVALUES)))
(FFORMAT (QUOTE (FLOAT 10 NIL NIL NIL 3]
(PRINTOUT STREAM "N = " .I5...T (fetch N of LETTERVALUES)
.SP 2 "Depth" .SP 5 "Lower" .SP 5 "Upper")
(if LONGFLG
then (PRINTOUT STREAM .SP 7 "Mid" .SP 4 "Spread"))
(PRINTOUT STREAM T "Median " .SP 2 .N (if (FIXP MEDIANDEPTH)
then (QUOTE (FIX 6))
else (QUOTE (FLOAT 6)))
MEDIANDEPTH .SP 5 .N FFORMAT (fetch MEDIAN of LETTERVALUES))
(PRINTOUT STREAM T "Fourths " .SP 2 .N (if (FIXP FOURTHDEPTH)
then (QUOTE (FIX 6))
else (QUOTE (FLOAT 6)))
FOURTHDEPTH .N FFORMAT (fetch LOWERFOURTH of LETTERVALUES)
.N FFORMAT (fetch UPPERFOURTH of LETTERVALUES))
(if LONGFLG
then (PRINTOUT STREAM .N FFORMAT (FQUOTIENT (FPLUS (fetch UPPERFOURTH
of LETTERVALUES)
(fetch LOWERFOURTH
of LETTERVALUES))
2)
.N FFORMAT (fetch FOURTHSPREAD of LETTERVALUES)))
(PRINTOUT STREAM T "Eighths " .SP 2 .N (if (FIXP EIGHTHDEPTH)
then (QUOTE (FIX 6))
else (QUOTE (FLOAT 6)))
EIGHTHDEPTH .N FFORMAT (fetch LOWEREIGHTH of LETTERVALUES)
.N FFORMAT (fetch UPPEREIGHTH of LETTERVALUES))
[if LONGFLG
then (PRINTOUT STREAM .N FFORMAT (FQUOTIENT (FPLUS (fetch UPPEREIGHTH
of LETTERVALUES)
(fetch LOWEREIGHTH
of LETTERVALUES))
2)
.N FFORMAT (FDIFFERENCE (fetch UPPEREIGHTH of LETTERVALUES)
(fetch LOWEREIGHTH of LETTERVALUES]
(PRINTOUT STREAM T "Extremes" .SP 7 "1" .N FFORMAT (fetch LOWEREXTREME of
LETTERVALUES)
.N FFORMAT (fetch UPPEREXTREME of LETTERVALUES))
[if LONGFLG
then (PRINTOUT STREAM .N FFORMAT (FQUOTIENT (FPLUS (fetch UPPEREXTREME
of LETTERVALUES)
(fetch LOWEREXTREME
of LETTERVALUES))
2)
.N FFORMAT (FDIFFERENCE (fetch UPPEREXTREME of LETTERVALUES)
(fetch LOWEREXTREME of LETTERVALUES]
(PRINTOUT STREAM T))])
(MAKEBOXOBJECT
[LAMBDA (BOXLEFT BOXRIGHT LADJACENT UADJACENT LETTERVALUES LABEL)
(* jop: "13-Feb-86 18:03")
(LET* ((BOXMIDDLE (FQUOTIENT (PLUS BOXLEFT BOXRIGHT)
2))
(N (fetch N of LETTERVALUES))
(MEDIAN (fetch MEDIAN of LETTERVALUES))
(LOWERFOURTH (fetch LOWERFOURTH of LETTERVALUES))
(UPPERFOURTH (fetch UPPERFOURTH of LETTERVALUES))
(BOX (CREATEPOLYGON (LIST (create POSITION
XCOORD ← BOXLEFT
YCOORD ← LOWERFOURTH)
(create POSITION
XCOORD ← BOXRIGHT
YCOORD ← LOWERFOURTH)
(create POSITION
XCOORD ← BOXRIGHT
YCOORD ← UPPERFOURTH)
(create POSITION
XCOORD ← BOXLEFT
YCOORD ← UPPERFOURTH))
NIL 2))
(MEDIANLINE (CREATECURVE (LIST (create POSITION
XCOORD ← BOXLEFT
YCOORD ← MEDIAN)
(create POSITION
XCOORD ← BOXRIGHT
YCOORD ← MEDIAN))
NIL 3))
(LWHISKER (CREATECURVE (LIST (create POSITION
XCOORD ← BOXMIDDLE
YCOORD ← LOWERFOURTH)
(create POSITION
XCOORD ← BOXMIDDLE
YCOORD ← LADJACENT))
NIL 1))
(UWHISKER (CREATECURVE (LIST (create POSITION
XCOORD ← BOXMIDDLE
YCOORD ← UPPERFOURTH)
(create POSITION
XCOORD ← BOXMIDDLE
YCOORD ← UADJACENT))
NIL 1))
(LBAR (CREATECURVE (LIST (create POSITION
XCOORD ← BOXLEFT
YCOORD ← LADJACENT)
(create POSITION
XCOORD ← BOXRIGHT
YCOORD ← LADJACENT))
NIL 1))
(UBAR (CREATECURVE (LIST (create POSITION
XCOORD ← BOXLEFT
YCOORD ← UADJACENT)
(create POSITION
XCOORD ← BOXRIGHT
YCOORD ← UADJACENT))
NIL 1)))
(CREATECOMPOUND (QUOTE BOX)
(LIST BOX MEDIANLINE LWHISKER UWHISKER LBAR UBAR)
LABEL
(QUOTE BOXMENU])
(SCATTERPLOT
[ULAMBDA ((Y (ONEOF VECTOR MATRIX))
(X (ONEOF NIL VECTOR MATRIX))
(CONTROLER (ONEOF NIL SCALAR VECTOR)))
(* jop: "13-Feb-86 23:03")
(* Plots vector YROW against XROW or 1->N)
(RESETLST (RESETSAVE (SETCURSOR WAITINGCURSOR)
(LIST (FUNCTION SETCURSOR)
DEFAULTCURSOR))
(LET* ((SCATTERPLOT (CREATEPLOT))
(RIGHTMENUITEMS (LIST (LIST (QUOTE Coordinates)
(FUNCTION SCATTERPLOT.WORLDCOORD)
"Display world coordinates at cursor position")
(LIST (QUOTE Regress)
(FUNCTION SCATTERPLOT.REGRESS)
"Display a linear regression line")))
[POINTMENUITEMS (APPEND (COPY (PLOTMENUITEMS SCATTERPLOT (QUOTE MIDDLE)
))
(LIST (LIST (QUOTE Coordinates)
(FUNCTION SCATTERPLOT.POINTCOORDS)
"Display point coordinates"]
[YLABEL (OR (if (type? VECTOR Y)
then (if (type? SELARRAY Y)
then (FIRSTHIDDENLEVLABEL Y))
else (if (EQP (CAR (fetch KEEPS of Y))
2)
then (GETDIMLAB Y 2)
else (GETDIMLAB Y 1)))
(CONCAT "ARRAY " (SERIALNUMBER Y]
[XLABEL (OR [if X
then (if (type? VECTOR X)
then (if (type? SELARRAY X)
then (FIRSTHIDDENLEVLABEL X))
else (if (EQP (CAR (fetch KEEPS
of X))
2)
then (GETDIMLAB X 2)
else (GETDIMLAB X 1)))
else (CONCAT 1 " - "
(if (type? VECTOR Y)
then (GETRELT (fetch SHAPE
of Y)
1)
else (if (EQP (CAR (fetch KEEPS
of Y))
2)
then (GETRELT (fetch
SHAPE
of Y)
1)
else (GETRELT (fetch SHAPE
of Y)
2]
(CONCAT "ARRAY " (SERIALNUMBER X]
(PTITLE (CONCAT "Scatterplot of " YLABEL " vs " XLABEL))
(GLYPHS (LIST STAR CROSS CIRCLE))
(NEXTGLYPH GLYPHS)
(GETLABFROMX (if (AND (type? VECTOR Y)
(type? MATRIX X))
then T
else NIL))
(LNUM 1))
(DECLARE (SPECVARS SCATTERPLOT GLYPHS NEXTGLYPH LNUM GETLABFROMX))
(PLOTTICS SCATTERPLOT (QUOTE BOTTOM)
T T)
(PLOTTICS SCATTERPLOT (QUOTE LEFT)
T T)
(PLOTLABEL SCATTERPLOT (QUOTE BOTTOM)
XLABEL T)
(PLOTLABEL SCATTERPLOT (QUOTE LEFT)
YLABEL T)
(PLOTLABEL SCATTERPLOT (QUOTE TOP)
PTITLE T)
(PLOTADDMENUITEMS SCATTERPLOT (QUOTE RIGHT)
RIGHTMENUITEMS)
(PLOTADDMENUITEMS SCATTERPLOT (QUOTE POINTMENU)
POINTMENUITEMS)
(EAPPLY* (FUNCTION SCATTERPLOT.POINTSORCURVES)
(QUOTE (VECTOR VECTOR SCALAR))
Y X CONTROLER)
(RESCALEPLOT SCATTERPLOT (QUOTE BOTH)
T)
(PLOTPROP SCATTERPLOT (QUOTE COPYFN)
(FUNCTION COPYSCATTERPLOT))
(OPENPLOTWINDOW SCATTERPLOT)
SCATTERPLOT))])
(SCATTERPLOT.POINTCOORDS
[DLAMBDA ((POINTOBJECT POINTOBJECT)
(SCATTERPLOT PLOT))
(* jop: "13-Aug-85 15:15")
(DPROG ((POINTPOSITION (fetch POINTPOSITION of (fetch OBJECTDATA of POINTOBJECT)) POSITION)
(XLABEL (CONCAT (OR (PLOTLABEL SCATTERPLOT (QUOTE BOTTOM))
"XCOORD")
" ") STRINGP)
(YLABEL (CONCAT " " (OR (PLOTLABEL SCATTERPLOT (QUOTE LEFT))
"YCOORD")
" ") STRINGP))
(PLOTPROMPT (CONCAT XLABEL (fetch XCOORD of POINTPOSITION)
YLABEL
(fetch YCOORD of POINTPOSITION))
SCATTERPLOT))])
(SCATTERPLOT.POINTSORCURVES
[DLAMBDA ((Y VECTOR)
(X (ONEOF NIL VECTOR))
(CONTROLER (SATISFIES (SCALARP CONTROLER))))
(* jop: " 2-Aug-85 15:36")
(if [AND X (NOT (EQP (GETRELT (fetch SHAPE of Y)
1)
(GETRELT (fetch SHAPE of X)
1]
then (UERROR "VECTOR X AND Y NOT OF SAME SHAPE"))
(if (AND CONTROLER (EQP CONTROLER 1))
then (ADDCURVETOPLOT SCATTERPLOT Y X (OR [if GETLABFROMX
then (OR (if (type? SELARRAY X)
then (FIRSTHIDDENLEVLABEL X))
(if (type? SELARRAY Y)
then (FIRSTHIDDENLEVLABEL Y)))
else (OR (if (type? SELARRAY Y)
then (FIRSTHIDDENLEVLABEL Y))
(if (type? SELARRAY X)
then (FIRSTHIDDENLEVLABEL X]
(CONCAT "LINE " LNUM))
NIL NIL T)
(SETQ LNUM (ADD1 LNUM))
else (ADDPOINTSTOPLOT SCATTERPLOT Y X (CAR NEXTGLYPH)
(for I to (GETRELT (fetch SHAPE of Y)
1)
collect (OR [if GETLABFROMX
then (OR (if X
then (GETLEVLAB X 1 I))
(GETLEVLAB Y 1 I))
else (OR (GETLEVLAB Y 1 I)
(if X
then (GETLEVLAB X 1 I]
I))
(QUOTE POINTMENU)
T)
(SETQ NEXTGLYPH (CDR NEXTGLYPH))
(if (NULL NEXTGLYPH)
then (SETQ NEXTGLYPH GLYPHS)))
NIL])
(SCATTERPLOT.REGRESS
[DLAMBDA ((SCATTERPLOT PLOT))
(* edited: " 2-Apr-86 23:49")
(DPROG ((PLOTOBJECTS (fetch PLOTOBJECTS of SCATTERPLOT) LISTP)
(N 1 FIXP)
(SLOPE NIL FLOATP)
(CONSTANT NIL FLOATP)
(CXX NIL FLOATP)
(CXY NIL FLOATP)
(XBAR NIL FLOATP)
(YBAR NIL FLOATP)
(LINEOBJECT NIL LINEOBJECT))
[if (NULL (PLOTMENU SCATTERPLOT (QUOTE REGRESSMENU)))
then (PLOTMENUITEMS SCATTERPLOT (QUOTE REGRESSMENU)
(APPEND (PLOTMENUITEMS SCATTERPLOT (QUOTE MIDDLE))
(LIST (LIST (QUOTE Coefficients)
(FUNCTION SCATTERPLOT.REGRESSSUMMARY)
"Display coefficients of regress line"]
(if (PLOTPROP SCATTERPLOT (QUOTE REGRESSLINE))
then (DELETEPLOTOBJECT (PLOTPROP SCATTERPLOT (QUOTE REGRESSLINE))
SCATTERPLOT NIL T))
[bind (SX ← 0.0)
(SY ← 0.0)
(SSX ← 0.0)
(SSY ← 0.0)
(SXY ← 0.0)
POSITION for OBJECT in PLOTOBJECTS when (PLOTOBJECTSUBTYPE? POINT OBJECT)
do (SETQ POSITION (fetch POINTPOSITION of (fetch OBJECTDATA of OBJECT)))
(add N 1)
(fadd SX (fetch XCOORD of POSITION))
(fadd SY (fetch YCOORD of POSITION))
(fadd SSX (TIMES (fetch XCOORD of POSITION)
(fetch XCOORD of POSITION)))
(fadd SSY (TIMES (fetch YCOORD of POSITION)
(fetch YCOORD of POSITION)))
(fadd SXY (TIMES (fetch XCOORD of POSITION)
(fetch YCOORD of POSITION)))
finally (SETQ XBAR (QUOTIENT SX N))
(SETQ YBAR (QUOTIENT SY N))
(SETQ CXX (DIFFERENCE (QUOTIENT SSX N)
(TIMES XBAR XBAR)))
(SETQ CXY (DIFFERENCE (QUOTIENT SXY N)
(TIMES XBAR YBAR)))
(SETQ SLOPE (QUOTIENT CXY CXX))
(SETQ CONSTANT (DIFFERENCE YBAR (TIMES SLOPE XBAR]
(SETQ LINEOBJECT (CREATELINE SLOPE CONSTANT "Regression line" NIL (QUOTE REGRESSMENU)))
(PLOTOBJECTPROP LINEOBJECT (QUOTE SLOPE)
SLOPE)
(PLOTOBJECTPROP LINEOBJECT (QUOTE CONSTANT)
CONSTANT)
(PLOTPROP SCATTERPLOT (QUOTE REGRESSLINE)
LINEOBJECT)
(ADDPLOTOBJECT LINEOBJECT SCATTERPLOT))])
(SCATTERPLOT.REGRESSSUMMARY
[DLAMBDA ((RLINE LINEOBJECT)
(SCATTERPLOT PLOT))
(* jop: "12-Feb-86 11:50")
(PLOTPROMPT (CONCAT "Slope: " (PLOTOBJECTPROP RLINE (QUOTE SLOPE))
" Constant: "
(PLOTOBJECTPROP RLINE (QUOTE CONSTANT)))
SCATTERPLOT)])
(SCATTERPLOT.RUNNINGAVERAGE
[DLAMBDA ((SCATTERPLOT PLOT))
(* edited: " 2-Apr-86 23:49")
(DPROG ((PLOTOBJECTS (fetch PLOTOBJECTS of SCATTERPLOT) LISTP)
(PRTWINDOW (fetch PLOTPROMPTWINDOW of SCATTERPLOT))
THEN (N (for OBJECT in PLOTOBJECTS count (PLOTOBJECTSUBTYPE? POINT OBJECT)) FIXP)
THEN (ROWOFXS (create ROWFLOAT
NELTS ← N) ROWFLOAT)
(OROWOFXS NIL ROWINT)
(ROWOFYS (create ROWFLOAT
NELTS ← N) ROWFLOAT)
(SMOOTHPOSITIONS NIL LST)
(SMOOTH NIL CURVEOBJECT)
(SPAN NIL FIXP))
(PRINTOUT PRTWINDOW T)
[SETQ SPAN (EVAL (READ (OPENSTRINGSTREAM (PROMPTFORWORD "Specify span:" 7 NIL
PRTWINDOW]
(if (EVENP SPAN)
then (PLOTPROMPT (CONCAT "Span must be odd " SPAN)
SCATTERPLOT)
(RETURN NIL))
(bind (I ← 1)
POSITION for OBJECT in PLOTOBJECTS when (PLOTOBJECTSUBTYPE? POINT OBJECT)
do (SETQ POSITION (fetch POINTPOSITION of (fetch OBJECTDATA of OBJECT)))
(SETRELT ROWOFXS I (fetch XCOORD of POSITION))
(SETRELT ROWOFYS I (fetch YCOORD of POSITION))
(SETQ I (ADD1 I))) (* Order the X's)
(SETQ OROWOFXS (ORDERROW ROWOFXS))
[SETQ SMOOTHPOSITIONS (bind [RUNNINGY ←(for I from 1 to (IQUOTIENT (SUB1
SPAN)
2)
sum (GETRELT ROWOFYS (GETRELT OROWOFXS I]
(LOWERBOUND ←(IQUOTIENT (SUB1 SPAN)
2))
(UPPERBOUND ←(IDIFFERENCE N (IQUOTIENT (SUB1 SPAN)
2)))
for I from 1 to N declare (TYPE FLOATP RUNNINGY)
collect [if (IGREATERP I LOWERBOUND)
then (SETQ RUNNINGY
(FDIFFERENCE RUNNINGY
(GETRELT
ROWOFYS
(GETRELT OROWOFXS
(IDIFFERENCE
I LOWERBOUND]
[if (ILEQ I UPPERBOUND)
then (SETQ RUNNINGY
(FPLUS RUNNINGY
(GETRELT ROWOFYS
(GETRELT
OROWOFXS
(IPLUS I
LOWERBOUND]
(create POSITION
XCOORD ←(GETRELT ROWOFXS (GETRELT
OROWOFXS I))
YCOORD ←(FQUOTIENT RUNNINGY SPAN]
(SETQ SMOOTH (CREATECURVE SMOOTHPOSITIONS (CONCAT "Running averages of " SPAN)))
(ADDPLOTOBJECT SMOOTH SCATTERPLOT))])
(SCATTERPLOT.RUNNINGREGRESS
[DLAMBDA ((SCATTERPLOT PLOT))
(* edited: " 2-Apr-86 23:50")
(DPROG ((PLOTOBJECTS (fetch PLOTOBJECTS of SCATTERPLOT) LISTP)
(PRTWINDOW (fetch PLOTPROMPTWINDOW of SCATTERPLOT))
THEN (N (for OBJECT in PLOTOBJECTS count (PLOTOBJECTSUBTYPE? POINT OBJECT)) FIXP)
THEN (ROWOFXS (create ROWFLOAT
NELTS ← N) ROWFLOAT)
(OROWOFXS NIL ROWINT)
(ROWOFYS (create ROWFLOAT
NELTS ← N) ROWFLOAT)
(SMOOTHPOSITIONS NIL LST)
(SMOOTH NIL CURVEOBJECT)
(SPAN NIL FIXP))
(PRINTOUT PRTWINDOW T)
[SETQ SPAN (EVAL (READ (OPENSTRINGSTREAM (PROMPTFORWORD
"Specify span:"
(LET [(THIRD (FIXR (TIMES .3 N]
(if (EVENP THIRD)
then (SUB1 THIRD)
else THIRD))
NIL PRTWINDOW]
(if (EVENP SPAN)
then (PLOTPROMPT (CONCAT "Span must be odd " SPAN)
SCATTERPLOT)
(RETURN NIL))
(bind (I ← 1)
POSITION for OBJECT in PLOTOBJECTS when (PLOTOBJECTSUBTYPE? POINT OBJECT)
do (SETQ POSITION (fetch POINTPOSITION of (fetch OBJECTDATA of OBJECT)))
(SETRELT ROWOFXS I (fetch XCOORD of POSITION))
(SETRELT ROWOFYS I (fetch YCOORD of POSITION))
(SETQ I (ADD1 I)))
(SETQ OROWOFXS (ORDERROW ROWOFXS))
[SETQ SMOOTHPOSITIONS (bind (SX ← 0.0)
(SY ← 0.0)
(SSX ← 0.0)
(SXY ← 0.0)
(LOWERBOUND ←(IQUOTIENT (SUB1 SPAN)
2))
(UPPERBOUND ←(IDIFFERENCE N (IQUOTIENT (SUB1 SPAN)
2)))
(X ← 0.0)
(Y ← 0.0)
INDEX first [for I from 1 to LOWERBOUND
do (SETQ INDEX (GETRELT OROWOFXS I))
(SETQ X (GETRELT ROWOFXS INDEX))
(SETQ Y (GETRELT ROWOFYS INDEX))
(SETQ SX (PLUS SX X))
(SETQ SY (PLUS SY Y))
(SETQ SSX (PLUS SSX
(TIMES X X)))
(SETQ SXY (PLUS SXY
(TIMES X Y]
for I from 1 to N
collect [if (IGREATERP I LOWERBOUND)
then (SETQ INDEX (GETRELT OROWOFXS
(IDIFFERENCE
I LOWERBOUND)))
(SETQ X (GETRELT ROWOFXS INDEX))
(SETQ Y (GETRELT ROWOFYS INDEX))
(SETQ SX (FDIFFERENCE SX X))
(SETQ SY (FDIFFERENCE SY Y))
(SETQ SSX (FDIFFERENCE SSX
(TIMES X X)))
(SETQ SXY (FDIFFERENCE SXY
(TIMES X Y]
[if (ILEQ I UPPERBOUND)
then (SETQ INDEX (GETRELT OROWOFXS
(IPLUS I
LOWERBOUND)))
(SETQ X (GETRELT ROWOFXS INDEX))
(SETQ Y (GETRELT ROWOFYS INDEX))
(SETQ SX (FPLUS SX X))
(SETQ SY (FPLUS SY Y))
(SETQ SSX (FPLUS SSX (TIMES X X)))
(SETQ SXY (FPLUS SXY (TIMES X Y]
(SETQ INDEX (GETRELT OROWOFXS I))
(SETQ X (GETRELT ROWOFXS INDEX))
(create POSITION
XCOORD ← X
YCOORD ←(SCATTERPLOT.SMOOTHEDVALUE
X
(if (ILEQ I LOWERBOUND)
then (IPLUS LOWERBOUND I)
elseif (IGREATERP I UPPERBOUND)
then (IPLUS LOWERBOUND
(ADD1 (IDIFFERENCE
N I)))
else SPAN)
SX SY SSX SXY]
(SETQ SMOOTH (CREATECURVE SMOOTHPOSITIONS "Running regression curve" 2))
(ADDPLOTOBJECT SMOOTH SCATTERPLOT))])
(SCATTERPLOT.SMOOTHEDVALUE
[LAMBDA (X N SX SY SSX SXY) (* jop: "16-Aug-85 01:07")
(PROG ((XBAR (QUOTIENT SX N))
(YBAR (QUOTIENT SY N))
CXX CXY SLOPE CONSTANT)
(SETQ CXX (DIFFERENCE (QUOTIENT SSX N)
(TIMES XBAR XBAR)))
(SETQ CXY (DIFFERENCE (QUOTIENT SXY N)
(TIMES XBAR YBAR)))
(SETQ SLOPE (QUOTIENT CXY CXX))
(SETQ CONSTANT (DIFFERENCE YBAR (TIMES SLOPE XBAR)))
(RETURN (PLUS CONSTANT (TIMES SLOPE X])
(SCATTERPLOT.WORLDCOORD
[DLAMBDA ((SCATTERPLOT PLOT))
(* jop: "12-Feb-86 11:37")
(DPROG ((PLOTWINDOW (fetch PLOTWINDOW of SCATTERPLOT) WINDOW)
(PLOTPROMPTWINDOW (fetch PLOTPROMPTWINDOW of SCATTERPLOT) WINDOW)
(PLOTVIEWPORT (fetch PLOTWINDOWVIEWPORT of SCATTERPLOT) VIEWPORT)
(XLABEL (CONCAT (OR (PLOTLABEL SCATTERPLOT (QUOTE BOTTOM))
"X")
" at ") STRINGP)
(YLABEL (CONCAT " " (OR (PLOTLABEL SCATTERPLOT (QUOTE LEFT))
"Y")
" at ") STRINGP)
(OLDCURSORPOS (CONSTANT (create POSITION
XCOORD ← 0
YCOORD ← 0)) LISTP)
(NEWCURSORPOS (CONSTANT (create POSITION)) LISTP)
STARTXCOORDX STARTXCOORDY STARTYCOORDX STARTYCOORDY)
(PRINTOUT PLOTPROMPTWINDOW T XLABEL)
(SETQ STARTXCOORDX (DSPXPOSITION NIL PLOTPROMPTWINDOW))
(SETQ STARTXCOORDY (DSPYPOSITION NIL PLOTPROMPTWINDOW))
(PRINTOUT PLOTPROMPTWINDOW .SP 10 YLABEL)
(SETQ STARTYCOORDX (DSPXPOSITION NIL PLOTPROMPTWINDOW))
(SETQ STARTYCOORDY (DSPYPOSITION NIL PLOTPROMPTWINDOW))
[while (MOUSESTATE UP)
do (SETQ NEWCURSORPOS (CURSORPOSITION NIL PLOTWINDOW NEWCURSORPOS))
(if [NOT (AND (EQP (fetch XCOORD of OLDCURSORPOS)
(fetch XCOORD of NEWCURSORPOS))
(EQP (fetch YCOORD of OLDCURSORPOS)
(fetch YCOORD of NEWCURSORPOS]
then (MOVETO STARTXCOORDX STARTXCOORDY PLOTPROMPTWINDOW)
(PRINTOUT PLOTPROMPTWINDOW .F10.4 (STREAMTOWORLDX (fetch XCOORD
of NEWCURSORPOS)
PLOTVIEWPORT))
(MOVETO STARTYCOORDX STARTYCOORDY PLOTPROMPTWINDOW)
(PRINTOUT PLOTPROMPTWINDOW .F10.4 (STREAMTOWORLDY (fetch YCOORD
of NEWCURSORPOS)
PLOTVIEWPORT))
(replace XCOORD of OLDCURSORPOS with (fetch XCOORD of
NEWCURSORPOS))
(replace YCOORD of OLDCURSORPOS with (fetch YCOORD of
NEWCURSORPOS])])
(SUMMARY.REPAINTFN
[DLAMBDA ((WINDOW WINDOW))
(* jop: "13-Feb-86 16:32")
(* * Mostly copied from the Pretty Print window example in the manual. If OUTPUT is an IDL array, it is pretty
printed, if LISTP , CAR is applied to (CONS WINDOW (CDR of item)) else PRIN1'ed)
[PROG [(OUTPUT (WINDOWPROP WINDOW (QUOTE OUTPUT]
(MOVETO (WINDOWPROP WINDOW (QUOTE TOPX))
(WINDOWPROP WINDOW (QUOTE TOPY))
WINDOW)
(for ITEM in OUTPUT do (if (IDLARRAYP ITEM)
then (PPA ITEM WINDOW)
elseif (LISTP ITEM)
then (APPLY (CAR ITEM)
(CONS WINDOW (CDR ITEM)))
else (printout WINDOW ITEM T]])
(SUMMARY.RESHAPEFN
[LAMBDA (WINDOW) (* jop: "13-Feb-86 16:31")
(* * Copied from example in manual)
(PROG (BOTTOMEXTENT)
(DSPRESET WINDOW)
(WINDOWPROP WINDOW (QUOTE TOPX)
(DSPXPOSITION NIL WINDOW))
(WINDOWPROP WINDOW (QUOTE TOPY)
(DSPYPOSITION NIL WINDOW))
(SUMMARY.REPAINTFN WINDOW)
[SETQ BOTTOMEXTENT (IPLUS (DSPYPOSITION NIL WINDOW)
(FONTPROP WINDOW (QUOTE ASCENT]
(WINDOWPROP WINDOW (QUOTE EXTENT)
(CREATEREGION 0 BOTTOMEXTENT (WINDOWPROP WINDOW (QUOTE WIDTH))
(IDIFFERENCE (WINDOWPROP WINDOW (QUOTE HEIGHT))
BOTTOMEXTENT])
(SUMMARYWINDOW.PRINT
[DLAMBDA ((PLOT PLOT)
OUTPUT)
(* jop: "13-Feb-86 16:32")
(* * Print OUTPUT in SUMMARY window. OUTPUT may be an IDLARRAY , in which case it is pretty printed, or
LETTERVALUES, in which case is LETTERVALUEDISPLAY'ed, or ANY, in which case it is PRIN1'ED.
A SUMMARY window is cached as a PLOT PROP. OUTPUT may be a list, in which case the process is iterated)
(PROG [(SUMMARYWINDOW (WINDOWPROP (fetch PLOTWINDOW of PLOT)
(QUOTE SUMMARYWINDOW]
(if (NULL SUMMARYWINDOW)
then (SETQ SUMMARYWINDOW (GETSUMMARYWINDOW 6))
(WINDOWPROP (fetch PLOTWINDOW of PLOT)
(QUOTE SUMMARYWINDOW)
SUMMARYWINDOW))
(WINDOWPROP SUMMARYWINDOW (QUOTE OUTPUT)
(if (NLISTP OUTPUT)
then (LIST OUTPUT)
else OUTPUT))
(if (NOT (OPENWP SUMMARYWINDOW))
then (ATTACHWINDOW SUMMARYWINDOW (fetch PLOTWINDOW of PLOT)
(QUOTE TOP)
NIL
(QUOTE LOCALCLOSE))
else (SUMMARY.RESHAPEFN SUMMARYWINDOW)))])
)
[DECLARE: EVAL@COMPILE
(DATATYPE HISTOGRAM.BINS (BINMIN BINMAX BININC NBINS))
(DATATYPE LETTERVALUES ((N INTEGER)
(MEDIAN FLOATING)
(MEDIANDEPTH FLOATING)
(LOWERFOURTH FLOATING)
(UPPERFOURTH FLOATING)
(FOURTHDEPTH FLOATING)
(LOWEREIGHTH FLOATING)
(UPPEREIGHTH FLOATING)
(EIGHTHDEPTH FLOATING)
(LOWEREXTREME FLOATING)
(UPPEREXTREME FLOATING))
[ACCESSFNS ((FOURTHSPREAD (FDIFFERENCE (fetch UPPERFOURTH
of DATUM)
(fetch LOWERFOURTH
of DATUM])
]
(/DECLAREDATATYPE (QUOTE HISTOGRAM.BINS)
(QUOTE (POINTER POINTER POINTER POINTER))
(QUOTE ((HISTOGRAM.BINS 0 POINTER)
(HISTOGRAM.BINS 2 POINTER)
(HISTOGRAM.BINS 4 POINTER)
(HISTOGRAM.BINS 6 POINTER)))
(QUOTE 8))
(/DECLAREDATATYPE (QUOTE LETTERVALUES)
(QUOTE (FIXP FLOATP FLOATP FLOATP FLOATP FLOATP FLOATP FLOATP FLOATP FLOATP FLOATP))
(QUOTE ((LETTERVALUES 0 FIXP)
(LETTERVALUES 2 FLOATP)
(LETTERVALUES 4 FLOATP)
(LETTERVALUES 6 FLOATP)
(LETTERVALUES 8 FLOATP)
(LETTERVALUES 10 FLOATP)
(LETTERVALUES 12 FLOATP)
(LETTERVALUES 14 FLOATP)
(LETTERVALUES 16 FLOATP)
(LETTERVALUES 18 FLOATP)
(LETTERVALUES 20 FLOATP)))
(QUOTE 22))
(DECLARE: DONTEVAL@LOAD DOEVAL@COMPILE DONTCOPY COMPILERVARS
(ADDTOVAR NLAMA )
(ADDTOVAR NLAML )
(ADDTOVAR LAMA BOXPLOTS)
)
(PUTPROPS IDLPLOT COPYRIGHT ("Xerox Corporation" 1985 1986))
(DECLARE: DONTCOPY
(FILEMAP (NIL (1751 86991 (ADDCURVESTOPLOT 1761 . 2454) (ADDCURVETOPLOT 2456 . 4195) (
ADDFILLEDRECTANGLESTOPLOT 4197 . 6679) (ADDLINESTOPLOT 6681 . 8952) (ADDPOINTSTOPLOT 8954 . 10523) (
ADDPOLYGONSTOPLOT 10525 . 11240) (ADDPOLYGONTOPLOT 11242 . 12974) (BARPLOT 12976 . 14502) (
BARPLOT.CHANGELABEL 14504 . 15187) (BARPLOT.DRAW 15189 . 16110) (BARPLOT.TICFN 16112 . 16707) (
BOXPLOTS 16709 . 19183) (BOXPLOT.COMPAREFN 19185 . 19511) (BOXPLOT.COMPUTETICS 19513 . 20213) (
BOXPLOT.DELETE 20215 . 22085) (BOXPLOT.LABEL 22087 . 22727) (BOXPLOT.MOVE 22729 . 26795) (
BOXPLOT.WHENADDEDFN 26797 . 27263) (BOXPLOT.WHENDELETEDFN 27265 . 27743) (BOXPLOT.HISTOGRAM 27745 .
27985) (BOXPLOT.MAKEBOX 27987 . 31640) (BOXPLOT.SUMMARY 31642 . 32124) (COPYBOXPLOT 32126 . 32608) (
COPYHISTOGRAM 32610 . 33629) (COPYSCATTERPLOT 33631 . 34297) (FIRSTHIDDENLEVLABEL 34299 . 34931) (
FLIPBOX 34933 . 36668) (GETHIDDENLEVLABELS 36670 . 37586) (GETLETTERVALUES 37588 . 39422) (
GETSUMMARYWINDOW 39424 . 40604) (GETVALUEATDEPTH 40606 . 41154) (HISTOGRAM 41156 . 45094) (
HISTOGRAM.BOXSUMMARY 45096 . 45831) (HISTOGRAM.CHANGEBINS 45833 . 48008) (HISTOGRAM.COMPUTEMULT 48010
. 48502) (HISTOGRAM.DELETEQUANTILES 48504 . 48974) (HISTOGRAM.DISPLAYQUANTILES 48976 . 50274) (
HISTOGRAM.DRAW 50276 . 54965) (HISTOGRAM.INTSCALEFN 54967 . 55220) (HISTOGRAM.INTTICFN 55222 . 56019)
(HISTOGRAM.MAKEBININTERVAL 56021 . 57061) (HISTOGRAM.RESET 57063 . 57687) (HISTOGRAM.SUMMARY 57689 .
58101) (HISTOGRAM.TICFN 58103 . 59105) (HISTOGRAM.VALUES 59107 . 59959) (LETTER.VALUE.DISPLAY 59961 .
63628) (MAKEBOXOBJECT 63630 . 65729) (SCATTERPLOT 65731 . 69283) (SCATTERPLOT.POINTCOORDS 69285 .
70009) (SCATTERPLOT.POINTSORCURVES 70011 . 71671) (SCATTERPLOT.REGRESS 71673 . 74230) (
SCATTERPLOT.REGRESSSUMMARY 74232 . 74602) (SCATTERPLOT.RUNNINGAVERAGE 74604 . 77325) (
SCATTERPLOT.RUNNINGREGRESS 77327 . 81303) (SCATTERPLOT.SMOOTHEDVALUE 81305 . 81893) (
SCATTERPLOT.WORLDCOORD 81895 . 84160) (SUMMARY.REPAINTFN 84162 . 84995) (SUMMARY.RESHAPEFN 84997 .
85751) (SUMMARYWINDOW.PRINT 85753 . 86989)))))
STOP