(FILECREATED "19-May-86 18:06:33" {QV}<PEDERSEN>LISP>HISTEXAMPLE.;4 12865
changes to: (FNS HISTO.DRAW LOGO.DRAW LOGO.MAKEBINS LOGOPLOT BMFROMW SNAPSCREEN)
(VARS HISTEXAMPLECOMS)
previous date: "16-Jan-86 22:17:28" {QV}<PEDERSEN>LISP>HISTEXAMPLE.;3)
(* Copyright (c) 1986 by Xerox Corporation. All rights reserved.)
(PRETTYCOMPRINT HISTEXAMPLECOMS)
(RPAQQ HISTEXAMPLECOMS ((FNS BMFROMW HISTO.DRAW HISTO.MAKEBINS HISTPLOT LOGO.DRAW LOGO.MAKEBINS
LOGOPLOT NUMBER-OF-BINS MAKEBININTERVAL SNAPSCREEN)
(RECORDS BININTERVAL)
(VARS DATA)))
(DEFINEQ
(BMFROMW
[LAMBDA (W) (* jop: "19-May-86 17:37")
(LET [(BM (BITMAPCREATE (WINDOWPROP W (QUOTE WIDTH))
(WINDOWPROP W (QUOTE HEIGHT]
(BITBLT W NIL NIL BM)
BM])
(HISTO.DRAW
[LAMBDA (HISTOGRAM) (* jop: "19-May-86 16:42")
(* * HISTOGRAM is a PLOT with PROP's N NBINS BININTERVAL BINEDNUMBERS
RECTANGLES, and PRETTYINTERVAL)
(PROG ((BINEDNUMBERS (PLOTPROP HISTOGRAM (QUOTE BINEDNUMBERS)))
(MARKS (PLOTPROP HISTOGRAM (QUOTE MARKS)))
NEWSCALES) (* An optimization to speed up adding
rectangles to the plot --
extends the scale once)
(* Construct the new image)
(for NUMBERINBIN in BINEDNUMBERS as LOWMARK in MARKS as HIGHMARK in (CDR MARKS)
when (GREATERP NUMBERINBIN 0) do (PLOTFILLEDRECTANGLE HISTOGRAM LOWMARK 0
(DIFFERENCE HIGHMARK LOWMARK)
NUMBERINBIN
(CONCAT NUMBERINBIN " Obs. between " LOWMARK
" and " HIGHMARK)
SHADE3 NIL NIL T))
(* Rescale the Histogram)
(RESCALEPLOT HISTOGRAM (QUOTE BOTH)
T) (* refresh the image)
(REDRAWPLOTWINDOW HISTOGRAM])
(HISTO.MAKEBINS
[LAMBDA (HISTOGRAM) (* jop: "16-Jan-86 22:15")
(* * Computes a BIN interval and the BINEDNUMBERS based on PLOT props.)
(LET* ((NBINS (PLOTPROP HISTOGRAM (QUOTE NBINS)))
(BATCH (PLOTPROP HISTOGRAM (QUOTE BATCH)))
(BATCHMIN (for NUM in BATCH smallest NUM))
(BATCHMAX (for NUM in BATCH largest NUM))
(BININTERVAL (MAKEBININTERVAL BATCHMIN BATCHMAX NBINS))
(BINEDNUMBERS (MAKE-ARRAY NBINS (QUOTE :INITIAL-ELEMENT)
0))
MARKS) (* MARKS is a list of the NBINS plus 1 bin end points)
(SETQ MARKS (NCONC1 (for I from 1 to (fetch (BININTERVAL NBINS) of
BININTERVAL)
as MARK from (fetch (BININTERVAL BINMIN) of BININTERVAL)
by (fetch (BININTERVAL BININC) of BININTERVAL)
collect MARK)
(fetch (BININTERVAL BINMAX) of BININTERVAL)))
(* 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)
(bind INDEX for NUM in BATCH
do (SETQ INDEX (find I from 0 as MARK in (CDR MARKS)
suchthat (LESSP NUM MARK)))
(ASET (ADD1 (AREF BINEDNUMBERS INDEX))
BINEDNUMBERS INDEX))
(PLOTPROP HISTOGRAM (QUOTE BINEDNUMBERS)
(for I from 0 to (SUB1 NBINS) collect (AREF BINEDNUMBERS I)))
(PLOTPROP HISTOGRAM (QUOTE MARKS)
MARKS])
(HISTPLOT
[LAMBDA (BATCH) (* jop: "15-Jan-86 12:39")
(* * 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)
(LET* ((HISTOGRAM (CREATEPLOT))
(BATCHSIZE (LENGTH BATCH))
(TOPLABEL "Histogram")
(NBINS (NUMBER-OF-BINS BATCHSIZE))) (* Set up a few key PLOT PROP'S)
(PLOTPROP HISTOGRAM (QUOTE BATCH)
BATCH)
(PLOTPROP HISTOGRAM (QUOTE BATCHSIZE)
BATCHSIZE)
(PLOTPROP HISTOGRAM (QUOTE NBINS)
NBINS) (* Bin the BATCH)
(* (HISTO.MAKEBINS HISTOGRAM))
(HISTO.MAKEBINS HISTOGRAM) (* Add label to top of HISTOGRAM)
(PLOTLABEL HISTOGRAM (QUOTE TOP)
TOPLABEL T) (* Draw the histogram based on the PLOT PROP's)
(HISTO.DRAW HISTOGRAM) (* Returns a PLOT)
HISTOGRAM])
(LOGO.DRAW
[LAMBDA (LOGOGRAM) (* jop: "19-May-86 17:53")
(* * LOGOGRAM is a PLOT with PROP's N NBINS BININTERVAL BINEDNUMBERS
RECTANGLES, and PRETTYINTERVAL)
(PROG ((BINEDNUMBERS (PLOTPROP LOGOGRAM (QUOTE BINEDNUMBERS)))
(MARKS (PLOTPROP LOGOGRAM (QUOTE MARKS)))
NEWSCALES) (* An optimization to speed up adding
rectangles to the plot --
extends the scale once)
(* Construct the new image)
(for NUMBERINBIN in BINEDNUMBERS as LOWMARK in MARKS as HIGHMARK in (CDR MARKS)
when (GREATERP NUMBERINBIN 0) do (PLOTFILLEDRECTANGLE LOGOGRAM LOWMARK 0
(DIFFERENCE HIGHMARK LOWMARK)
NUMBERINBIN
(CONCAT NUMBERINBIN " Obs. between " LOWMARK
" and " HIGHMARK)
SHADE3 NIL NIL T))
(* Rescale the Histogram)
(RESCALEPLOT LOGOGRAM (QUOTE BOTH)
T) (* refresh the image)
(REDRAWPLOTWINDOW LOGOGRAM])
(LOGO.MAKEBINS
[LAMBDA (LOGOGRAM) (* jop: "19-May-86 17:54")
(* * Computes a BIN interval and the BINEDNUMBERS based on PLOT props.)
(LET* ((NBINS (PLOTPROP LOGOGRAM (QUOTE NBINS)))
(BATCH (PLOTPROP LOGOGRAM (QUOTE BATCH)))
(BATCHMIN (for NUM in BATCH smallest NUM))
(BATCHMAX (for NUM in BATCH largest NUM))
(BININTERVAL (MAKEBININTERVAL BATCHMIN BATCHMAX NBINS))
(BINEDNUMBERS (MAKE-ARRAY NBINS (QUOTE :INITIAL-ELEMENT)
0))
MARKS) (* MARKS is a list of the NBINS plus 1
bin end points)
(SETQ MARKS (NCONC1 (for I from 1 to (fetch (BININTERVAL NBINS) of BININTERVAL)
as MARK from (fetch (BININTERVAL BINMIN) of BININTERVAL)
by (fetch (BININTERVAL BININC) of BININTERVAL) collect MARK)
(fetch (BININTERVAL BINMAX) of BININTERVAL)))
(* 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)
(bind INDEX for NUM in BATCH do (SETQ INDEX (find I from 0 as MARK
in (CDR MARKS) suchthat (LESSP NUM MARK)))
(ASET (ADD1 (AREF BINEDNUMBERS INDEX))
BINEDNUMBERS INDEX))
[PLOTPROP LOGOGRAM (QUOTE BINEDNUMBERS)
(for I from 0 to (SUB1 NBINS) collect (LOG (ADD1 (AREF BINEDNUMBERS I]
(PLOTPROP LOGOGRAM (QUOTE MARKS)
MARKS])
(LOGOPLOT
[LAMBDA (BATCH) (* jop: "19-May-86 17:54")
(* * 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)
(LET* ((LOGOGRAM (CREATEPLOT))
(BATCHSIZE (LENGTH BATCH))
(TOPLABEL "Logogram")
(NBINS (NUMBER-OF-BINS BATCHSIZE))) (* Set up a few key PLOT PROP'S)
(PLOTPROP LOGOGRAM (QUOTE BATCH)
BATCH)
(PLOTPROP LOGOGRAM (QUOTE BATCHSIZE)
BATCHSIZE)
(PLOTPROP LOGOGRAM (QUOTE NBINS)
NBINS) (* Bin the BATCH)
(* (HISTO.MAKEBINS LOGOGRAM))
(LOGO.MAKEBINS LOGOGRAM) (* Add label to top of LOGOGRAM)
(PLOTLABEL LOGOGRAM (QUOTE TOP)
TOPLABEL T) (* Draw the histogram based on the
PLOT PROP's)
(LOGO.DRAW LOGOGRAM) (* Returns a PLOT)
LOGOGRAM])
(NUMBER-OF-BINS
[LAMBDA (N) (* jop: "15-Jan-86 13:38")
(FIXR (TIMES 10 (PLOT.LOG10 N])
(MAKEBININTERVAL
[LAMBDA (BATCHMIN BATCHMAX NBINS INTFLG) (* jop: " 9-Jan-86 16:42")
(* *)
(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])
(SNAPSCREEN
[LAMBDA (BM SCALE) (* jop: "19-May-86 17:36")
(BITMAPTEDITOBJ (OR BM (BITMAPCOPY (SCREENBITMAP)))
(OR SCALE .5])
)
[DECLARE: EVAL@COMPILE
(RECORD BININTERVAL (BINMIN BINMAX BININC NBINS))
]
(RPAQQ DATA
(.2696728 .2968236 -.7876302 .6222596 .2196549 .1898454 .6259271 .6376168 .8839008 .1154824
.7437894 .4891711 -.3652292 .1539875 -.3773931 -.5595354 .7560991 -.9755152 -.9968518
-.6638787 -.662383 -.8682778 -.4636112 .780136 .8983866 -.8473772 .8515804 -.9910488
.6688705 -.921014 -.5456739 -.3693008 .984716 .7236375 .7426192 .3215012 .150682
-.3899213 .1090956 .7564017 .2322166 -.8393076 -.952917 -.5902187 -.9353654 .9517152
.9366858 .6430499 .4412507 .2498168 .8954604 -.5694289 -.9924798 -.6115247 -.927683
-.7934208 -.880632 -.7681321 .9292772 .7048157 .9657528 -.794305 -.6643842 -.4802305
.6642233 -.7076029 -.2372223 -.4747018 -.7924202 -.5172206 -.4678051 .83325 -.6042705
-.4340686 .7048806 -.4905105 .7552106 -.4794992 -.1320058 .8171255 .9547086 .7076029
.7796468 .7640889 -.587394 -.4800399 -.710959 .6411488 -.4957091 -.9432442 -.6292337
-.9596982 -.962651 -.6001404 -.400424 -.8527802 -.6314608 .676086 .9165466 -.6097255
0.0 0.0 0.0 0.0 0.0 0.0 0.0 0.0 0.0 0.0 0.0 0.0 0.0 0.0 0.0 0.0 0.0 0.0 0.0 0.0 0.0 0.0
0.0 0.0 0.0 0.0 0.0 0.0 0.0 0.0 0.0 0.0 0.0 0.0 0.0 0.0 0.0 0.0 0.0 0.0 0.0 0.0 0.0 0.0
0.0 0.0 0.0 0.0 0.0 0.0 0.0 0.0 0.0 0.0 0.0 0.0 0.0 0.0 0.0 0.0 0.0 0.0 0.0 0.0 0.0 0.0
0.0 0.0 0.0 0.0 0.0 0.0 0.0 0.0 0.0 0.0 0.0 0.0 0.0 0.0 0.0 0.0 0.0 0.0 0.0 0.0 0.0 0.0
0.0 0.0 0.0 0.0 0.0 0.0 0.0 0.0 0.0 0.0 0.0 0.0))
(PUTPROPS HISTEXAMPLE COPYRIGHT ("Xerox Corporation" 1986))
(DECLARE: DONTCOPY
(FILEMAP (NIL (660 11111 (BMFROMW 670 . 926) (HISTO.DRAW 928 . 2551) (HISTO.MAKEBINS 2553 . 4261) (
HISTPLOT 4263 . 5440) (LOGO.DRAW 5442 . 7058) (LOGO.MAKEBINS 7060 . 9038) (LOGOPLOT 9040 . 10326) (
NUMBER-OF-BINS 10328 . 10487) (MAKEBININTERVAL 10489 . 10914) (SNAPSCREEN 10916 . 11109)))))
STOP