May 31, 2010

at Monday, May 31, 2010 Labels: , , Posted by Billy

;;; SICP Section 3.1

;;; 3.1
(defun make-accumulator (n)
  (lambda (x)
    (incf n x)))

;;; 3.2
(defun make-monitored (f)
  (let ((count 0))
    (lambda (x)
      (cond ((eq x 'how-many-calls?) count)
     ((eq x 'reset-count) (setf count 0))
     (t (incf count)
        (funcall f x))))))

;;; 3.3 and 3.4 - updated for 3.7
(defun make-account (balance password)
  (let ((consecutive-attempts 0))
    (labels ((withdraw (amount)
        (if (>= balance amount)
     (setf balance (- balance amount))
     "Insufficient funds"))
      (deposit (amount)
        (setf balance (+ balance amount)))
      (dispatch (pass m)
        (cond
   ;; Incorrect password?
   ((not (eq pass password))
    (lambda (x)
      (if (<= 7 (incf consecutive-attempts))
   "Calling cops"
   "Incorrect password")))
   ;; Withdrawing?
   ((eq m 'withdraw)
    (setf consecutive-attempts 0)
    #'withdraw)
   ;; Depositing?
   ((eq m 'deposit)
    (setf consecutive-attempts 0)
    #'deposit)
   ;; Creating joint account?
   ((eq m 'joint)
    (lambda (new-pass)
      (lambda (pass m)
        (if (eq pass new-pass)
     (funcall #'dispatch password m)
     (funcall #'dispatch nil m)))))
   (t (error "Unknown request -- MAKE-ACCOUNT")))))
      #'dispatch)))

(defun withdraw (acc pwd amt)
  (funcall (funcall acc pwd 'withdraw) amt))

(defun deposit (acc pwd amt)
  (funcall (funcall acc pwd 'deposit) amt))

;;; 3.5
(defun random-in-range (low high)
  (let ((range (- high low)))
    (+ low (random range))))

(defun monte-carlo (trials experiment)
  (labels ((iter (trials-remaining trials-passed)
      (cond ((= trials-remaining 0)
      (float (/ trials-passed trials)))
     ((funcall experiment)
      (iter (- trials-remaining 1) (+ trials-passed 1)))
     (t
      (iter (- trials-remaining 1) trials-passed)))))
    (iter trials 0)))

(defun in-circle-p ()
  (let ((x (random-in-range 0 1.0))
 (y (random-in-range 0 1.0)))
    (<= (+ (expt (- x 0.5) 2)
    (expt (- y 0.5) 2))
 (expt 0.5 2))))

(defun estimate-integral (p x1 x2 y1 y2 trials)
  (let ((area-of-rect (* (- x2 x1)
    (- y2 y1)))
 (frac-inside (monte-carlo trials p)))
    (* frac-inside area-of-rect)))

;;; 3.6
(let ((st (make-random-state)))
  (defun rnd (sym)
    (cond ((eq sym 'generate)
    (lambda (x)
      (random x st)))
   ((eq sym 'reset)
    (lambda (x)
      (setf st x)))
   (t "Unknown symbol"))))

;;; 3.7
(defun make-joint (acc pass new-pass)
  (funcall (funcall acc pass 'joint) new-pass))

;;; 3.8
(let ((num 1))
  (defun f (n)
    (setf num (* num n))))

0 comments: