Psych 285: Computational Statistics
and Statistical Visualization

Professor Forrest Young

Lisp Programming Examples

These short examples follow Luke Tierney's text. You may copy this page and work your way through these examples without having to type them in.


  • Examples from Chapter 4
    (excluding array & matrix examples)
  • 
    ;
    ;-=-=-=-=-=-=-=-=-=-=-=
    ;Section 4.2 Defining More Flexible Functions
    ;-=-=-=-=-=-=-=-=-=-=-=
    ;
    
    ;keyword arguments
    
    (defun factorial (n &key print)
      (if print (format t "n = ~d~%" n))
      (if (= n 0) 1 (* (factorial (- n 1) :print print) n)))
    
    ;optional arguments
    
    (defun factorial (n &optional print)
      (if print (format t "n = ~d~%" n))
      (if (= n 0) 1 (* (factorial (- n 1) :print print) n)))
    
    ;variable number of arguments
    
    (defun vec+ (&rest args)
      (if (some #'compound-data-p args)
          (apply #'map-elements #'vec+ args)
          (apply #'+ args)))
    
    ;
    ;-=-=-=-=-=-=-=-=-=-=-=
    ;Section 4.3 Control Structure
    ;-=-=-=-=-=-=-=-=-=-=-=
    ;
    
    ;4.3.1 - case, when, unless, cond
    
    ;4.3.2 - looping with do, but especially dotimes and dolist.
    
    ;
    ;-=-=-=-=-=-=-=-=-=-=-=
    ;Section 4.4 Basic Lisp Data and Functions
    ;-=-=-=-=-=-=-=-=-=-=-=
    ;
    
    ;4.4.1 Numbers - integer, float (single, double), complex
    
    ;4.4.2 Strings are lists of characters
    
    ;4.4.3 Symbols are identifyers
    
    ;4.4.4 Lists are the basic tool for constructing complex structures
    
    (setf alist (list 1 2 3 4 5 6 7 8 9 10))
    
    ;Functions first, second,... ninth, nth, rest, last, append
    (first alist)
    (third alist)
    (last alist)
    (rest alist)
    (append alist alist)
    
    ;      Lists as sets:
    
    ;Functions: member, adjoin, union, intersection, set-difference
    (member '2 alist)
    
    ;4.4.5 Vectors - a sequence of numbers accessed positionally 
    ;                (lists are a sequence of numbers accessed sequentially)
    ; note the #( ... ) syntax
    (setf avector #(1 2 3 4 5))
    
    
    ;4.4.6 Sequences - a list, vector or string
    ;functions for sequences include
    ;length, elt, coerce, concatenate, map, some, reverse, remove, find, position
    (length avector)
    (elt avector 3)
    (coerce avector 'list)
    (concatenate 'list avector alist)
    (combine avector alist)
    (adjoin avector alist)
    (append avector alist)
    (some #'< (repeat 1 (length avector)) avector)
    (reverse avector)
    (remove '3 (reverse avector))
    (find '3 avector)
    (position '2 (reverse avector))
    
    ;4.5 Odds and Ends
    
    (error "This is an error message")
    
    ;documentation, help, apropos
    
    (defun pm (matrix &optional (decimals 2))
    "Args: (matrix &optional (decimals 2))
    Prints a matrix with precision specified by decimals (default is 2). Matrix may contain string values." 
      (print-matrix-to-window matrix nil :decimals decimals) 
      t)
    
    (defun print-matrix-to-window (a window-object &key labels (decimals 2))
    "Args: (matrix window-object &key labels types)
    Prints MATRIX in WINDOW-OBJECT in a nice format with DECIMALS places after the decimal, and with optional row labels when the :LABELS keyword is followed by a list of labels. Prints to stdio if window-object is nil. Modified version of the print-matrix function written by Luke Tierney. Modified by FWY 08/24/91. Modified by FWY for XLSP+ 7/19/94. Modified again by FWY 8/30/96 for decimals."
      (unless (matrixp a) (error "not a matrix - ~a" a)) 
       (let ((size 0)
             (sizea 0)
             (j 0)) 
         (dotimes (i (length (row a 0)))
          (if (not (stringp (first (coerce (col a i) 'list))))
           (setf size (max size (+ 4 (flatsize (round (max (abs (col a i))))))))
           (setf sizea (max (mapcar #'length (coerce (col a i) 'list))))))
         (dolist (x (row-list a))
                (let ((n (length x)))
                  (dotimes (i n)
                           (let ((y (aref x i)))
                             (cond
                               ((integerp y)
                                (if window-object
                                    (send window-object :paste-string
                                          (format nil "~vd" size y))
                                    (format t "~vd" size y))
                                )
                               ((floatp y)
                                (if window-object
                                    (send window-object :paste-string
                                          (format nil "~v,2f" size y))
                                    (format t "~v,vf" (+ decimals size)
                                            decimals y))
                                )
                               (t 
                                (if window-object
                                    (send window-object :paste-string
                                          (format nil "~va" sizea y))
                                    (format t "~va" sizea y))
                                )))
                           (if (< i (- n 1))
                              (if window-object
                                  (send window-object :paste-string
                                        (format nil " "))
                                  (format t " "))
                                  )
                           (if (and (not (equal labels nil)) (= i (- n 1)))
                               (if window-object
                                   (send window-object :paste-string
                                         (format nil " ~a" (select labels j)))
                                   (format t " ~a" (select labels j)))
                                   )
                           )
                  (setf j (+ j 1))
                           (if window-object
                               (send window-object :paste-string 
                                     (format nil "~%"))
                               (format t "~%"))
                               ))
        nil))
    
    (help 'pm)
    (apropos 'pm)
    
    *features*
    #+macintosh(print "Mac")
    #+msdos(Print "MSDos")
    
    (defun break-function (x)
        (break)
        )