(DEFINE-FILE-INFO READTABLE "INTERLISP" PACKAGE "INTERLISP")
(FILECREATED " 5-May-87 15:24:37" {PHYLUM}<LISPUSERS>LYRIC>PLOTEXAMPLES.;1 37750
changes to%: (FNS HISTO.DRAW HISTPLOT MAKEBININTERVAL SCATPLOT SCAT.LOGSCALE LOGTICFN)
previous date%: "18-Jun-86 12:50:08" {PHYLUM}<LISPUSERS>KOTO>PLOTEXAMPLES.;1)
(* "
Copyright (c) 1986, 1987 by Xerox Corporation. All rights reserved.
")
(PRETTYCOMPRINT PLOTEXAMPLESCOMS)
(RPAQQ PLOTEXAMPLESCOMS ((* * HISTOGRAM FNS)
(FNS COMPUTEMULTIPLE HISTO.CHANGEBINS HISTO.COPYFN HISTO.DRAW
HISTO.INTSCALEFN HISTO.INTTICFN HISTO.MAKEBINS HISTO.RESET HISTO.TICFN
HISTO.VALUES HISTPLOT MAKEBININTERVAL SUMMARYWINDOW.REPAINTFN)
(RECORDS BININTERVAL)
(* * SCATTERPLOT FNS)
(FNS SCATPLOT SCAT.LOGSCALE SCAT.POINTCOORDS SCAT.WORLDCOORD LOGTICFN)
(* * Depends on PLOT)
(FILES PLOT)
(MACROS HISTO.GETFREQ HISTO.GETVALUE)
(DECLARE%: DONTCOPY DONTEVAL@LOAD DOEVAL@COMPILE (LOCALVARS . T))))
(* * HISTOGRAM FNS)
(DEFINEQ
(COMPUTEMULTIPLE
[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])
(HISTO.CHANGEBINS
[LAMBDA (HISTOGRAM) (* jop%: "27-Feb-86 15:05")
(* * Allow the use to specify a range and a bin interval for the histogram)
(PROG ((PLOTPROMPTWINDOW (PLOTPROP HISTOGRAM 'PLOTPROMPTWINDOW))
(INTFLG (PLOTPROP HISTOGRAM 'INTFLG))
(BININTERVAL (PLOTPROP HISTOGRAM 'BININTERVAL))
INC START END NBINS)
(SETQ INC (fetch (BININTERVAL BININC) of BININTERVAL))
(SETQ START (fetch (BININTERVAL BINMIN) of BININTERVAL))
(SETQ END (fetch (BININTERVAL BINMAX) of BININTERVAL))
(* have a dialogue with the user)
(TERPRI PLOTPROMPTWINDOW)
[SETQ START (READ (OPENSTRINGSTREAM (PROMPTFORWORD "From " START
"Type start point of bin sequence"
PLOTPROMPTWINDOW]
(SETQ START (if INTFLG
then (PLOT.FLOOR START)
else (FLOAT START)))
[SETQ END (READ (OPENSTRINGSTREAM (PROMPTFORWORD " to " END
"Type end point of bin sequence" PLOTPROMPTWINDOW]
(SETQ END (if INTFLG
then (PLOT.CEILING END)
else (FLOAT END)))
[SETQ INC (READ (OPENSTRINGSTREAM (PROMPTFORWORD " by " INC "Type an increment"
PLOTPROMPTWINDOW]
(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))) (* Inform the user of what will happen)
(PLOTPROMPT (CONCAT "Using: from " START " to " END " by " INC)
HISTOGRAM)
(PLOTPROP HISTOGRAM 'BININTERVAL
(create BININTERVAL
BINMIN ← START
BINMAX ← END
BININC ← INC
NBINS ← NBINS)) (* redraw the histogram based on the
new parameters)
(HISTO.DRAW HISTOGRAM])
(HISTO.COPYFN
[LAMBDA (NEWHIST OLDHIST PROPNAME) (* jop%: "24-Feb-86 23:11")
(SELECTQ PROPNAME
(N (PLOTPROP OLDHIST 'N))
(NBINS (PLOTPROP OLDHIST 'NBINS))
(OBATCH (PLOTPROP OLDHIST 'OBATCH))
(INTFLG (PLOTPROP OLDHIST 'INTFLG))
(BINEDNUMBERS (PLOTPROP OLDHIST 'BINEDNUMBERS))
(MARKS (PLOTPROP OLDHIST 'MARKS))
NIL])
(HISTO.DRAW
[LAMBDA (HISTOGRAM) (* edited%: "27-Mar-86 21:56")
(* *)
(LET* ((SHADE (PLOTPROP HISTOGRAM 'SHADE))
(OBATCH (PLOTPROP HISTOGRAM 'OBATCH))
(INTFLG (PLOTPROP HISTOGRAM 'INTFLG))
(BININTERVAL (OR (PLOTPROP HISTOGRAM 'BININTERVAL)
(LET ((NEWINTERVAL (MAKEBININTERVAL (HISTO.GETVALUE (CAR OBATCH))
(HISTO.GETVALUE (CAR (LAST OBATCH)))
(PLOTPROP HISTOGRAM 'NBINS)
INTFLG)))
(PLOTPROP HISTOGRAM 'BININTERVAL NEWINTERVAL)
NEWINTERVAL)))
(BINMIN (fetch (BININTERVAL BINMIN) of BININTERVAL))
(BINMAX (fetch (BININTERVAL BINMAX) of BININTERVAL))
(BININC (fetch (BININTERVAL BININC) of BININTERVAL))
(NBINS (fetch (BININTERVAL NBINS) of BININTERVAL))
BINS) (* Erase the old image, if any)
[for OBJECT in (COPY (PLOTPROP HISTOGRAM 'PLOTOBJECTS))
do (COND
((AND (PLOTOBJECTSUBTYPE? FILLEDRECTANGLE OBJECT)
(PLOTOBJECTPROP OBJECT 'FROMHISTOGRAM?))
(DELETEPLOTOBJECT OBJECT HISTOGRAM T T]
[COND
(INTFLG (SETQ BINMIN (DIFFERENCE BINMIN 0.5))
(SETQ BINMAX (PLUS BINMAX 0.5]
(SETQ BINS (bind (NUMBERS ← OBATCH)
FREQ for I from 1 to NBINS as MARK from (PLUS BINMIN BININC) by BININC
eachtime (SETQ FREQ (bind NUM eachtime (SETQ NUM (CAR NUMBERS))
while (AND NUMBERS (LESSP (HISTO.GETVALUE NUM)
MARK))
sum (SETQ NUMBERS (CDR NUMBERS))
(HISTO.GETFREQ NUM)))
when (NEQ FREQ 0) collect (CONS MARK FREQ)))
(* An optimization to speed up adding rectangles to the plot --
extends the scale once)
(ADJUSTSCALE? [create EXTENT
MINX ← BINMIN
MAXX ← BINMAX
MINY ← 0
MAXY ← (CDR (for BIN in BINS largest (CDR BIN]
HISTOGRAM) (* Construct the new image)
(RESETLST [RESETSAVE (FLTFMT '(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
(COND
[INTFLG (LET ((ILOWMARK (PLOT.CEILING LOWMARK))
(IHIGHMARK (PLOT.FLOOR HIGHMARK)))
(COND
((IEQP ILOWMARK IHIGHMARK)
(CONCAT FREQ " Obs. at " ILOWMARK))
(T (CONCAT FREQ " Obs. between " ILOWMARK " and "
IHIGHMARK]
(T (CONCAT FREQ " Obs. between " LOWMARK " and " HIGHMARK)))
SHADE NIL 'BINMENU T))
(PLOTOBJECTPROP RECTANGLE 'FROMHISTOGRAM? T)
(PLOTOBJECTPROP RECTANGLE 'LOWMARK LOWMARK)
(PLOTOBJECTPROP RECTANGLE 'HIGHMARK HIGHMARK)))
(* Rescale the Histogram)
(RESCALEPLOT HISTOGRAM 'BOTH T) (* refresh the image)
(REDRAWPLOTWINDOW HISTOGRAM])
(HISTO.INTSCALEFN
[LAMBDA (MIN MAX TICINFO) (* jop%: "24-Feb-86 23:29")
(with TICINFO TICINFO (create AXISINTERVAL
MIN ← (DIFFERENCE TICMIN 0.5)
MAX ← (PLUS TICMAX 0.5])
(HISTO.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])
(HISTO.MAKEBINS
[LAMBDA (HISTOGRAM) (* jop%: "24-Feb-86 23:07")
(* * Computes a BIN interval and the BINEDNUMBERS based on PLOT props.)
(PROG ((OBATCH (PLOTPROP HISTOGRAM 'OBATCH))
(BININTERVAL (PLOTPROP HISTOGRAM 'BININTERVAL))
(INTFLG (PLOTPROP HISTOGRAM 'INTFLG))
NBINS MARKS BINEDNUMBERS)
(if (NULL BININTERVAL)
then (SETQ BININTERVAL (MAKEBININTERVAL (HISTO.GETVALUE (CAR OBATCH))
(HISTO.GETVALUE (CAR (LAST OBATCH)))
(PLOTPROP HISTOGRAM 'NBINS)
INTFLG)))
(* MARKS is a list of the NBINS plus 1 bin end points)
(SETQ NBINS (fetch (BININTERVAL NBINS) of BININTERVAL))
(SETQ MARKS
(LET ((BINMIN (fetch (BININTERVAL BINMIN) of BININTERVAL))
(BINMAX (fetch (BININTERVAL BINMAX) of BININTERVAL))
(BININC (fetch (BININTERVAL BININC) of BININTERVAL)))
(if INTFLG
then (SETQ BINMIN (DIFFERENCE BINMIN 0.5))
(SETQ BINMAX (PLUS BINMAX 0.5)))
(NCONC1 (for I from 1 to NBINS as MARK from BINMIN by BININC collect MARK)
BINMAX)))
(* BINEDNUMBERS is a list of numbers, one for each bin, so that each entry is
the number of elements of BATCH that fall in that bin)
[SETQ BINEDNUMBERS (bind (NUMBERS ← OBATCH) for MARK in (CDR MARKS)
collect (bind NUM eachtime (SETQ NUM (CAR NUMBERS))
while (AND NUMBERS (LESSP (HISTO.GETVALUE NUM)
MARK))
sum (SETQ NUMBERS (CDR NUMBERS))
(HISTO.GETFREQ NUM]
(PLOTPROP HISTOGRAM 'BININTERVAL BININTERVAL)
(PLOTPROP HISTOGRAM 'BINEDNUMBERS BINEDNUMBERS)
(PLOTPROP HISTOGRAM 'MARKS MARKS])
(HISTO.RESET
[LAMBDA (HISTOGRAM) (* jop%: "27-Feb-86 15:06")
(* * Resets the range and bin interval to their original values)
(PLOTPROP HISTOGRAM 'BININTERVAL NIL)
(HISTO.DRAW HISTOGRAM])
(HISTO.TICFN
[LAMBDA (MIN MAX HISTOGRAM) (* jop%: "25-Feb-86 12:43")
(* *)
(LET* ((RANGE (DIFFERENCE MAX MIN))
(BININTERVAL (PLOTPROP HISTOGRAM 'BININTERVAL))
(BININC (fetch (BININTERVAL BININC) of BININTERVAL))
(NBINS (fetch (BININTERVAL 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 (COMPUTEMULTIPLE 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])
(HISTO.VALUES
[LAMBDA (RECTANGLE HISTOGRAM) (* jop%: "24-Feb-86 23:25")
(PROG [(SUMMARYWINDOW (WINDOWPROP (PLOTPROP HISTOGRAM 'PLOTWINDOW)
'SUMMARYWINDOW))
(LOWMARK (PLOTOBJECTPROP RECTANGLE 'LOWMARK))
(HIGHMARK (PLOTOBJECTPROP RECTANGLE 'HIGHMARK))
(OBATCH (PLOTPROP HISTOGRAM 'OBATCH]
(COND
((NULL SUMMARYWINDOW) (* Make a window five chars high)
(SETQ SUMMARYWINDOW (CREATEW (CREATEREGION 0 0 100
(HEIGHTIFWINDOW (ITIMES 5
(FONTPROP
(DEFAULTFONT 'DISPLAY)
'HEIGHT))
T))
"SUMMARY WINDOW" NIL T))
(* Supply a simple repaintfn)
(WINDOWADDPROP SUMMARYWINDOW 'REPAINTFN (FUNCTION SUMMARYWINDOW.REPAINTFN))
(WINDOWADDPROP SUMMARYWINDOW 'RESHAPEFN (FUNCTION SUMMARYWINDOW.REPAINTFN))
(WINDOWPROP (PLOTPROP HISTOGRAM 'PLOTWINDOW)
'SUMMARYWINDOW SUMMARYWINDOW))) (* cache the output as a window prop)
(WINDOWPROP SUMMARYWINDOW 'OUTPUT (bind NUM for ITEM in OBATCH eachtime (SETQ NUM
(HISTO.GETVALUE
ITEM))
when (AND (GEQ NUM LOWMARK)
(LESSP NUM HIGHMARK)) collect ITEM))
(* If the window is not yet attached, then attach it)
(COND
((NOT (OPENWP SUMMARYWINDOW))
(ATTACHWINDOW SUMMARYWINDOW (fetch PLOTWINDOW of HISTOGRAM)
'TOP NIL 'LOCALCLOSE))
(T (SUMMARYWINDOW.REPAINTFN SUMMARYWINDOW])
(HISTPLOT
[LAMBDA (BATCH LABEL SHADE) (* jop%: "27-Feb-86 22:55")
(* * Batch is assumed to be a list of numbers or a list of pairs
(number . frequency) Label, a label to be associated with those numbers)
(PROG ((HISTOGRAM (CREATEPLOT))
(BINMENU (LIST (LIST 'Values (FUNCTION HISTO.VALUES)
"Output values in bin")))
[RIGHTMENUITEMS (LIST (LIST 'Change% bins (FUNCTION HISTO.CHANGEBINS)
"Change number of bins"
(LIST 'SUBITEMS (LIST 'RESET (FUNCTION HISTO.RESET)
"Reset range and bin interval to original value"
]
(LEFTLABEL "Frequency")
(BOTTOMLABEL (OR LABEL "Values"))
(N (for ITEM in BATCH sum (HISTO.GETFREQ ITEM)))
(TOPLABEL (COND
(LABEL (CONCAT "Histogram of " LABEL))
(T "Histogram")))
OBATCH INTFLG NBINS)
(* * BINMENU is aspecial menu for the rectangle of the histogram.
RIGHTMENUITEMS are additional right menu items.)
[SETQ OBATCH (SORT (COPY BATCH)
(FUNCTION (LAMBDA (X Y)
(LESSP (HISTO.GETVALUE X)
(HISTO.GETVALUE Y]
(* Order the data)
[SETQ INTFLG (for X in OBATCH always (FIXP (HISTO.GETVALUE X]
(* check if data are all integers)
[SETQ NBINS (COND
[INTFLG (ADD1 (DIFFERENCE (HISTO.GETVALUE (CAR (LAST OBATCH)))
(HISTO.GETVALUE (CAR OBATCH]
(T (COND
[(LESSP N 20)
(FIX (TIMES 2 (SQRT N]
(T (FIX (TIMES 10 (PLOT.LOG10 N]
(* Default number of bins set by an
heuristic)
(* Set up a few key PLOT PROP'S)
(PLOTPROP HISTOGRAM 'N N)
(PLOTPROP HISTOGRAM 'NBINS NBINS)
(PLOTPROP HISTOGRAM 'OBATCH OBATCH)
(PLOTPROP HISTOGRAM 'INTFLG INTFLG)
(PLOTPROP HISTOGRAM 'SHADE (OR SHADE SHADE3)) (* Function to copy the plot props)
(PLOTPROP HISTOGRAM 'COPYFN (FUNCTION HISTO.COPYFN))
(* Initialize the histogram so that labels and tics are displayed)
(PLOTTICS HISTOGRAM 'BOTTOM T T)
(PLOTTICS HISTOGRAM 'LEFT T T)
(PLOTLABEL HISTOGRAM 'BOTTOM BOTTOMLABEL T)
(PLOTLABEL HISTOGRAM 'LEFT LEFTLABEL T)
(PLOTLABEL HISTOGRAM 'TOP TOPLABEL T) (* add items to the right menu)
(PLOTADDMENUITEMS HISTOGRAM 'RIGHT RIGHTMENUITEMS) (* Establish a special "bin" menu)
(PLOTMENUITEMS HISTOGRAM 'BINMENU BINMENU)
[COND
(INTFLG (PLOTTICFN HISTOGRAM 'X (FUNCTION HISTO.INTTICFN))
(PLOTSCALEFN HISTOGRAM 'X (FUNCTION HISTO.INTSCALEFN)))
(T (PLOTTICFN HISTOGRAM 'X (FUNCTION HISTO.TICFN]
(* Draw the histogram based on the
PLOT PROP's)
(HISTO.DRAW HISTOGRAM) (* Returns a PLOT)
(RETURN HISTOGRAM])
(MAKEBININTERVAL
[LAMBDA (BATCHMIN BATCHMAX NBINS INTFLG) (* jop%: "25-Feb-86 12:48")
(* *)
(COND
[INTFLG (LET ((NINT (ADD1 (IDIFFERENCE BATCHMAX BATCHMIN)))
MULT)
(COND
((IGEQ NBINS NINT)
(create BININTERVAL
BINMIN ← BATCHMIN
BINMAX ← BATCHMAX
BININC ← 1
NBINS ← NINT))
(T (SETQ MULT (PLOT.CEILING (FQUOTIENT (DIFFERENCE BATCHMAX BATCHMIN)
NBINS)))
(create BININTERVAL
BINMIN ← BATCHMIN
BINMAX ← (PLUS BATCHMIN (TIMES MULT NBINS))
BININC ← MULT
NBINS ← NBINS]
(T (LET [(TICINFO (SCALE BATCHMIN BATCHMAX (ADD1 NBINS]
(create BININTERVAL
BINMIN ← (fetch (TICINFO TICMIN) of TICINFO)
BINMAX ← (fetch (TICINFO TICMAX) of TICINFO)
BININC ← (fetch (TICINFO TICINC) of TICINFO)
NBINS ← NBINS])
(SUMMARYWINDOW.REPAINTFN
[LAMBDA (WINDOW) (* jop%: "12-May-85 14:40")
(* * PRIN1 whatever happens to be under the OUTPUT PROP)
(PROG [(OUTPUT (WINDOWPROP WINDOW 'OUTPUT]
(CLEARW WINDOW)
(printout WINDOW OUTPUT T])
)
(DECLARE%: EVAL@COMPILE
(RECORD BININTERVAL (BINMIN BINMAX BININC NBINS))
)
(* * SCATTERPLOT FNS)
(DEFINEQ
(SCATPLOT
[LAMBDA (Y X POINTLABELS YLABEL XLABEL TITLE SYMBOL) (* jop%: "26-Feb-86 12:44")
(* * X and Y are equal length list of numbers, or X is NIL)
(COND
((NULL X)
(SETQ X (for I from 1 to (LENGTH Y) collect I)))
((NOT (EQLENGTH Y (LENGTH X)))
(HELP "X and Y must be of equal length")))
[COND
((NULL TITLE)
(SETQ TITLE (COND
((AND XLABEL YLABEL)
(CONCAT "Scatterplot of" YLABEL " vs " XLABEL))
(T "Scatterplot"]
(COND
((NULL SYMBOL)
(SETQ SYMBOL STAR)))
(LET* [(SCATPLOT (CREATEPLOT))
[RIGHTMENUITEMS '((Logscale SCAT.LOGSCALE "Toggle exponential tics"
(SUBITEMS (X% axis (SCAT.LOGSCALE 'X)
"X axis only")
(Y% axis (SCAT.LOGSCALE 'Y)
"Y axis only")))
(Coordinates SCAT.WORLDCOORD
"Display world coordinates at cursor position"]
(POINTMENUITEMS '((Coordinates SCAT.POINTCOORDS "Display point coordinates"]
(PLOTPOINTS SCATPLOT (for XVALUE in X as YVALUE in Y collect (CREATEPOSITION XVALUE YVALUE)
)
POINTLABELS SYMBOL 'POINTMENU T)
(PLOTTICS SCATPLOT 'BOTTOM T T)
(PLOTTICS SCATPLOT 'LEFT T T)
(PLOTLABEL SCATPLOT 'BOTTOM XLABEL T)
(PLOTLABEL SCATPLOT 'LEFT YLABEL T)
(PLOTLABEL SCATPLOT 'TOP TITLE T)
(PLOTADDMENUITEMS SCATPLOT 'RIGHT RIGHTMENUITEMS)
(PLOTMENUITEMS SCATPLOT 'POINTMENU (APPEND (PLOTMENUITEMS SCATPLOT 'MIDDLE)
POINTMENUITEMS))
(RESCALEPLOT SCATPLOT 'BOTH T)
(OPENPLOTWINDOW SCATPLOT)
SCATPLOT])
(SCAT.LOGSCALE
[LAMBDA (PLOT AXIS) (* jop%: "25-Feb-86 13:22")
(* * sets up PLOT to have log scale on AXIS --
X, Y or both)
[COND
((NULL AXIS)
(SETQ AXIS 'BOTH]
(PROG ((XON (EQ (PLOTTICFN PLOT 'X)
(FUNCTION LOGTICFN)))
(YON (EQ (PLOTTICFN PLOT 'Y)
(FUNCTION LOGTICFN)))
(XLOWER (fetch (PLOT XLOWER) of PLOT))
(XUPPER (fetch (PLOT XUPPER) of PLOT))
(YLOWER (fetch (PLOT YLOWER) of PLOT))
(YUPPER (fetch (PLOT YUPPER) of PLOT)))
[COND
((OR (EQ AXIS 'X)
(EQ AXIS 'BOTH))
(COND
((AND (NULL XON)
(OR (LESSP XLOWER -35)
(GREATERP XUPPER 35)))
(PLOTPROMPT "X axis scale not appropriate" PLOT))
(T (PLOTTICFN PLOT 'X (AND (NULL XON)
(FUNCTION LOGTICFN))
T)
(PLOTPROP PLOT 'XLABELFN (AND (NULL XON)
(FUNCTION PLOT.EXP10)))
(PLOTPROP PLOT 'XWORLDFN (AND (NULL XON)
(FUNCTION PLOT.LOG10)))
(RESCALEPLOT PLOT 'X T]
[COND
((OR (EQ AXIS 'Y)
(EQ AXIS 'BOTH))
(COND
((AND (NULL YON)
(OR (LESSP YLOWER -35)
(GREATERP YUPPER 35)))
(PLOTPROMPT "Y axis scale not appropriate" PLOT))
(T (PLOTTICFN PLOT 'Y (AND (NULL YON)
(FUNCTION LOGTICFN))
T)
(PLOTPROP PLOT 'YLABELFN (AND (NULL YON)
(FUNCTION PLOT.EXP10)))
(PLOTPROP PLOT 'YWORLDFN (AND (NULL YON)
(FUNCTION PLOT.LOG10)))
(RESCALEPLOT PLOT 'Y T]
(REDRAWPLOTWINDOW PLOT)
(RETURN PLOT])
(SCAT.POINTCOORDS
[LAMBDA (POINTOBJECT SCATTERPLOT) (* jop%: "20-Jan-86 21:18")
(PROG ([POINTPOSITION (fetch (POINTDATA POINTPOSITION) of (PLOTOBJECTPROP POINTOBJECT
'OBJECTDATA]
(XLABEL (CONCAT (OR (PLOTLABEL SCATTERPLOT 'BOTTOM)
"XCOORD")
" "))
(YLABEL (CONCAT " " (OR (PLOTLABEL SCATTERPLOT 'LEFT)
"YCOORD")
" ")))
(PLOTPROMPT (CONCAT XLABEL (PLOT.WORLDTOLABEL (fetch XCOORD of POINTPOSITION)
SCATTERPLOT
'X)
YLABEL
(PLOT.WORLDTOLABEL (fetch YCOORD of POINTPOSITION)
SCATTERPLOT
'Y))
SCATTERPLOT])
(SCAT.WORLDCOORD
[LAMBDA (SCATTERPLOT) (* jop%: "20-Jan-86 17:46")
(PROG ((PLOTWINDOW (PLOTPROP SCATTERPLOT 'PLOTWINDOW))
(PLOTPROMPTWINDOW (PLOTPROP SCATTERPLOT 'PLOTPROMPTWINDOW))
(PLOTVIEWPORT (PLOTPROP SCATTERPLOT 'PLOTWINDOWVIEWPORT))
(XLABEL (CONCAT (OR (PLOTLABEL SCATTERPLOT 'BOTTOM)
"X")
" at "))
(YLABEL (CONCAT " " (OR (PLOTLABEL SCATTERPLOT '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 (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])
(LOGTICFN
[LAMBDA (MIN MAX) (* jop%: "18-Jun-86 12:49")
(* * returns TICINFO for log scale)
(* assumes log to base 10 -- later base could be determined by plot prop)
(COND
[(GREATERP (DIFFERENCE MAX MIN)
1)
(* spans more than 1 decade; use equispaced tics on logscale)
(LET ((NEWMIN (PLOT.FLOOR MIN))
(NEWMAX (PLOT.CEILING MAX))
RANGE NUMINT INC EXCESS)
(SETQ RANGE (IDIFFERENCE NEWMAX NEWMIN))
[SETQ NUMINT (for NUMINT from 2 to 7 smallest (* NUMINT is %# of intervals =
%#tics-1)
(TIMES NUMINT (PLOT.CEILING (FQUOTIENT RANGE
NUMINT]
(SETQ INC (PLOT.CEILING (FQUOTIENT RANGE NUMINT)))
(SETQ EXCESS (DIFFERENCE (TIMES NUMINT INC)
RANGE))
(* EXCESS is additional number of decades to include for pretty RANGE)
(add NEWMIN (MINUS (IQUOTIENT EXCESS 2)))
(add NEWMAX (DIFFERENCE EXCESS (IQUOTIENT EXCESS 2)))
(create TICINFO
TICMAX ← NEWMAX
TICMIN ← NEWMIN
TICINC ← (for I from NEWMIN to NEWMAX by INC collect (CONS I (EXPT 10.0 I]
(T (* plot is in a single decade; use equispaced tics on exponential scale)
(LET ((MINEXP (EXPT 10.0 MIN))
(MAXEXP (EXPT 10.0 MAX))
(UNITSIZE (PLOT.FLOOR MIN))
TICINFO) (* UNITSIZE is the unit interval in
this decade)
(bind (RANGE ← (PLOT.LOG10 (DIFFERENCE MAXEXP MINEXP))) while (LESSP RANGE UNITSIZE)
do (SETQ UNITSIZE (SUB1 UNITSIZE)))
(SETQ TICINFO (DEFAULTTICFN MINEXP MAXEXP NIL NIL UNITSIZE))
(* check for zero endpoint)
(with TICINFO TICINFO
[COND
[(EQP 0 TICMIN)
(LET* ((UNITSIZEEXP (EXPT 10.0 UNITSIZE))
(LOWERMULT (PLOT.FLOOR (FQUOTIENT MINEXP UNITSIZEEXP)))
(UPPERMULT (PLOT.CEILING (FQUOTIENT MAXEXP UNITSIZEEXP)))
UPPERUNITSIZEEXP)
(COND
[(LEQ UPPERMULT 10)
(* entire plot fits in single decade -- put a tic at each unit)
(SETQ TICMIN (TIMES UNITSIZEEXP LOWERMULT))
(SETQ TICMAX (TIMES UNITSIZEEXP UPPERMULT))
(SETQ TICINC UNITSIZEEXP)
(SETQ NTICS (ADD1 (DIFFERENCE UPPERMULT LOWERMULT)))
(SETQ TICINC
(NCONC1 (for VALUE from TICMIN by TICINC as I from 1
to (SUB1 NTICS) collect (CONS (PLOT.LOG10 VALUE)
VALUE))
(CONS (PLOT.LOG10 TICMAX)
TICMAX]
(T
(* plot crosses decade bound -- switch to larger units after decade bound to
avoid possibility of large number of tic marks)
(SETQ UPPERUNITSIZEEXP (TIMES 10 UNITSIZEEXP))
(SETQ UPPERMULT (PLOT.CEILING (FQUOTIENT MAXEXP UPPERUNITSIZEEXP
)))
(SETQ TICMIN (TIMES UNITSIZEEXP LOWERMULT))
(SETQ TICMAX (TIMES UPPERUNITSIZEEXP UPPERMULT))
(* 10-LOWERMULT tics using small units, UPPERMULT tics using large units)
(SETQ NTICS (PLUS 10 (DIFFERENCE UPPERMULT LOWERMULT)))
(SETQ TICINC
(NCONC1 (NCONC (for VALUE from TICMIN by UNITSIZEEXP
as I from LOWERMULT to 9
collect (CONS (PLOT.LOG10 VALUE)
VALUE))
(for VALUE from UPPERUNITSIZEEXP by
UPPERUNITSIZEEXP
as I from 1 to (SUB1 UPPERMULT)
collect (CONS (PLOT.LOG10 VALUE)
VALUE)))
(CONS (PLOT.LOG10 TICMAX)
TICMAX]
(T (* no adjustment needed)
(SETQ TICINC
(NCONC1 (for VALUE from TICMIN by TICINC as I from 1
to (SUB1 NTICS) collect (CONS (PLOT.LOG10 VALUE)
VALUE))
(CONS (PLOT.LOG10 TICMAX)
TICMAX]
(SETQ TICMIN (PLOT.LOG10 TICMIN))
(SETQ TICMAX (PLOT.LOG10 TICMAX)))
TICINFO])
)
(* * Depends on PLOT)
(FILESLOAD PLOT)
(DECLARE%: EVAL@COMPILE
[PUTPROPS HISTO.GETFREQ MACRO (OPENLAMBDA (ITEM)
(COND ((LISTP ITEM)
(CDR ITEM))
(T 1]
[PUTPROPS HISTO.GETVALUE MACRO (OPENLAMBDA (ITEM)
(COND ((LISTP ITEM)
(CAR ITEM))
(T ITEM]
)
(DECLARE%: DONTCOPY DONTEVAL@LOAD DOEVAL@COMPILE
(DECLARE%: DOEVAL@COMPILE DONTCOPY
(LOCALVARS . T)
)
)
(PUTPROPS PLOTEXAMPLES COPYRIGHT ("Xerox Corporation" 1986 1987))
(DECLARE%: DONTCOPY
(FILEMAP (NIL (1236 22599 (COMPUTEMULTIPLE 1246 . 1769) (HISTO.CHANGEBINS 1771 . 4356) (HISTO.COPYFN
4358 . 4770) (HISTO.DRAW 4772 . 9295) (HISTO.INTSCALEFN 9297 . 9591) (HISTO.INTTICFN 9593 . 10432) (
HISTO.MAKEBINS 10434 . 12734) (HISTO.RESET 12736 . 13014) (HISTO.TICFN 13016 . 14701) (HISTO.VALUES
14703 . 16987) (HISTPLOT 16989 . 20921) (MAKEBININTERVAL 20923 . 22276) (SUMMARYWINDOW.REPAINTFN 22278
. 22597)) (22709 37054 (SCATPLOT 22719 . 24759) (SCAT.LOGSCALE 24761 . 27017) (SCAT.POINTCOORDS 27019
. 28040) (SCAT.WORLDCOORD 28042 . 30859) (LOGTICFN 30861 . 37052)))))
STOP