(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