(FILECREATED "18-Jun-86 12:50:08" {QV}<PEDERSEN>LISP>PLOTEXAMPLES.;11 32554 changes to: (FNS LOGTICFN) previous date: "27-Mar-86 21:58:57" {QV}<PEDERSEN>LISP>PLOTEXAMPLES.;9) (* 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: "18-Jun-86 12:49") (* * 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)) (* check for zero endpoint) (with TICINFO TICINFO [if (EQP 0 TICMIN) then [LET* ((UNITSIZEEXP (EXPT 10.0 UNITSIZE)) (LOWERMULT (PLOT.FLOOR (FQUOTIENT MINEXP UNITSIZEEXP)) ) (UPPERMULT (PLOT.CEILING (FQUOTIENT MAXEXP UNITSIZEEXP))) UPPERUNITSIZEEXP) (if (LEQ UPPERMULT 10) then (* 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))) else (* 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] else (* 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) (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 (891 19669 (COMPUTEMULTIPLE 901 . 1387) (HISTO.CHANGEBINS 1389 . 3602) (HISTO.COPYFN 3604 . 4105) (HISTO.DRAW 4107 . 8272) (HISTO.INTSCALEFN 8274 . 8523) (HISTO.INTTICFN 8525 . 9318) ( HISTO.MAKEBINS 9320 . 11425) (HISTO.RESET 11427 . 11708) (HISTO.TICFN 11710 . 12696) (HISTO.VALUES 12698 . 14567) (HISTPLOT 14569 . 18311) (MAKEBININTERVAL 18313 . 19334) (SUMMARYWINDOW.REPAINTFN 19336 . 19667)) (19779 32024 (SCATPLOT 19789 . 21813) (SCAT.LOGSCALE 21815 . 23884) (SCAT.POINTCOORDS 23886 . 24689) (SCAT.WORLDCOORD 24691 . 26888) (LOGTICFN 26890 . 32022))))) STOP