Test Lisp Snippet

LISP

(defun call-random (m n)
  "(m n)
Call (random n) m times. Used by seed-random."
  (do ((i 0 (1+ i)))
      ((= i m) nil)
    (if (zerop n) 
        (random 1)
      (random n))))

;;;file: r.cl
;;;purpose: pearson r in modular fashion
;;;programmer: Tom Shultz
;;;started: 2 jan 08
;;;current: 3 jan 08

(defun total (scores)
  "(scores)
Sum of scores."
  (do ((x scores (cdr x))
       (sum 0 (+ (car x) sum)))
      ((null x) sum)))

;;;(total '(1 2 3 4))

(defun sum-squares (scores)
  "(scores)
Sum of squares of scores."
  (do ((x scores (cdr x))
       (ss 0 (+ (expt (car x) 2)
                ss)))
      ((null x) ss)))

;;;(sum-squares '(1 2 3 4))

(defun sum-squared-deviations (scores)
  "(scores)
Sum of squared deviations of scores."
  (- (sum-squares scores)
     (float (/ (expt (total scores) 2)
               (length scores)))))

;;;(sum-squared-deviations '(1 2 3 4))

(defun dot* (x y)
  "(x y)
Sum of products of corresponding x & y scores."
  (do ((xs x (cdr xs))
       (ys y (cdr ys))
       (sum 0 (+ (* (car xs) (car ys))
                 sum)))
      ((null xs) sum)))

;;;(dot* '(1 2 3) '(4 5 6))

(defun covariance (x y)
  "(x y)
Covariance of corresponding x & y scores."
  (- (dot* x y)
     (/ (* (total x) (total y))
        (length x))))

;;;(covariance '(1 2 3) '(4 5 6))

(defun r (x y)
  "(x y)
Pearson r between x & y scores."
  (/ (covariance x y)
     (sqrt (* (sum-squared-deviations x)
              (sum-squared-deviations y)))))

;;;(r '(5 10 5 11 12 4 3 2 7 1)
;;;   '(1 6 2 8 5 1 4 6 5 2))
;;;
;;;(r '(22 6 20 8 0 17 21 13 14 5 6 4 9 8 6 0 
;;;     0 22 16 13 7 10 6 16 13 0 0 0 12 4 12 0)
;;;   '(136 106 116 139 103 126 131 137 144 130 133 123 134 132 117 128 
;;;     101 128 122 111 129 117 116 129 109 103 104 111 131 112 134 101))
;;;
;;;(r '(3 7 2 9 8 4 1 10 6 5)
;;;   '(11 1 19 5 17 3 15 9 15 8))

(defun r&df (x y)
  "(x y)
List of r between x & y scores & df"
  (list (r x y)
        (- (length x) 2)))