(FILECREATED "27-Mar-86 21:58:57" {QV}<PEDERSEN>LISP>PLOTEXAMPLES.;9 30704
changes to: (FNS HISTO.DRAW)
previous date: " 2-Mar-86 19:51:42" {QV}<PEDERSEN>LISP>PLOTEXAMPLES.;7)
(* Copyright (c) 1986 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 (QUOTE PLOTPROMPTWINDOW)))
(INTFLG (PLOTPROP HISTOGRAM (QUOTE INTFLG)))
(BININTERVAL (PLOTPROP HISTOGRAM (QUOTE 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 (QUOTE 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 (QUOTE N)))
(NBINS (PLOTPROP OLDHIST (QUOTE NBINS)))
(OBATCH (PLOTPROP OLDHIST (QUOTE OBATCH)))
(INTFLG (PLOTPROP OLDHIST (QUOTE INTFLG)))
(BINEDNUMBERS (PLOTPROP OLDHIST (QUOTE BINEDNUMBERS)))
(MARKS (PLOTPROP OLDHIST (QUOTE MARKS)))
NIL])
(HISTO.DRAW
[LAMBDA (HISTOGRAM) (* edited: "27-Mar-86 21:56")
(* *)
(LET* ((SHADE (PLOTPROP HISTOGRAM (QUOTE SHADE)))
(OBATCH (PLOTPROP HISTOGRAM (QUOTE OBATCH)))
(INTFLG (PLOTPROP HISTOGRAM (QUOTE INTFLG)))
(BININTERVAL (OR (PLOTPROP HISTOGRAM (QUOTE BININTERVAL))
(LET ((NEWINTERVAL (MAKEBININTERVAL (HISTO.GETVALUE (CAR OBATCH))
(HISTO.GETVALUE
(CAR (LAST OBATCH)))
(PLOTPROP HISTOGRAM
(QUOTE NBINS))
INTFLG)))
(PLOTPROP HISTOGRAM (QUOTE 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 (QUOTE PLOTOBJECTS)))
do (if (AND (PLOTOBJECTSUBTYPE? FILLEDRECTANGLE OBJECT)
(PLOTOBJECTPROP OBJECT (QUOTE FROMHISTOGRAM?)))
then (DELETEPLOTOBJECT OBJECT HISTOGRAM T T)))
(if INTFLG
then (SETQ BINMIN (DIFFERENCE BINMIN .5))
(SETQ BINMAX (PLUS BINMAX .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 (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)
(RESCALEPLOT HISTOGRAM (QUOTE 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 .5)
MAX ←(PLUS TICMAX .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 (QUOTE OBATCH)))
(BININTERVAL (PLOTPROP HISTOGRAM (QUOTE BININTERVAL)))
(INTFLG (PLOTPROP HISTOGRAM (QUOTE INTFLG)))
NBINS MARKS BINEDNUMBERS)
(if (NULL BININTERVAL)
then (SETQ BININTERVAL (MAKEBININTERVAL (HISTO.GETVALUE (CAR OBATCH))
(HISTO.GETVALUE (CAR (LAST OBATCH)))
(PLOTPROP HISTOGRAM (QUOTE 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 .5))
(SETQ BINMAX (PLUS BINMAX .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 (QUOTE BININTERVAL)
BININTERVAL)
(PLOTPROP HISTOGRAM (QUOTE BINEDNUMBERS)
BINEDNUMBERS)
(PLOTPROP HISTOGRAM (QUOTE MARKS)
MARKS])
(HISTO.RESET
[LAMBDA (HISTOGRAM) (* jop: "27-Feb-86 15:06")
(* * Resets the range and bin interval to their original values)
(PLOTPROP HISTOGRAM (QUOTE 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 (QUOTE 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 (QUOTE PLOTWINDOW))
(QUOTE SUMMARYWINDOW)))
(LOWMARK (PLOTOBJECTPROP RECTANGLE (QUOTE LOWMARK)))
(HIGHMARK (PLOTOBJECTPROP RECTANGLE (QUOTE HIGHMARK)))
(OBATCH (PLOTPROP HISTOGRAM (QUOTE OBATCH]
(if (NULL SUMMARYWINDOW)
then (* Make a window five chars high)
(SETQ SUMMARYWINDOW (CREATEW
(CREATEREGION 0 0 100 (HEIGHTIFWINDOW
(ITIMES 5 (FONTPROP (DEFAULTFONT (QUOTE DISPLAY))
(QUOTE HEIGHT)))
T))
"SUMMARY WINDOW" NIL T)) (* Supply a simple repaintfn)
(WINDOWADDPROP SUMMARYWINDOW (QUOTE REPAINTFN)
(FUNCTION SUMMARYWINDOW.REPAINTFN))
(WINDOWADDPROP SUMMARYWINDOW (QUOTE RESHAPEFN)
(FUNCTION SUMMARYWINDOW.REPAINTFN))
(WINDOWPROP (PLOTPROP HISTOGRAM (QUOTE PLOTWINDOW))
(QUOTE SUMMARYWINDOW)
SUMMARYWINDOW)) (* cache the output as a window prop)
(WINDOWPROP SUMMARYWINDOW (QUOTE 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)
(if (NOT (OPENWP SUMMARYWINDOW))
then (ATTACHWINDOW SUMMARYWINDOW (fetch PLOTWINDOW of HISTOGRAM)
(QUOTE TOP)
NIL
(QUOTE LOCALCLOSE))
else (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 (QUOTE Values)
(FUNCTION HISTO.VALUES)
"Output values in bin")))
[RIGHTMENUITEMS (LIST (LIST (QUOTE Change% bins)
(FUNCTION HISTO.CHANGEBINS)
"Change number of bins"
(LIST (QUOTE SUBITEMS)
(LIST (QUOTE 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 (if LABEL
then (CONCAT "Histogram of " LABEL)
else "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 (if INTFLG
then [ADD1 (DIFFERENCE (HISTO.GETVALUE (CAR (LAST OBATCH)))
(HISTO.GETVALUE (CAR OBATCH]
else (if (LESSP N 20)
then (FIX (TIMES 2 (SQRT N)))
else (FIX (TIMES 10 (PLOT.LOG10 N]
(* Default number of bins set by an heuristic)
(* Set up a few key PLOT PROP'S)
(PLOTPROP HISTOGRAM (QUOTE N)
N)
(PLOTPROP HISTOGRAM (QUOTE NBINS)
NBINS)
(PLOTPROP HISTOGRAM (QUOTE OBATCH)
OBATCH)
(PLOTPROP HISTOGRAM (QUOTE INTFLG)
INTFLG)
(PLOTPROP HISTOGRAM (QUOTE SHADE)
(OR SHADE SHADE3)) (* Function to copy the plot props)
(PLOTPROP HISTOGRAM (QUOTE COPYFN)
(FUNCTION HISTO.COPYFN)) (* Initialize the histogram so that labels and tics
are displayed)
(PLOTTICS HISTOGRAM (QUOTE BOTTOM)
T T)
(PLOTTICS HISTOGRAM (QUOTE LEFT)
T T)
(PLOTLABEL HISTOGRAM (QUOTE BOTTOM)
BOTTOMLABEL T)
(PLOTLABEL HISTOGRAM (QUOTE LEFT)
LEFTLABEL T)
(PLOTLABEL HISTOGRAM (QUOTE TOP)
TOPLABEL T) (* add items to the right menu)
(PLOTADDMENUITEMS HISTOGRAM (QUOTE RIGHT)
RIGHTMENUITEMS) (* Establish a special "bin" menu)
(PLOTMENUITEMS HISTOGRAM (QUOTE BINMENU)
BINMENU)
(if INTFLG
then (PLOTTICFN HISTOGRAM (QUOTE X)
(FUNCTION HISTO.INTTICFN))
(PLOTSCALEFN HISTOGRAM (QUOTE X)
(FUNCTION HISTO.INTSCALEFN))
else (PLOTTICFN HISTOGRAM (QUOTE 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")
(* *)
(if INTFLG
then (LET ((NINT (ADD1 (IDIFFERENCE BATCHMAX BATCHMIN)))
MULT)
(if (IGEQ NBINS NINT)
then (create BININTERVAL
BINMIN ← BATCHMIN
BINMAX ← BATCHMAX
BININC ← 1
NBINS ← NINT)
else (SETQ MULT (PLOT.CEILING (FQUOTIENT (DIFFERENCE BATCHMAX
BATCHMIN)
NBINS)))
(create BININTERVAL
BINMIN ← BATCHMIN
BINMAX ←(PLUS BATCHMIN (TIMES MULT NBINS))
BININC ← MULT
NBINS ← NBINS)))
else (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 (QUOTE 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)
(if (NULL X)
then (SETQ X (for I from 1 to (LENGTH Y) collect I))
elseif (NOT (EQLENGTH Y (LENGTH X)))
then (HELP "X and Y must be of equal length"))
(if (NULL TITLE)
then (SETQ TITLE (if (AND XLABEL YLABEL)
then (CONCAT "Scatterplot of" YLABEL " vs " XLABEL)
else "Scatterplot")))
(if (NULL SYMBOL)
then (SETQ SYMBOL STAR))
(LET* [(SCATPLOT (CREATEPLOT))
[RIGHTMENUITEMS (QUOTE ((Logscale SCAT.LOGSCALE "Toggle exponential tics"
(SUBITEMS (X% axis (SCAT.LOGSCALE (QUOTE X))
"X axis only")
(Y% axis (SCAT.LOGSCALE (QUOTE Y))
"Y axis only")))
(Coordinates SCAT.WORLDCOORD
"Display world coordinates at cursor position"]
(POINTMENUITEMS (QUOTE ((Coordinates SCAT.POINTCOORDS "Display point coordinates"]
(PLOTPOINTS SCATPLOT (for XVALUE in X as YVALUE in Y collect (CREATEPOSITION
XVALUE YVALUE))
POINTLABELS SYMBOL (QUOTE POINTMENU)
T)
(PLOTTICS SCATPLOT (QUOTE BOTTOM)
T T)
(PLOTTICS SCATPLOT (QUOTE LEFT)
T T)
(PLOTLABEL SCATPLOT (QUOTE BOTTOM)
XLABEL T)
(PLOTLABEL SCATPLOT (QUOTE LEFT)
YLABEL T)
(PLOTLABEL SCATPLOT (QUOTE TOP)
TITLE T)
(PLOTADDMENUITEMS SCATPLOT (QUOTE RIGHT)
RIGHTMENUITEMS)
(PLOTMENUITEMS SCATPLOT (QUOTE POINTMENU)
(APPEND (PLOTMENUITEMS SCATPLOT (QUOTE MIDDLE))
POINTMENUITEMS))
(RESCALEPLOT SCATPLOT (QUOTE 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)
(if (NULL AXIS)
then (SETQ AXIS (QUOTE BOTH)))
(PROG ((XON (EQ (PLOTTICFN PLOT (QUOTE X))
(FUNCTION LOGTICFN)))
(YON (EQ (PLOTTICFN PLOT (QUOTE 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)))
(if (OR (EQ AXIS (QUOTE X))
(EQ AXIS (QUOTE BOTH)))
then (if (AND (NULL XON)
(OR (LESSP XLOWER -35)
(GREATERP XUPPER 35)))
then (PLOTPROMPT "X axis scale not appropriate" PLOT)
else (PLOTTICFN PLOT (QUOTE X)
(AND (NULL XON)
(FUNCTION LOGTICFN))
T)
(PLOTPROP PLOT (QUOTE XLABELFN)
(AND (NULL XON)
(FUNCTION PLOT.EXP10)))
(PLOTPROP PLOT (QUOTE XWORLDFN)
(AND (NULL XON)
(FUNCTION PLOT.LOG10)))
(RESCALEPLOT PLOT (QUOTE X)
T)))
(if (OR (EQ AXIS (QUOTE Y))
(EQ AXIS (QUOTE BOTH)))
then (if (AND (NULL YON)
(OR (LESSP YLOWER -35)
(GREATERP YUPPER 35)))
then (PLOTPROMPT "Y axis scale not appropriate" PLOT)
else (PLOTTICFN PLOT (QUOTE Y)
(AND (NULL YON)
(FUNCTION LOGTICFN))
T)
(PLOTPROP PLOT (QUOTE YLABELFN)
(AND (NULL YON)
(FUNCTION PLOT.EXP10)))
(PLOTPROP PLOT (QUOTE YWORLDFN)
(AND (NULL YON)
(FUNCTION PLOT.LOG10)))
(RESCALEPLOT PLOT (QUOTE 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
(QUOTE
OBJECTDATA]
(XLABEL (CONCAT (OR (PLOTLABEL SCATTERPLOT (QUOTE BOTTOM))
"XCOORD")
" "))
(YLABEL (CONCAT " " (OR (PLOTLABEL SCATTERPLOT (QUOTE LEFT))
"YCOORD")
" ")))
(PLOTPROMPT (CONCAT XLABEL (PLOT.WORLDTOLABEL (fetch XCOORD of POINTPOSITION)
SCATTERPLOT
(QUOTE X))
YLABEL
(PLOT.WORLDTOLABEL (fetch YCOORD of POINTPOSITION)
SCATTERPLOT
(QUOTE Y)))
SCATTERPLOT])
(SCAT.WORLDCOORD
[LAMBDA (SCATTERPLOT) (* jop: "20-Jan-86 17:46")
(PROG ((PLOTWINDOW (PLOTPROP SCATTERPLOT (QUOTE PLOTWINDOW)))
(PLOTPROMPTWINDOW (PLOTPROP SCATTERPLOT (QUOTE PLOTPROMPTWINDOW)))
(PLOTVIEWPORT (PLOTPROP SCATTERPLOT (QUOTE PLOTWINDOWVIEWPORT)))
(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 (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: "20-Jan-86 21:08")
(* * returns TICINFO for log scale)
(* assumes log to base 10 -- later base could be
determined by plot prop)
(if (GREATERP (DIFFERENCE MAX MIN)
1)
then (* 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]
else (* 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))
(* Need to fix up zero endpoint)
(with TICINFO TICINFO [if (EQP 0 TICMIN)
then (LET* [(UNITSIZEEXP (EXPT 10.0 UNITSIZE))
(LOWERMULT (PLOT.FLOOR (FQUOTIENT
MINEXP
UNITSIZE)))
(UPPERMULT (PLOT.CEILING (FQUOTIENT
MAXEXP
UNITSIZE]
(SETQ TICMIN (PLOT.LOG10 (TIMES
UNITSIZEEXP
LOWERMULT)))
(SETQ TICMAX (PLOT.LOG10 (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)))
(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)
(if (LISTP ITEM)
then
(CDR ITEM)
else 1)))
(PUTPROPS HISTO.GETVALUE MACRO (OPENLAMBDA (ITEM)
(if (LISTP ITEM)
then
(CAR ITEM)
else ITEM)))
)
(DECLARE: DONTCOPY DONTEVAL@LOAD DOEVAL@COMPILE
(DECLARE: DOEVAL@COMPILE DONTCOPY
(LOCALVARS . T)
)
)
(PUTPROPS PLOTEXAMPLES COPYRIGHT ("Xerox Corporation" 1986))
(DECLARE: DONTCOPY
(FILEMAP (NIL (892 19670 (COMPUTEMULTIPLE 902 . 1388) (HISTO.CHANGEBINS 1390 . 3603) (HISTO.COPYFN
3605 . 4106) (HISTO.DRAW 4108 . 8273) (HISTO.INTSCALEFN 8275 . 8524) (HISTO.INTTICFN 8526 . 9319) (
HISTO.MAKEBINS 9321 . 11426) (HISTO.RESET 11428 . 11709) (HISTO.TICFN 11711 . 12697) (HISTO.VALUES
12699 . 14568) (HISTPLOT 14570 . 18312) (MAKEBININTERVAL 18314 . 19335) (SUMMARYWINDOW.REPAINTFN 19337
. 19668)) (19780 30174 (SCATPLOT 19790 . 21814) (SCAT.LOGSCALE 21816 . 23885) (SCAT.POINTCOORDS 23887
. 24690) (SCAT.WORLDCOORD 24692 . 26889) (LOGTICFN 26891 . 30172)))))
STOP