( This page is part of the NOVA system. )

nova/tricks

Some general LISP utilities that should be useful for more than just NOVA.

Files

nova/lisp/tricks/eg.lisp
Unit test code.
nova/lisp/tricks/macros.lisp
Some general utilities.
nova/lisp/tricks/profile.lisp
Code to study the code.
nova/lisp/tricks/lib.lisp
Lots of tricks including:

eg.lisp

The following code defines four tests. The first two define an output expectation (using the ":of" keyword) and if the code does not return what is expected, an error count is incremented by one. 

(egs :unittest
     (eg '(+ 1 2)
	   :of "define an example"
	   :out	3)
     (eg '(+ 10	20)
	 :of "define a failing example"
	 :out 0)
     (eg '(+ 2 3)
	 :of "define an example with any output")
      (eg '(+ 2 3))
     )

A call to "(demo :unittest)" returns the number of failed tests.

macros.lisp

When adding in "print" statements to code, I don't want to type much. 

(defun running-average (l)
  (let ((n 0) (sum 0) average)
    (dolist (x l average)
      (incf n)
      (incf sum x)
      (setf average (/ sum n))
      (o average)
      (oo n sum))))
The call to "o" prints one variable while "oo" calls multiple variables. For example: 
CL-USER> (running-average '(1 2 3 4 5))
[AVERAGE]=[1]
[N]=[1]
[SUM]=[1]
[AVERAGE]=[3/2]
[N]=[2]
[SUM]=[3]
[AVERAGE]=[2]
[N]=[3]
[SUM]=[6]
[AVERAGE]=[5/2]
[N]=[4]
[SUM]=[10]
[AVERAGE]=[3]
[N]=[5]
[SUM]=[15]
3

profile.lisp

This is very SBCL-specific code for finding the hot spots in a system.

It is not loaded as part of the standard NOVA. To use it, it must be first loaded: 

(load "tricks/profile.lisp")
(load "apps/search1.lisp")

In this example, a "search1" function is defined inside "apps/search1.lisp". We can finds its hot spots as follows: 

(watch (search1))

; after some time...

  seconds  |     consed    |    calls   |  sec/call  |  name  
----------------------------------------------------------------
     6.421 | 1,253,569,392 | 11,300,955 |   0.000001 | PARK-MILLER-RANDOMIZER
     3.119 |   586,724,568 | 11,300,955 |  0.0000003 | MY-RANDOM
     0.981 |             0 |  2,700,000 |  0.0000004 | GETA
     0.488 |    59,031,928 |  1,800,000 |  0.0000003 | PIVOTED-LINE
     0.488 |    50,322,272 |  1,703,417 |  0.0000003 | MAKE-EM
     ....
     0.000 |    69,562,096 |  1,800,000 |   0.000000 | EM2EFFORT
     0.000 |             0 |        101 |   0.000000 | MAKE-ONE-B
     0.000 |             0 |        101 |   0.000000 | B-DEFAULTS
     0.000 |        24,576 |        100 |   0.000000 | ALL-POLICIES
----------------------------------------------------------------
    11.955 | 3,566,857,840 | 57,742,702 |            | Total

So this code is saying that the slowest thing in this system is the 11 million calls to the random number generator.

(Note that the traced code much slower than the untraced code.)

lib.lisp: Copyright tricks

The following functions are useful for printing usage and copyright information.

For an example of usage, see boot.html.

lib.lisp: Random tricks

One problem with running a stochastic program is that it is hard to reproduce a bug.

A pseudo-random number generator builds random numbers from a seed, then changes that seed. If the seed is reset to some initial value, then the entire series of "random" numbers can be regenerated.

The following functions are useful for printing usage and copyright information.

The following demo shows 1000 generations of integers 0 ≤ n. This is repeated twice, with a reset called to the seed between run one and two. 
(defun random-demo ()
  (let (counts out)
    (labels 
	((sorter (x y) (< (car x) (car y)))
         (zap    ()    (setf out nil)
	               (reset-seed) 
	               (setf counts (make-hash-table)))
	 (inc    (n)   (setf (gethash n counts) 
			     (1+  (gethash n counts 0)))) 
	 (cache  (k v) (push (list k v) out)))
      (dotimes (i 2 t)
	(zap)
	(dotimes (i 10000) 
	  (inc  (my-random-int 5)))
	(maphash #'cache counts)
	(print (sort out #'sorter))))))

Note that the same random numbers x1,x2,x3,x4,x5 and generated the same n1,n2,n3,n4,n5 number of times. 

CL-USER> (random-demo)
; x1 n1   x2  n2   x3  n3   x4  n4   x5  n5   
((0 1969) (1 1944) (2 1986) (3 2007) (4 2094)) 
((0 1969) (1 1944) (2 1986) (3 2007) (4 2094)) 
T

lib.lisp: Line tricks

Here's a simple abstract data type. 

(defstruct line 
  "A 'line' runs between two points 'x1@y1' to 'x2@y2'
with gradient 'm' and y-intercept 'b'. Also, some runs
are 'verticalp'; i.e. run vertically."
   x1 y1 x2 y2 m b verticalp)

(defun point-to-line (x1 y1 x2 y2) 
  "Create a line from two points."
  (let* ((rise      (- y2 y1))
	 (run       (- x2 x1))
	 (verticalp (zerop run))
	 m 
	 b)
    (if (not verticalp)
	 (setf m    (/ rise run)
	       b    (- y2 (* m x2))))
    (make-line :x1 x1 :y1  y1 :x2 x2 :y2 y2 
	       :m m :b b :verticalp verticalp)))

(defun line-y (x l)
  "Return the 'y' point associated with 'x' on line 'l'."
  (if (line-verticalp l)
      (line-y1 l)
      (+ (* (line-m l)  x) (line-b l))))

lib.lisp: List tricks

(defun as-list (x)
  "Ensure that x is a list."
  (if (listp x)
      x
      (list x)))

(defun geta (key list &optional (default nil))  
  "Return a value from an assocation 'list'' of, if absent, 
   some 'default' value. Maybe this should be a macro?"
  (or 
    (cdr (assoc key list)) 
    default))

lib.lisp: Maths tricks

Sum and mean: 

(defun sum (l)
  "Sum a list of numbers."
  (let ((sum 0))
    (dolist (x l sum)
      (incf sum x))))  

(defun mean (l)
  "Return the mean and sum of list of numbers."
  (let ((sum 0)
	(n   0))
    (dolist (one nums (/ sum n))
      (incf n)
      (incf sum one))))

Standard deviation: 

(defun list2stdev (l)
  "Return the standard deviation of a list of numbers."
  (let ((n 0) (sum 0) (sumSq 0))
    (dolist (x l (stdev n sum sumSq))
      (incf n)
      (incf sum x)
      (incf sumSq (* x x )))))

(defun stdev (n sum sumSq) 
  "Compute the mean and standard deviation."
  (sqrt (/ (- sumSq(/ (* sum sum) n)) (- n 1))))

Mean and standard deviation: 

(defun mean-sd (l)
  "Return the mean and standard deviation of a list of numbers"
  (let ((sum 0)
	(n   0)
	(sumSq 0))
    (labels ((mean () (/ sum n))
	     (sd   () (sqrt (/ (- sumSq(/ (* sum sum) n)) (- n 1) ))))
      (dolist (x l)
	(incf n)
	(incf sum   x)
	(incf sumSq (* x x)))
      (values 
       (mean) 
       (sd)))))

Median: 

(defun median (nums) 
  "Return 50% and (75-50)% values, the 25% value"
  (labels ((mean (x y) (/ (+ x y ) 2)))
    (let* ((n1         (sort nums #'<))
	   (l          (length n1))
	   (mid        (floor (/ l 2)))
	   (midval     (nth mid  n1))
	   (25percent  (nth (floor (* l 0.25)) n1))
	   (75percent  (nth (floor (* l 0.75)) n1))
	   (50percent  (if (oddp l) 
			   midval
			   (mean midval (nth (- mid 1) n1)))))	 
      (values  
       50percent
       (- 75percent 
	  50percent)
       75percent
       25percent))))

lib.lisp: t-test tricks

T-tests compare the means of two independent samples (assumes that the samples are normal distributions). 

(defun ttest-from-lists (one two &optional (conf 95)) 
  "Given two lists of numbers 'a' and 'b', return the ttest result."
  (let ((as 0) (asq 0) (an 0)(bs 0) (bsq 0) (bn 0))
    (dolist (a one) 
      (incf an) (incf as a) (incf asq (* a a)))
    (dolist (b two) 
      (incf bn) (incf bs b) (incf bsq (* b b)))
    (ttest as asq an bs bsq bn :conf conf)))

(defun ttest (as asq an bs bsq bn &key (conf 95))
  "Compares means of two indpendent samples a,b 
  of sizes an,nb, with sums as,bs and sumsquared asq,bsq
  at either a 95 or 99% confidence"
  (labels 
      ((less ()  (< (/ as an) (/ bs bn)))
       (same ()  (let* ((tcrit    (tcritical (+ an bn -2) conf))
			(ssa      (- asq (/ (* as as) an)))
			(ssb      (- bsq (/ (* bs bs) bn)))
			(pooled   (/ (+ ssa ssb) (+ bn  an -2)))
			(sxasb    (sqrt (* pooled (+ (/ 1 an) (/ 1 bn)))))
			(tvalue   (abs (/ (- (/ bs bn) (/ as an)) sxasb))))
		   (oo tcrit tvalue)
		   (> tcrit tvalue))))
    (cond ((same)  0)    ; H0  : mean of a same as mean of b
	  ((less) -1)    ; H1a : mean of a <       mean of b 
	  (t       1)))) ; H1b : mean of a >       mean of b

The above needs some support code: 

(defun tcritical (n conf)
  "Returns the t-test critical values. Keeps those
   values as a piecewise set of lines and intermediary
   values are interpolated between the points."
  (let* ((tvalues '((95 . ((   1  . 12.70   )
			   (   3  .  3.1820 )
			   (   5  .  2.5710 )
			   (  10  .  2.2280 )
			   (  20  .  2.0860 )
			   (  80  .  1.99   )
			   ( 320  .  1.97   )))
		    (99 . ((   1  . 63.6570 )
                           (   3  .  5.8410 )
                           (   5  .  4.0320 )
			   (  10  .  3.1690 )
			   (  20  .  2.8450 )
			   (  80  .  2.64   )
			   ( 320  .  2.58   )))))
	 (tvalues   (geta conf tvalues)))
    (interpolates n tvalues)))

(defun interpolates (x l)
  "return a y value for x by interpolating over (x . y) pairs in l"
  (let* ((one  (pop l))
	 (two  (first l)))
    (or (if (null l) (cdr one))
	(interpolate  x (car one) (cdr one) 
		        (car two) (cdr two))
	(interpolates x l))))

(defun interpolate (x x1 y1 x2 y2)
  "interpolate between the points x1@y2 and x2@y2;
  returns nil if x > x2 and returns x1 if x

And here's code that reproduces an example
in an on-line tutorial:

(defun ttest-demo (&optional (fudge 1))
  "implements the demo described at 
   http://www.cas.buffalo.edu/classes/psy/segal/2072001/ttests/t-tests1.html"
  (let ((one '(105 112  96 124 103  92 97  108 105 110))
	(two '( 98 108 114 106 117 118 126 116 122 108)))
    (setf one (mapcar #'(lambda (x) (* x fudge)) one))
    (ttest-from-lists one two)))




lib.lib: Distribution tricks


If a simulator produces numeric output, a
"dist" (short for "distribution") is a place to
incrementally log that output. 

These "dist"s are space efficient- instead of
storing all numbers, they round values to some
"fuzz" factor then increment counts
of the rounded values;
e.g. if "fuzz" was one, then
 1.2, 1.4, 0.9 would get "fuzzed" to
3*1.

 When numbers
are added then,  some counters are
incremented as a side effect. 

(defstruct dist 
  (min    most-positive-double-float) 
  (max    most-negative-double-float) 
  (bars   '()) 
  (sum    0)
  (sumsq  0)
  (n      0)
  (sorted t)
  (fuzz   1)
)

(defun dist-add (num &optional (d (make-dist)))
  (incf (dist-n      d))
  (incf (dist-sum    d) num)
  (incf (dist-sumsq  d) (* num num))
  (if (< num (dist-min d)) (setf (dist-min d) num))
  (if (> num (dist-max d)) (setf (dist-max d) num))
  (let* ((fuzz (dist-fuzz d))
	 (num1 (* fuzz (round (/ num fuzz))))
	 (val  (cdr (assoc num1 (dist-bars d)))))
    (if val
	(setf (cdr (assoc num1 (dist-bars d))) (1+ val))
	(push (cons num1 1) (dist-bars d)))
    (setf (dist-sorted d) nil))
  d)



This means that "dist" can quickly
compute (e.g.) then  mean, and standard deviation
of the distribution.

(defun dist-mean (d)
  (/ (dist-sum d) (dist-n d)))

(defun dist-sd (d)
  (stdev (dist-n d) (dist-sum d) (dist-sumsq d)))



Two distributions can be compared, via t-tests,
to see if they are statistically significantly
different.

(defun dist-compare (d1 d2 &key (conf 95))
  "compares means of two independent samples d1 d2"
  (ttest (dist-sum d1) (dist-sumsq d1) (dust-n d1)
	 (dist-sum d2) (dist-sumsq d2) (dust-n d2)
	 :conf conf))



Here are some convenience functions:

(defun as-dist (l)
  "Return a dist with all the numbers of l"
  (if (eq 'dist (type-of l))
      l
      (dist-adds l)))

(defun dist-adds (l &optional (d (make-dist)))
  "Add the numbers in the list 'l' to a dist."
  (dolist (x l d)
    (dist-add x d)))

(defun dist-sort (d)
  "Ensure that the bars are sorted."
  (labels ((car< (a b) (< (car a ) (car b))))
    (unless (dist-sorted d) 
      (setf (dist-bars d) (sort (dist-bars d) #'car<)
	    (dist-sorted d) t))
    d))



A "distogram" is a
histogram generated from a "dist". For example, in the following
code, a distogram is a "log" that records one thousand randomly
generated numbers (actually, 1000
 square roots of a randomly generated number).

(defun demo-distogram ()
  (let ((log (make-dist :fuzz 2)))
    (dotimes (i 1000)
      (dist-add (sqrt (random 100)) log))
    (distogram log :shrink 10)
    ))



This produces:

CL-USER> (demo-distogram)
  1.00 *    27 =   2% < ---
  3.00 *    75 =   7% < --------
  5.00 *   172 =  17% < -----------------
  7.00 *   214 =  21% < ---------------------
  9.00 *   335 =  33% < ----------------------------------
 11.00 *   177 =  17% > ------------------



That is, on the last line, in 17% of the runs (177 times),
the square root of  random number from 0 100 was around 11.

This "distogram" was generated by:

(defun distogram (d0 &key 
		  header
		  (lwidth 5) (decimals 2) (rwidth 5)
		  (shrink 1)  (on "-") (pad 4) (str t))
  "Prints the dist 'd0' on stream 'str', shrinking the right hand side
  bars by 'shrink'. 'Header' is some text to show on top. The other 
  variables control details of how each line is printed."
  (let ((d (as-dist d0)))
    (unless (dist-sorted d)
      (dist-sort d))
    (let ((sum   (dist-sum  d))
	  (bars  (dist-bars d))
	  (min   (dist-min  d))
	  (max   (dist-max  d))
	  (n     (dist-n    d))
	  (fuzz  (dist-fuzz d))
	  (percentSum 0)
	  (fmt   
	   (format nil " ~~~a,~af * ~~~ad = ~~3d% ~~a " 
		   lwidth decimals rwidth)))
      (if header
	  (format t "~a~%" header))
      (dolist (bar bars t)
	(let* ((key     (car bar))
	       (value   (cdr bar))
	       (percent (floor (* 100 (/ value n))))
	       (stars   (round (/ value shrink)))
	       (halfp   (< percentSum 50)))
	  (incf percentSum percent)
	  (format str fmt
		  (+ key (/ fuzz 2)) 
		  value 
		  percent
		(if halfp "<" ">")
		)
	  (chars stars on)
	  (terpri str))))))



lib.lisp: Misc tricks


Easy loading


Define a macro "l" that loads a file. If
called with no arguments, it loads the last seen file.
Illustrates the use of lexical closures (note that no
other code except "l" can access the "last-loaded" variable.

(let (last-loaded)
  (defmacro l (&optional (f last-loaded))
    `(progn 
      (setf last-loaded ',f)
      (load (string-downcase (format nil "~a.lisp" ',f)))
      ',f)))



Euclidean distance


(defun euclidean (&rest l)
  "Returns the distance of a point in n-dimensional
  space from the orgin. 
  Example1: (euclidean  1 1) => 1.4142135
  Example2: (euclidean 10 10 10 10) => 20.0"
  (let ((sumsq 0))
    (dolist (x l (sqrt sumsq)) 
      (incf sumsq (* x x)))))



Some environment access tricks
 Illustrates use
of conditional compilation.

(defun my-command-line ()
  "Access the command-line."
  (or   
   #+SBCL *posix-argv*  
   #+LISPWORKS system:*line-arguments-list*
   #+CMU extensions:*command-line-words*
   nil))

(defun my-getenv (name &optional default)
  "Return a variable setting from the environment 
  outside of LISP."
  #+CMU
  (let ((x (assoc name ext:*environment-list* 
		  :test #'string=))) 
    (if x (cdr x)  default)) 
  #-CMU 
  (or #+Allegro   (sys:getenv name)
      #+CLISP     (ext:getenv name) 
      #+ECL       (si:getenv name) 
      #+SBCL      (sb-unix::posix-getenv name) 
      #+LISPWORKS (lispworks:environment-variable name)
      default))



(chars n)


(defun chars (n &optional (c "*") (str t))
  "print a string of characters 'c' to stream 'str'
  (and the default stream is standard output)."
  (if (> n 0)
      (dotimes (i n) (princ c str))))