May 31, 2010
at
Monday, May 31, 2010
Labels:
Computer Science,
Lisp,
SICP
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))))
Subscribe to:
Post Comments (Atom)
0 comments:
Post a Comment