(FILECREATED "17-Feb-87 12:57:04" {QV}<PEDERSEN>LISP>KOTO>IDLPLOTFNS.;3 74875
changes to: (FNS HISTOGRAM HISTOGRAM.GETBATCH SCATTERPLOT-MATRIX)
(VARS IDLPLOTFNSCOMS)
previous date: "28-Jun-86 16:58:56" {QV}<PEDERSEN>LISP>KOTO>IDLPLOTFNS.;1)
(* Copyright (c) 1986, 1987 by Xerox Corporation. All rights reserved.)
(PRETTYCOMPRINT IDLPLOTFNSCOMS)
(RPAQQ IDLPLOTFNSCOMS [(* *)
(FNS ADDCURVE ADDFILLEDRECTANGLES ADDLINES ADDPOINTS ADDPOLYGON 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 FLIPBOX
GETLETTERVALUES GETSUMMARYWINDOW GETVALUEATDEPTH HISTOGRAM HISTOGRAM.BOXSUMMARY
HISTOGRAM.CHANGEBINS HISTOGRAM.COMPUTEMULT HISTOGRAM.DELETEQUANTILES
HISTOGRAM.DISPLAYQUANTILES HISTOGRAM.DRAW HISTOGRAM.GETBATCH HISTOGRAM.INTSCALEFN
HISTOGRAM.INTTICFN HISTOGRAM.MAKEBININTERVAL HISTOGRAM.RESET HISTOGRAM.SUMMARY
HISTOGRAM.TICFN HISTOGRAM.VALUES LETTER.VALUE.DISPLAY MAKEBOXOBJECT SCATTERPLOT
SCATTERPLOT-MATRIX SCATTERPLOT.POINTCOORDS SCATTERPLOT.REGRESS
SCATTERPLOT.REGRESSSUMMARY SCATTERPLOT.SMOOTH SCATTERPLOT.WORLDCOORD SUMMARY.REPAINTFN
SUMMARY.RESHAPEFN SUMMARYWINDOW.PRINT)
(RECORDS HISTOGRAM.BINS LETTERVALUES)
(DECLARE: DONTEVAL@LOAD DOEVAL@COMPILE DONTCOPY COMPILERVARS (ADDVARS (NLAMA)
(NLAML)
(LAMA])
(* *)
(DEFINEQ
(ADDCURVE
[LAMBDA (PLOT XYMATRIX LABEL WIDTH MENU NODRAWFLG) (* jop: "27-Jun-86 13:32")
(* *)
(if [NOT (OR (AND (EQ 2 (IDLARRAY-RANK XYMATRIX))
(EQ 2 (IDLARRAY-DIMENSION XYMATRIX 1))
(IDLARRAY-ELTTYPEP XYMATRIX (QUOTE NUMERIC)))
(AND (EQ 1 (IDLARRAY-RANK XYMATRIX))
(EQ 2 (IDLARRAY-TOTALSIZE XYMATRIX))
(IDLARRAY-ELTTYPEP (IDLARRAY-REF XYMATRIX 0)
(QUOTE NUMERIC))
(IDLARRAY-ELTTYPEP (IDLARRAY-REF XYMATRIX 1)
(QUOTE NUMERIC))
(EQ (IDLARRAY-TOTALSIZE (IDLARRAY-REF XYMATRIX 0))
(IDLARRAY-TOTALSIZE (IDLARRAY-REF XYMATRIX 1]
then (ERROR "XYMATRIX of incorrect form" XYMATRIX))
[if (NULL LABEL)
then (SETQ LABEL (if (AND (EQ 2 (IDLARRAY-RANK XYMATRIX))
(LITATOM (IDLARRAY-GETDIMLABEL XYMATRIX 1)))
then (IDLARRAY-GETDIMLABEL XYMATRIX 1]
(if (EQ 2 (IDLARRAY-RANK XYMATRIX))
then (PLOTCURVE PLOT (bind (CMLARRAY ←(IDLARRAY-CMLARRAY XYMATRIX)) for I
from 0 upto (IDLARRAY-DIMENSION XYMATRIX 0)
collect (CREATEPOSITION (AREF CMLARRAY I 0)
(AREF CMLARRAY I 1)))
LABEL WIDTH MENU NODRAWFLG)
else (LET* ((X (IDLARRAY-REF XYMATRIX 0))
(Y (IDLARRAY-REF XYMATRIX 1))
(N (IDLARRAY-TOTALSIZE X)))
(PLOTCURVE PLOT (bind (XARRAY ←(IDLARRAY-CMLARRAY X))
(YARRAY ←(IDLARRAY-CMLARRAY Y)) for I from 0
upto N collect (CREATEPOSITION (AREF XARRAY I)
(AREF YARRAY I)))
LABEL WIDTH MENU NODRAWFLG])
(ADDFILLEDRECTANGLES
[LAMBDA (PLOT PARAM-MATRIX LABELS SHADE WIDTH MENU NODRAWFLG)
(* jop: "27-Jun-86 13:57")
(* *)
(if [NOT (OR (AND (EQ 2 (IDLARRAY-RANK PARAM-MATRIX))
(EQ 4 (IDLARRAY-DIMENSION PARAM-MATRIX 1))
(IDLARRAY-ELTTYPEP PARAM-MATRIX (QUOTE NUMERIC)))
(AND (EQ 1 (IDLARRAY-RANK PARAM-MATRIX))
(EQ 4 (IDLARRAY-TOTALSIZE PARAM-MATRIX))
(EQ (IDLARRAY-TOTALSIZE (IDLARRAY-REF PARAM-MATRIX 0))
(IDLARRAY-TOTALSIZE (IDLARRAY-REF PARAM-MATRIX 1)))
(EQ (IDLARRAY-TOTALSIZE (IDLARRAY-REF PARAM-MATRIX 0))
(IDLARRAY-TOTALSIZE (IDLARRAY-REF PARAM-MATRIX 2)))
(EQ (IDLARRAY-TOTALSIZE (IDLARRAY-REF PARAM-MATRIX 0))
(IDLARRAY-TOTALSIZE (IDLARRAY-REF PARAM-MATRIX 3]
then (ERROR "PARAM-MATRIX of incorrect form" PARAM-MATRIX))
(if (EQ 2 (IDLARRAY-RANK PARAM-MATRIX))
then [bind (CMLARRAY ←(IDLARRAY-CMLARRAY PARAM-MATRIX)) for I from 0
upto (IDLARRAY-DIMENSION PARAM-MATRIX 0)
collect (PROG1 (PLOTFILLEDRECTANGLE PLOT (AREF CMLARRAY I 0)
(AREF CMLARRAY I 1)
(AREF CMLARRAY I 2)
(AREF CMLARRAY I 3)
(OR (CAR LABELS)
(IDLARRAY-GETLEVELLABEL
PARAM-MATRIX 0 I)
)
SHADE WIDTH MENU NODRAWFLG)
(SETQ LABELS (CDR LABELS]
else (LET* ((LEFTARRAY (IDLARRAY-REF PARAM-MATRIX 0))
(BOTTOMARRAY (IDLARRAY-REF PARAM-MATRIX 1))
(WIDTHARRAY (IDLARRAY-REF PARAM-MATRIX 2))
(HEIGHTARRAY (IDLARRAY-REF PARAM-MATRIX 3))
(N (IDLARRAY-TOTALSIZE LEFTARRAY)))
[if (NULL LABELS)
then (SETQ LABELS (if (IDLARRAY-HAS-LEVELLABELS-P LEFTARRAY)
then (IDLARRAY-LEVELLABELS LEFTARRAY 0)
elseif (IDLARRAY-HAS-LEVELLABELS-P BOTTOMARRAY)
then (IDLARRAY-LEVELLABELS BOTTOMARRAY 0)
elseif (IDLARRAY-HAS-LEVELLABELS-P WIDTHARRAY)
then (IDLARRAY-LEVELLABELS WIDTHARRAY 0)
else (IDLARRAY-LEVELLABELS HEIGHTARRAY 0]
(bind (LARRAY ←(IDLARRAY-CMLARRAY LEFTARRAY))
(BARRAY ←(IDLARRAY-CMLARRAY BOTTOMARRAY))
(WARRAY ←(IDLARRAY-CMLARRAY WIDTHARRAY))
(HARRAY ←(IDLARRAY-CMLARRAY HEIGHTARRAY)) for I from 0
upto N collect (PROG1 (PLOTFILLEDRECTANGLE PLOT (AREF LARRAY I)
(AREF BARRAY I)
(AREF WARRAY I)
(AREF HARRAY I)
(CAR LABELS)
SHADE WIDTH MENU NODRAWFLG)
(SETQ LABELS (CDR LABELS])
(ADDLINES
[LAMBDA (PLOT PARAM-MATRIX LABELS WIDTH MENU NODRAWFLG) (* jop: "27-Jun-86 13:42")
(* *)
(if [NOT (OR (AND (EQ 2 (IDLARRAY-RANK PARAM-MATRIX))
(EQ 2 (IDLARRAY-DIMENSION PARAM-MATRIX 1))
(IDLARRAY-ELTTYPEP PARAM-MATRIX (QUOTE NUMERIC)))
(AND (EQ 1 (IDLARRAY-RANK PARAM-MATRIX))
(EQ 2 (IDLARRAY-TOTALSIZE PARAM-MATRIX))
(IDLARRAY-ELTTYPEP (IDLARRAY-REF PARAM-MATRIX 0)
(QUOTE NUMERIC))
(IDLARRAY-ELTTYPEP (IDLARRAY-REF PARAM-MATRIX 1)
(QUOTE NUMERIC))
(EQ (IDLARRAY-TOTALSIZE (IDLARRAY-REF PARAM-MATRIX 0))
(IDLARRAY-TOTALSIZE (IDLARRAY-REF PARAM-MATRIX 1]
then (ERROR "PARAM-MATRIX of incorrect form" PARAM-MATRIX))
(if (EQ 2 (IDLARRAY-RANK PARAM-MATRIX))
then [bind (CMLARRAY ←(IDLARRAY-CMLARRAY PARAM-MATRIX)) for I from 0
upto (IDLARRAY-DIMENSION PARAM-MATRIX 0)
collect (PROG1 (PLOTLINE PLOT (AREF CMLARRAY I 0)
(AREF CMLARRAY I 1)
(OR (CAR LABELS)
(IDLARRAY-GETLEVELLABEL PARAM-MATRIX 0 I))
WIDTH MENU NODRAWFLG)
(SETQ LABELS (CDR LABELS]
else (LET* ((SLOPE (IDLARRAY-REF PARAM-MATRIX 0))
(CONST (IDLARRAY-REF PARAM-MATRIX 1))
(N (IDLARRAY-TOTALSIZE SLOPE)))
[if (NULL LABELS)
then (SETQ LABELS (if (IDLARRAY-HAS-LEVELLABELS-P SLOPE)
then (bind SLOPELABEL for I from 0
upto N
collect (SETQ SLOPELABEL
(IDLARRAY-GETLEVELLABEL
SLOPE 0 I))
(if (NOT (LITATOM
SLOPELABEL))
then (
IDLARRAY-GETLEVELLABEL
CONST 0 I)
else SLOPELABEL))
else (IDLARRAY-LEVELLABELS CONST 0]
(bind (XARRAY ←(IDLARRAY-CMLARRAY SLOPE))
(YARRAY ←(IDLARRAY-CMLARRAY CONST)) for I from 0 upto N
collect (PROG1 (PLOTLINE PLOT (AREF XARRAY I)
(AREF YARRAY I)
(CAR LABELS)
WIDTH MENU NODRAWFLG)
(SETQ LABELS (CDR LABELS])
(ADDPOINTS
[LAMBDA (PLOT XYMATRIX LABELS SYMBOL MENU NODRAWFLG) (* jop: "27-Jun-86 13:25")
(* *)
(if [NOT (OR (AND (EQ 2 (IDLARRAY-RANK XYMATRIX))
(EQ 2 (IDLARRAY-DIMENSION XYMATRIX 1))
(IDLARRAY-ELTTYPEP XYMATRIX (QUOTE NUMERIC)))
(AND (EQ 1 (IDLARRAY-RANK XYMATRIX))
(EQ 2 (IDLARRAY-TOTALSIZE XYMATRIX))
(IDLARRAY-ELTTYPEP (IDLARRAY-REF XYMATRIX 0)
(QUOTE NUMERIC))
(IDLARRAY-ELTTYPEP (IDLARRAY-REF XYMATRIX 1)
(QUOTE NUMERIC))
(EQ (IDLARRAY-TOTALSIZE (IDLARRAY-REF XYMATRIX 0))
(IDLARRAY-TOTALSIZE (IDLARRAY-REF XYMATRIX 1]
then (ERROR "XYMATRIX of incorrect form" XYMATRIX))
(if (EQ 2 (IDLARRAY-RANK XYMATRIX))
then (PLOTPOINTS PLOT (bind (CMLARRAY ←(IDLARRAY-CMLARRAY XYMATRIX)) for I
from 0 upto (IDLARRAY-DIMENSION XYMATRIX 0)
collect (CREATEPOSITION (AREF CMLARRAY I 0)
(AREF CMLARRAY I 1)))
(OR LABELS (IDLARRAY-LEVELLABELS XYMATRIX 0))
SYMBOL MENU NODRAWFLG)
else (LET* ((X (IDLARRAY-REF XYMATRIX 0))
(Y (IDLARRAY-REF XYMATRIX 1))
(N (IDLARRAY-TOTALSIZE X)))
(PLOTPOINTS PLOT (bind (XARRAY ←(IDLARRAY-CMLARRAY X))
(YARRAY ←(IDLARRAY-CMLARRAY Y)) for I from 0
upto N collect (CREATEPOSITION (AREF XARRAY I)
(AREF YARRAY I)))
(OR LABELS (if (IDLARRAY-HAS-LEVELLABELS-P X)
then (bind XLABEL for I from 0
upto N
collect (SETQ XLABEL
(IDLARRAY-GETLEVELLABEL
X 0 I))
(if (NOT (LITATOM XLABEL))
then (
IDLARRAY-GETLEVELLABEL
Y 0 I)
else XLABEL))
else (IDLARRAY-LEVELLABELS Y 0)))
SYMBOL MENU NODRAWFLG])
(ADDPOLYGON
[LAMBDA (PLOT XYMATRIX LABEL WIDTH MENU NODRAWFLG) (* jop: "27-Jun-86 13:31")
(* *)
(if [NOT (OR (AND (EQ 2 (IDLARRAY-RANK XYMATRIX))
(EQ 2 (IDLARRAY-DIMENSION XYMATRIX 1))
(IDLARRAY-ELTTYPEP XYMATRIX (QUOTE NUMERIC)))
(AND (EQ 1 (IDLARRAY-RANK XYMATRIX))
(EQ 2 (IDLARRAY-TOTALSIZE XYMATRIX))
(IDLARRAY-ELTTYPEP (IDLARRAY-REF XYMATRIX 0)
(QUOTE NUMERIC))
(IDLARRAY-ELTTYPEP (IDLARRAY-REF XYMATRIX 1)
(QUOTE NUMERIC))
(EQ (IDLARRAY-TOTALSIZE (IDLARRAY-REF XYMATRIX 0))
(IDLARRAY-TOTALSIZE (IDLARRAY-REF XYMATRIX 1]
then (ERROR "XYMATRIX of incorrect form" XYMATRIX))
[if (NULL LABEL)
then (SETQ LABEL (if (AND (EQ 2 (IDLARRAY-RANK XYMATRIX))
(LITATOM (IDLARRAY-GETDIMLABEL XYMATRIX 1)))
then (IDLARRAY-GETDIMLABEL XYMATRIX 1]
(if (EQ 2 (IDLARRAY-RANK XYMATRIX))
then (PLOTPOLYGON PLOT (bind (CMLARRAY ←(IDLARRAY-CMLARRAY XYMATRIX)) for I
from 0 upto (IDLARRAY-DIMENSION XYMATRIX 0)
collect (CREATEPOSITION (AREF CMLARRAY I 0)
(AREF CMLARRAY I 1)))
LABEL WIDTH MENU NODRAWFLG)
else (LET* ((X (IDLARRAY-REF XYMATRIX 0))
(Y (IDLARRAY-REF XYMATRIX 1))
(N (IDLARRAY-TOTALSIZE X)))
(PLOTPOLYGON PLOT (bind (XARRAY ←(IDLARRAY-CMLARRAY X))
(YARRAY ←(IDLARRAY-CMLARRAY Y)) for I
from 0 upto N collect (CREATEPOSITION (AREF
XARRAY I)
(AREF
YARRAY I)))
LABEL WIDTH MENU NODRAWFLG])
(BARPLOT
[LAMBDA (BATCH XLABEL YLABEL SHADE NODRAWFLG) (* jop: "24-Jun-86 20:24")
(* *)
(if [NOT (AND (EQ 1 (IDLARRAY-RANK BATCH))
(IDLARRAY-ELTTYPEP BATCH (QUOTE NUMERIC]
then (ERROR "BATCH of incorrect form" BATCH))
(if (NULL SHADE)
then (SETQ SHADE SHADE3))
(LET [(BARPLOT (CREATEPLOT))
(N (IDLARRAY-TOTALSIZE BATCH))
(PTITLE (if XLABEL
then (CONCAT "Barplot of " XLABEL)
else "Barplot"))
(BARMENUITEMS (QUOTE ((Label BARPLOT.CHANGELABEL "Change label for this bar"]
(PLOTPROP BARPLOT (QUOTE N)
N)
(PLOTPROP BARPLOT (QUOTE SHADE)
SHADE)
(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 NODRAWFLG)
BARPLOT])
(BARPLOT.CHANGELABEL
[LAMBDA (BOX BARPLOT) (* jop: "24-Jun-86 20:24")
(* *)
(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
[LAMBDA (BARPLOT NODRAWFLG) (* jop: "24-Jun-86 20:23")
(* *)
(LET [(BATCH (PLOTPROP BARPLOT (QUOTE BATCH)))
(N (PLOTPROP BARPLOT (QUOTE N)))
(SHADE (PLOTPROP BARPLOT (QUOTE SHADE]
(bind RECTANGLE for I from 0 upto N as LOWMARK from .1 by 1.0
do (SETQ RECTANGLE (PLOTFILLEDRECTANGLE BARPLOT LOWMARK 0 .8 (IDLARRAY-REF BATCH
I)
(IDLARRAY-GETLEVELLABEL BATCH 0 I)
SHADE NIL (QUOTE BARMENU)
T))
(PLOTOBJECTPROP RECTANGLE (QUOTE BOXLEFT)
LOWMARK)
(PLOTOBJECTPROP RECTANGLE (QUOTE BOXRIGHT)
(FPLUS LOWMARK .8)))
(RESCALEPLOT BARPLOT (QUOTE BOTH)
T)
(if (NULL NODRAWFLG)
then (REDRAWPLOTWINDOW BARPLOT])
(BARPLOT.TICFN
[LAMBDA (MARGIN PLOTSCALE BARPLOT) (* jop: "24-Jun-86 20:21")
(* * 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 BATCHLABELS XLABEL YLABEL TITLE NODRAWFLG)
(* jop: "27-Jun-86 14:31")
(* * Made NO SPREAD to accomodate batches of unequal size)
(if [NOT (AND (EQ 1 (IDLARRAY-RANK BATCHES))
(bind B for I from 0 upto (IDLARRAY-RANK BATCHES)
always (SETQ B (IDLARRAY-REF BATCHES I))
(AND (EQ 1 (IDLARRAY-RANK B))
(IDLARRAY-ELTTYPEP B (QUOTE NUMERIC]
then (ERROR "BATCHES must be a vector of vectors"))
(if (NULL TITLE)
then (SETQ TITLE (if XLABEL
then (CONCAT "Boxplots of" XLABEL)
else "Boxplots")))
(if (NULL XLABEL)
then (SETQ XLABEL "Batches"))
(LET ((BOXPLOT (CREATEPLOT))
[BOXMENU (QUOTE ((Summary BOXPLOT.SUMMARY "Printout quantile summary for this batch"
(SUBITEMS (Long (BOXPLOT.SUMMARY T)
"Long summary outout")
(Short BOXPLOT.SUMMARY "Short summary output")))
(Label BOXPLOT.LABEL "Change label for this batch")
(Histogram BOXPLOT.HISTOGRAM "Generate a histogram for this batch")
(Move BOXPLOT.MOVE "Move boxplot")
(Delete BOXPLOT.DELETE "Delete boxplot from batch"]
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 LEFT)
YLABEL T)
(PLOTLABEL BOXPLOT (QUOTE BOTTOM)
XLABEL T)
(PLOTLABEL BOXPLOT (QUOTE TOP)
TITLE T)
[SETQ BOXES (bind (BOXLEFT ← .2)
(BOXRIGHT ← .8) for I from 0 upto (IDLARRAY-TOTALSIZE BATCHES)
collect (PROG1 (BOXPLOT.MAKEBOX (IDLARRAY-REF BATCHES I)
BOXLEFT BOXRIGHT
(OR (CAR BATCHLABELS)
(CONCAT "Batch " I)))
(SETQ BOXLEFT (PLUS BOXLEFT 1))
(SETQ BOXRIGHT (PLUS BOXRIGHT 1))
(SETQ BATCHLABELS (CDR BATCHLABELS]
(for BOX in BOXES do (ADDPLOTOBJECT BOX BOXPLOT T))
(if (NULL NODRAWFLG)
then (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
[LAMBDA (MARGIN PLOTSCALE BOXPLOT) (* jop: "24-Jun-86 20:38")
(* * 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
[LAMBDA (BOX BOXPLOT) (* jop: "24-Jun-86 20:41")
(* *)
(PROG ((BOXES (for OBJECT in (PLOTPROP BOXPLOT (QUOTE PLOTOBJECTS))
when (AND (PLOTOBJECTSUBTYPE? COMPOUND OBJECT)
(EQ (COMPOUNDSUBTYPE OBJECT)
(QUOTE BOX)))
collect OBJECT))) (* DELETE BOX from display list of BOXPLOT)
(DELETEPLOTOBJECT BOX BOXPLOT T T)
[SETQ BOXES (DREMOVE BOX (SORT BOXES (FUNCTION BOXPLOT.COMPAREFN]
(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)))
(add LEFTCOUNTER 1.0))
(RESCALEPLOT BOXPLOT (QUOTE X)
T)
(REDRAWPLOTWINDOW BOXPLOT])
(BOXPLOT.LABEL
[LAMBDA (BOX BOXPLOT) (* jop: "24-Jun-86 20:44")
(* *)
(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
[LAMBDA (BOX BOXPLOT) (* jop: "24-Jun-86 20:45")
(* *)
(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)))
(add 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
[LAMBDA (BOX BOXPLOT) (* jop: "24-Jun-86 20:53")
(* *)
(HISTOGRAM (PLOTOBJECTPROP BOX (QUOTE BATCH))
NIL
(PLOTOBJECTPROP BOX (QUOTE OBJECTLABEL])
(BOXPLOT.MAKEBOX
[LAMBDA (BATCH BOXLEFT BOXRIGHT DEFAULTLABEL OBATCH) (* jop: "24-Jun-86 20:35")
(* *)
[if (NULL OBATCH)
then (SETQ OBATCH (EARRAY-INDEX-SORT (IDLARRAY-CMLARRAY BATCH]
(LET* ((LETTERVALUES (GETLETTERVALUES BATCH 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 (SUB1 (PLOT.CEILING (fetch FOURTHDEPTH of LETTERVALUES))
)
to 0 by -1 until (LESSP (IDLARRAY-REF BATCH (AREF OBATCH I))
LINNERFENCE)
finally (RETURN (if (EQ I 0)
then 0
else (ADD1 I]
[UADJACENT (for I from (PLOT.FLOOR (DIFFERENCE N (fetch FOURTHDEPTH
of LETTERVALUES)))
upto N until (GREATERP (IDLARRAY-REF BATCH (AREF OBATCH I))
UINNERFENCE)
finally (RETURN (if (EQ I (SUB1 N))
then (SUB1 N)
else (SUB1 I]
(LABEL DEFAULTLABEL)
(BOXOBJECT (MAKEBOXOBJECT BOXLEFT BOXRIGHT (IDLARRAY-REF BATCH (AREF OBATCH
LADJACENT))
(IDLARRAY-REF BATCH (AREF 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)
(IDLARRAY-REF BATCH (AREF OBATCH LADJACENT)))
(PLOTOBJECTPROP BOXOBJECT (QUOTE UADJACENT)
(IDLARRAY-REF BATCH (AREF OBATCH UADJACENT)))
[PLOTOBJECTPROP BOXOBJECT (QUOTE LOWEROUTSIDE)
(for I from (SUB1 LADJACENT) to 0 by -1
collect (CREATEPOINT (CREATEPOSITION BOXMIDDLE
(IDLARRAY-REF
BATCH
(AREF OBATCH I)))
(IDLARRAY-GETLEVELLABEL BATCH 0
(AREF OBATCH I]
[PLOTOBJECTPROP BOXOBJECT (QUOTE UPPEROUTSIDE)
(bind POINT for I from (ADD1 UADJACENT) upto N
collect (CREATEPOINT (CREATEPOSITION BOXMIDDLE
(IDLARRAY-REF
BATCH
(AREF OBATCH I)))
(IDLARRAY-GETLEVELLABEL BATCH 0
(AREF 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
[LAMBDA (OBJECT BOXPLOT LONGFLG) (* jop: "24-Jun-86 20:38")
(* *)
(SUMMARYWINDOW.PRINT BOXPLOT (LIST (CONCAT "Batch " (PLOTOBJECTPROP OBJECT (QUOTE
OBJECTLABEL)))
(LIST (FUNCTION LETTER.VALUE.DISPLAY)
(PLOTOBJECTPROP OBJECT (QUOTE LETTERVALUES))
LONGFLG])
(COPYBOXPLOT
[LAMBDA (NEWBOX OLDBOX BOXPLOT PROPNAME) (* jop: "24-Jun-86 17:53")
(* * Copies the prop list of OLDBOX to NEWBOX)
(SELECTQ PROPNAME
(BATCH (PLOTOBJECTPROP OLDBOX (QUOTE BATCH)))
(LETTERVALUES (PLOTOBJECTPROP OLDBOX (QUOTE LETTERVALUES)))
NIL])
(COPYHISTOGRAM
[LAMBDA (NEWHIST OLDHIST PROPNAME) (* jop: "24-Jun-86 17:23")
(* * 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)))
(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
[LAMBDA (NEWSCATTERPLOT OLDSCATTERPLOT PROPNAME) (* jop: "24-Jun-86 16:15")
(* * 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])
(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])
(GETLETTERVALUES
[LAMBDA (BATCH ORDEREDBATCH) (* jop: "24-Jun-86 20:18")
(* * COMPUTE the Median, Hinges, Eigths, and Extremes of BATCH)
[if (NULL ORDEREDBATCH)
then (SETQ ORDEREDBATCH (EARRAY-INDEX-SORT (IDLARRAY-CMLARRAY BATCH]
(LET* ((N (IDLARRAY-TOTALSIZE BATCH))
(DEPTH (FQUOTIENT (ADD1 N)
2))
(LETTERVALUES (create LETTERVALUES
N ← N)))
(replace MEDIAN of LETTERVALUES with (GETVALUEATDEPTH BATCH ORDEREDBATCH DEPTH))
(replace MEDIANDEPTH of LETTERVALUES with DEPTH)
(SETQ DEPTH (FQUOTIENT (ADD1 (FIX DEPTH))
2))
(replace LOWERFOURTH of LETTERVALUES with (GETVALUEATDEPTH BATCH ORDEREDBATCH DEPTH)
)
[replace UPPERFOURTH of LETTERVALUES with (GETVALUEATDEPTH
BATCH ORDEREDBATCH
(PLUS 1 (FDIFFERENCE N (FIX DEPTH]
(replace FOURTHDEPTH of LETTERVALUES with DEPTH)
(SETQ DEPTH (FQUOTIENT (ADD1 (FIX DEPTH))
2))
(replace LOWEREIGHTH of LETTERVALUES with (GETVALUEATDEPTH BATCH ORDEREDBATCH DEPTH)
)
[replace UPPEREIGHTH of LETTERVALUES with (GETVALUEATDEPTH
BATCH ORDEREDBATCH
(PLUS 1 (FDIFFERENCE N (FIX DEPTH]
(replace EIGHTHDEPTH of LETTERVALUES with DEPTH)
(replace LOWEREXTREME of LETTERVALUES with (IDLARRAY-REF BATCH (AREF ORDEREDBATCH
0)))
[replace UPPEREXTREME of LETTERVALUES with (IDLARRAY-REF BATCH (AREF
ORDEREDBATCH
(SUB1 N]
LETTERVALUES])
(GETSUMMARYWINDOW
[LAMBDA (CHARHEIGHT) (* jop: "24-Jun-86 18:19")
(* * 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
[LAMBDA (BATCH ORDEREDBATCH DEPTH) (* jop: "24-Jun-86 17:41")
(* *)
(if (EQ (PLOT.FLOOR DEPTH)
DEPTH)
then [IDLARRAY-REF BATCH (AREF ORDEREDBATCH (SUB1 (FIX DEPTH]
else (FQUOTIENT [PLUS [IDLARRAY-REF BATCH (AREF ORDEREDBATCH (SUB1 (PLOT.FLOOR
DEPTH]
(IDLARRAY-REF BATCH (AREF ORDEREDBATCH (SUB1 (PLOT.CEILING
DEPTH]
2])
(HISTOGRAM
[LAMBDA (BATCH NBINS XLABEL TITLE SHADE NODRAWFLG) (* edited: "17-Feb-87 12:35")
(* *)
(if [NOT (AND (EQ 1 (IDLARRAY-RANK BATCH))
(IDLARRAY-ELTTYPEP BATCH (QUOTE NUMERIC]
then (ERROR "BATCH of incorrect form" BATCH))
(if (NULL TITLE)
then (SETQ TITLE (if XLABEL
then (CONCAT "Histogram of " XLABEL)
else "Histogram")))
(if (NULL SHADE)
then (SETQ SHADE SHADE3))
(LET* ((HISTOGRAM (CREATEPLOT))
[BINMENU (QUOTE (("Values" HISTOGRAM.VALUES "Inspect values in bin"]
[RIGHTMENUITEMS (QUOTE (("Change bins" HISTOGRAM.CHANGEBINS "Change number of bins"
(SUBITEMS (Reset (HISTOGRAM.RESET T)
"Reset range and bin interval to original value")))
("Summary" HISTOGRAM.SUMMARY "Attach quantile summary"
(SUBITEMS (Long (HISTOGRAM.SUMMARY T)
"Long summary")
(Short HISTOGRAM.SUMMARY "Short summary")))
("Display quantiles" HISTOGRAM.DISPLAYQUANTILES
"Overlay graph of some quantiles")
("IT ← Batch" HISTOGRAM.GETBATCH
"Bind IT to the Batch displayed"]
(N (IDLARRAY-TOTALSIZE BATCH))
(INTFLG (IDLARRAY-SUBTYPEP (IDLARRAY-ELTTYPE BATCH)
(QUOTE INTEGER)))
(OBATCH (EARRAY-INDEX-SORT (IDLARRAY-CMLARRAY BATCH)))
(YLABEL "Frequency"))
[if (NULL NBINS)
then (SETQ NBINS (if (ILESSP N 20)
then (FIXR (TIMES 2 (SQRT N)))
else (FIXR (TIMES 10 (PLOT.LOG10 N]
(PLOTPROP HISTOGRAM (QUOTE N)
N)
(PLOTPROP HISTOGRAM (QUOTE NBINS)
NBINS)
(PLOTPROP HISTOGRAM (QUOTE INTFLG)
INTFLG)
(PLOTPROP HISTOGRAM (QUOTE SHADE)
SHADE)
(PLOTPROP HISTOGRAM (QUOTE BATCH)
BATCH)
(PLOTPROP HISTOGRAM (QUOTE OBATCH)
OBATCH)
(PLOTPROP HISTOGRAM (QUOTE LETTERVALUES)
(GETLETTERVALUES BATCH 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)
TITLE 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 NODRAWFLG)
(PLOTPROP HISTOGRAM (QUOTE COPYFN)
(FUNCTION COPYHISTOGRAM))
HISTOGRAM])
(HISTOGRAM.BOXSUMMARY
[LAMBDA (BOX HISTOGRAM) (* jop: "24-Jun-86 18:14")
(* *)
(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
[LAMBDA (HISTOGRAM) (* jop: "24-Jun-86 18: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)
(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
[LAMBDA (BOX HISTOGRAM NODRAWFLG) (* jop: "24-Jun-86 17:47")
(* * DELETE QUANTILE DISPLAY)
(if BOX
then (DELETEPLOTOBJECT BOX HISTOGRAM NODRAWFLG)
(PLOTPROP HISTOGRAM (QUOTE QUANTILEDISPLAY)
NIL)
(RESCALEPLOT HISTOGRAM (QUOTE Y)
NODRAWFLG])
(HISTOGRAM.DISPLAYQUANTILES
[LAMBDA (HISTOGRAM NODRAWFLG) (* jop: "24-Jun-86 18:13")
(* * DISPLAY QUANTILES GRAPHICALLY)
[if (NOT (PLOTMENUITEMS HISTOGRAM (QUOTE BOXMENU)))
then (PLOTMENUITEMS HISTOGRAM (QUOTE BOXMENU)
(QUOTE ((Summary HISTOGRAM.BOXSUMMARY "Printout summary statistics")
(Delete 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 OBATCH]
(ADDPLOTOBJECT (PLOTPROP HISTOGRAM (QUOTE QUANTILEDISPLAY))
HISTOGRAM NODRAWFLG])
(HISTOGRAM.DRAW
[LAMBDA (HISTOGRAM NODRAWFLG) (* jop: "24-Jun-86 18:17")
(* *)
(LET* ((SHADE (PLOTPROP HISTOGRAM (QUOTE SHADE)))
(INTFLG (PLOTPROP HISTOGRAM (QUOTE INTFLG)))
(N (PLOTPROP HISTOGRAM (QUOTE N)))
(BATCH (PLOTPROP HISTOGRAM (QUOTE BATCH)))
(OBATCH (PLOTPROP HISTOGRAM (QUOTE OBATCH)))
(BININTERVAL (OR (PLOTPROP HISTOGRAM (QUOTE BININTERVAL))
(LET ((NEWINTERVAL (HISTOGRAM.MAKEBININTERVAL
(IDLARRAY-REF BATCH (AREF OBATCH 0))
(IDLARRAY-REF BATCH (AREF OBATCH (SUB1
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 ← 0)
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 (SUB1 N))
(LESSP (IDLARRAY-REF
BATCH
(AREF 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 (EQ 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)
(if (NULL NODRAWFLG)
then (REDRAWPLOTWINDOW HISTOGRAM])
(HISTOGRAM.GETBATCH
[LAMBDA (PLOT) (* edited: "17-Feb-87 12:37")
(LET [(BATCH (PLOTPROP PLOT (QUOTE BATCH]
(PROMPTPRINT "IT set to" BATCH)
(SETQ IT BATCH])
(HISTOGRAM.INTSCALEFN
[LAMBDA (MIN MAX TICINFO) (* jop: "24-Jun-86 17:21")
(* *)
(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
[LAMBDA (HISTOGRAM) (* jop: "24-Jun-86 18:21")
(* *)
(PROG [(N (PLOTPROP HISTOGRAM (QUOTE N]
[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
[LAMBDA (HISTOGRAM LONGFLG) (* jop: "24-Jun-86 17:47")
(* *)
(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
[LAMBDA (RECTANGLE HISTOGRAM) (* jop: "24-Jun-86 18:24")
(* *)
(PROG ((N (PLOTPROP HISTOGRAM (QUOTE N)))
(BATCH (PLOTPROP HISTOGRAM (QUOTE BATCH)))
(LOWMARK (PLOTOBJECTPROP RECTANGLE (QUOTE LOWMARK)))
(HIGHMARK (PLOTOBJECTPROP RECTANGLE (QUOTE HIGHMARK)))
SELECTION)
(SETQ SELECTION (ASVECTOR (for I from 0 upto N
when (AND (GEQ (IDLARRAY-REF BATCH I)
LOWMARK)
(LESSP (IDLARRAY-REF BATCH I)
HIGHMARK))
collect I)))
(INSPECT (AT BATCH (ASVECTOR* SELECTION])
(LETTER.VALUE.DISPLAY
[LAMBDA (STREAM LETTERVALUES LONGFLG) (* jop: "24-Jun-86 17:46")
(* * 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
[LAMBDA (XYMATRIX XLABEL YLABEL SYMBOL NODRAWFLG) (* jop: "27-Jun-86 14:22")
(* *)
(if [NOT (OR (AND (EQ 2 (IDLARRAY-RANK XYMATRIX))
(EQ 2 (IDLARRAY-DIMENSION XYMATRIX 1))
(IDLARRAY-ELTTYPEP XYMATRIX (QUOTE NUMERIC)))
(AND (EQ 1 (IDLARRAY-RANK XYMATRIX))
(EQ 2 (IDLARRAY-TOTALSIZE XYMATRIX))
(IDLARRAY-ELTTYPEP (IDLARRAY-REF XYMATRIX 0)
(QUOTE NUMERIC))
(IDLARRAY-ELTTYPEP (IDLARRAY-REF XYMATRIX 1)
(QUOTE NUMERIC))
(EQ (IDLARRAY-TOTALSIZE (IDLARRAY-REF XYMATRIX 0))
(IDLARRAY-TOTALSIZE (IDLARRAY-REF XYMATRIX 1]
then (ERROR "XYMATRIX of incorrect form" XYMATRIX))
[if (AND (EQ 2 (IDLARRAY-RANK XYMATRIX))
(NULL XLABEL))
then (SETQ XLABEL (AND (LITATOM (IDLARRAY-GETLEVELLABEL XYMATRIX 1 0))
(IDLARRAY-GETLEVELLABEL XYMATRIX 1 0]
[if (AND (EQ 2 (IDLARRAY-RANK XYMATRIX))
(NULL YLABEL))
then (SETQ YLABEL (AND (LITATOM (IDLARRAY-GETLEVELLABEL XYMATRIX 1 1))
(IDLARRAY-GETLEVELLABEL XYMATRIX 1 1]
(LET* ((SCATTERPLOT (CREATEPLOT))
[RIGHTMENUITEMS (QUOTE ((Coordinates SCATTERPLOT.WORLDCOORD
"Display world coordinates at cursor position")
(Regress SCATTERPLOT.REGRESS "Display a linear regression line"]
[POINTMENUITEMS (APPEND (COPY (PLOTMENUITEMS SCATTERPLOT (QUOTE MIDDLE)))
(QUOTE ((Coordinates SCATTERPLOT.POINTCOORDS
"Display point coordinates"]
(PTITLE (if (AND XLABEL YLABEL)
then (CONCAT "Scatterplot of " YLABEL " vs " XLABEL)
else "Scatterplot")))
(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)
(if (EQ SYMBOL (QUOTE LINE))
then (ADDCURVE SCATTERPLOT XYMATRIX NIL NIL NIL T)
else (ADDPOINTS SCATTERPLOT XYMATRIX NIL SYMBOL (QUOTE POINTMENU)
T))
(RESCALEPLOT SCATTERPLOT (QUOTE BOTH)
T)
(PLOTPROP SCATTERPLOT (QUOTE COPYFN)
(FUNCTION COPYSCATTERPLOT))
(if (NULL NODRAWFLG)
then (OPENPLOTWINDOW SCATTERPLOT))
SCATTERPLOT])
(SCATTERPLOT-MATRIX
[LAMBDA (MATRIX SYMBOL) (* edited: "15-Feb-87 17:40")
(if [NOT (AND (EQ 2 (IDLARRAY-RANK MATRIX))
(IDLARRAY-ELTTYPEP MATRIX (QUOTE FLOAT]
then (ERROR "MATRIX of incorrect form" MATRIX))
(SCATMAT (IDLARRAY-CMLARRAY MATRIX)
(COPY (IDLARRAY-LEVELLABELS MATRIX 1))
SYMBOL])
(SCATTERPLOT.POINTCOORDS
[LAMBDA (POINTOBJECT SCATTERPLOT) (* jop: "24-Jun-86 16:49")
(* *)
(LET ((POINTPOSITION (fetch POINTPOSITION of (fetch OBJECTDATA of POINTOBJECT)))
(XLABEL (CONCAT (OR (PLOTLABEL SCATTERPLOT (QUOTE BOTTOM))
"XCOORD")
" "))
(YLABEL (CONCAT " " (OR (PLOTLABEL SCATTERPLOT (QUOTE LEFT))
"YCOORD")
" ")))
(PLOTPROMPT (CONCAT XLABEL (fetch XCOORD of POINTPOSITION)
YLABEL
(fetch YCOORD of POINTPOSITION))
SCATTERPLOT])
(SCATTERPLOT.REGRESS
[LAMBDA (SCATTERPLOT) (* jop: "24-Jun-86 16:40")
(* *)
(LET ((PLOTOBJECTS (fetch PLOTOBJECTS of SCATTERPLOT))
(N 0)
LINEOBJECT SLOPE CONSTANT CXX CXY XBAR YBAR)
[if (NULL (PLOTMENU SCATTERPLOT (QUOTE REGRESSMENU)))
then (PLOTMENUITEMS SCATTERPLOT (QUOTE REGRESSMENU)
(APPEND (PLOTMENUITEMS SCATTERPLOT (QUOTE MIDDLE))
(QUOTE ((Coefficients 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 X Y declare (TYPE FLOATP SX SY SSX SSY SXY X Y) for OBJECT
in PLOTOBJECTS when (PLOTOBJECTSUBTYPE? POINT OBJECT)
do (SETQ POSITION (fetch POINTPOSITION of (fetch OBJECTDATA of OBJECT)))
(SETQ X (fetch XCOORD of POSITION))
(SETQ Y (fetch YCOORD of POSITION))
(SETQ SX (FPLUS SX X))
(SETQ SY (FPLUS SY Y))
(SETQ SSX (FPLUS SSX (FTIMES X X)))
(SETQ SSY (FPLUS SSY (FTIMES Y Y)))
(SETQ SXY (FPLUS SXY (FTIMES X Y)))
(SETQ N (ADD1 N))
finally (SETQ XBAR (FQUOTIENT SX N))
(SETQ YBAR (FQUOTIENT SY N))
(SETQ CXX (FDIFFERENCE (FQUOTIENT SSX N)
(FTIMES XBAR XBAR)))
(SETQ CXY (FDIFFERENCE (FQUOTIENT SXY N)
(FTIMES XBAR YBAR)))
(SETQ SLOPE (FQUOTIENT CXY CXX))
(SETQ CONSTANT (FDIFFERENCE YBAR (FTIMES 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
[LAMBDA (RLINE SCATTERPLOT) (* jop: "24-Jun-86 16:41")
(* *)
(PLOTPROMPT (CONCAT "Slope: " (PLOTOBJECTPROP RLINE (QUOTE SLOPE))
" Constant: "
(PLOTOBJECTPROP RLINE (QUOTE CONSTANT)))
SCATTERPLOT])
(SCATTERPLOT.SMOOTH
[LAMBDA (SCATTERPLOT) (* edited: "28-Jun-86 16:37")
(* *)
(LET* ((PLOTOBJECTS (fetch (PLOT PLOTOBJECTS) of SCATTERPLOT))
(N (for OBJECT in PLOTOBJECTS count (PLOTOBJECTSUBTYPE? POINT OBJECT)))
(X (MAKE-ARRAY N (QUOTE :ELEMENT-TYPE)
(QUOTE FLOAT)))
(Y (MAKE-ARRAY N (QUOTE :ELEMENT-TYPE)
(QUOTE FLOAT)))
INDICES SMOOTH)
(bind (I ← 0)
POSITION for OBJECT in PLOTOBJECTS when (PLOTOBJECTSUBTYPE? POINT OBJECT)
do (SETQ POSITION (fetch POINTPOSITION of (fetch OBJECTDATA of OBJECT)))
(ASET (FLOAT (fetch XCOORD of POSITION))
X I)
(ASET (FLOAT (fetch YCOORD of POSITION))
Y I)
(SETQ I (ADD1 I)))
(SETQ INDICES (INDEX-FLOAT-ARRAY-SORT X))
(SETQ SMOOTH (MEDIANSMOOTH (EARRAY-REF Y (EARRAY-ASVECTOR (LIST INDICES)))
NIL NIL T))
(PLOTCURVE SCATTERPLOT (for I from 0 upto N collect (CREATEPOSITION
(AREF X (AREF INDICES I)
)
(AREF SMOOTH I)))
"3RSSH smoother" 2])
(SCATTERPLOT.WORLDCOORD
[LAMBDA (SCATTERPLOT) (* jop: "24-Jun-86 16:17")
(* *)
(LET ((PLOTWINDOW (fetch PLOTWINDOW of SCATTERPLOT))
(PLOTPROMPTWINDOW (fetch PLOTPROMPTWINDOW of SCATTERPLOT))
(PLOTVIEWPORT (fetch PLOTWINDOWVIEWPORT of SCATTERPLOT))
(XLABEL (CONCAT (OR (PLOTLABEL SCATTERPLOT (QUOTE BOTTOM))
"X")
" at "))
(YLABEL (CONCAT " " (OR (PLOTLABEL SCATTERPLOT (QUOTE LEFT))
"Y")
" at "))
(OLDCURSORPOS (CONSTANT (create POSITION
XCOORD ← 0
YCOORD ← 0)))
(NEWCURSORPOS (CONSTANT (create POSITION)))
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 (EQ (fetch XCOORD of OLDCURSORPOS)
(fetch XCOORD of NEWCURSORPOS))
(EQ (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
[LAMBDA (WINDOW) (* jop: "24-Jun-86 16:20")
(* * 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 (type? IDLARRAY ITEM)
then (ERROR "PPA not yet implemented")
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
[LAMBDA (PLOT OUTPUT) (* jop: "24-Jun-86 16:21")
(* * 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 )
)
(PUTPROPS IDLPLOTFNS COPYRIGHT ("Xerox Corporation" 1986 1987))
(DECLARE: DONTCOPY
(FILEMAP (NIL (1593 73365 (ADDCURVE 1603 . 3403) (ADDFILLEDRECTANGLES 3405 . 6323) (ADDLINES 6325 .
8707) (ADDPOINTS 8709 . 10797) (ADDPOLYGON 10799 . 12642) (BARPLOT 12644 . 14015) (BARPLOT.CHANGELABEL
14017 . 14613) (BARPLOT.DRAW 14615 . 15522) (BARPLOT.TICFN 15524 . 16024) (BOXPLOTS 16026 . 18619) (
BOXPLOT.COMPAREFN 18621 . 18947) (BOXPLOT.COMPUTETICS 18949 . 19554) (BOXPLOT.DELETE 19556 . 21120) (
BOXPLOT.LABEL 21122 . 21705) (BOXPLOT.MOVE 21707 . 25705) (BOXPLOT.WHENADDEDFN 25707 . 26173) (
BOXPLOT.WHENDELETEDFN 26175 . 26653) (BOXPLOT.HISTOGRAM 26655 . 26913) (BOXPLOT.MAKEBOX 26915 . 30168)
(BOXPLOT.SUMMARY 30170 . 30573) (COPYBOXPLOT 30575 . 30925) (COPYHISTOGRAM 30927 . 31800) (
COPYSCATTERPLOT 31802 . 32411) (FLIPBOX 32413 . 34148) (GETLETTERVALUES 34150 . 35995) (
GETSUMMARYWINDOW 35997 . 37115) (GETVALUEATDEPTH 37117 . 37638) (HISTOGRAM 37640 . 40833) (
HISTOGRAM.BOXSUMMARY 40835 . 41527) (HISTOGRAM.CHANGEBINS 41529 . 43551) (HISTOGRAM.COMPUTEMULT 43553
. 44045) (HISTOGRAM.DELETEQUANTILES 44047 . 44430) (HISTOGRAM.DISPLAYQUANTILES 44432 . 45530) (
HISTOGRAM.DRAW 45532 . 50164) (HISTOGRAM.GETBATCH 50166 . 50413) (HISTOGRAM.INTSCALEFN 50415 . 50691)
(HISTOGRAM.INTTICFN 50693 . 51490) (HISTOGRAM.MAKEBININTERVAL 51492 . 52532) (HISTOGRAM.RESET 52534 .
53009) (HISTOGRAM.SUMMARY 53011 . 53382) (HISTOGRAM.TICFN 53384 . 54386) (HISTOGRAM.VALUES 54388 .
55104) (LETTER.VALUE.DISPLAY 55106 . 58546) (MAKEBOXOBJECT 58548 . 60647) (SCATTERPLOT 60649 . 63513)
(SCATTERPLOT-MATRIX 63515 . 63929) (SCATTERPLOT.POINTCOORDS 63931 . 64561) (SCATTERPLOT.REGRESS 64563
. 66830) (SCATTERPLOT.REGRESSSUMMARY 66832 . 67161) (SCATTERPLOT.SMOOTH 67163 . 68445) (
SCATTERPLOT.WORLDCOORD 68447 . 70590) (SUMMARY.REPAINTFN 70592 . 71416) (SUMMARY.RESHAPEFN 71418 .
72172) (SUMMARYWINDOW.PRINT 72174 . 73363)))))
STOP