home *** CD-ROM | disk | FTP | other *** search
/ BMUG PD-ROM A / PD-ROM A.iso / Programming / Programming Languages / Gambit LISP / pi.scm < prev    next >
Encoding:
Text File  |  1991-01-28  |  1.1 KB  |  41 lines  |  [TEXT/gamI]
  1. ; Compute pi
  2.  
  3. (define (square x) (* x x))
  4.  
  5. (define (expt b n)
  6.   (cond ((= n 0) 1)
  7.         ((negative? n) (/ 1 (expt b (abs n))))
  8.         ((even? n) (square (expt b (/ n 2))))
  9.         (else (* b (expt b (- n 1))))))
  10.  
  11. (define (partial-sum i n e ee base)
  12.   (- (quotient base (* i e))
  13.      (quotient base (* (+ 2 i) ee))))
  14.  
  15. (define (a n base)  ; atan(1/n)
  16.   (do ((i 1 (+ 4 i))
  17.        (delta 1 (partial-sum i n e (* e n n) base))
  18.        (e n (* e n n n n))
  19.        (sum 0 (+ sum delta)))
  20.       ((zero? delta) sum)))
  21.  
  22. (define (calc-pi base)
  23.   (- (* 32 (a  10 base))
  24.      (* 16 (a 515 base))
  25.      (*  4 (a 239 base))))
  26.  
  27. (define (run)
  28.   (display "How many digits of pi do you want (0 to exit): ")
  29.   (let ((num (read)))
  30.     (if (and (not (eof-object? num)) (integer? num) (positive? num))
  31.       (let* ((extra (+ 5 10)) ; was (extra (+ 5 (truncate (log num))))
  32.            (base (expt 10 (+ num extra)))
  33.            (pi (calc-pi base)))
  34.         (display (quotient pi base))
  35.         (display ".")
  36.         (display (quotient (remainder pi base) (expt 10 extra)))
  37.         (newline)
  38.         (run)))))
  39.  
  40. (run)
  41.