AI gen code

foo.scheme

#!chezscheme
;; ============================================================================
;;  pi-demo.ss  --  A longer Chez Scheme demo (~250 lines) that computes π
;;
;;  Features:
;;   - Multiple π algorithms:
;;       * Machin-like arctan formula (fast, good for many digits)
;;       * Gauss–Legendre (quadratic convergence, very fast)
;;       * Monte Carlo (fun + stats; slow for precision)
;;       * Leibniz (educational; very slow)
;;   - Small CLI parser (no external libs)
;;   - Timing + simple benchmarking output
;;   - Basic unit-ish checks
;;
;;  Run examples:
;;    scheme --script pi-demo.ss
;;    scheme --script pi-demo.ss --algo machin --terms 2000
;;    scheme --script pi-demo.ss --algo gauss --iters 6
;;    scheme --script pi-demo.ss --algo mc --samples 5000000
;;    scheme --script pi-demo.ss --algo leibniz --iters 20000000
;;
;;  Notes:
;;   - Most algorithms below use inexact reals (flonums) for speed.
;;   - Gauss–Legendre benefits from higher precision; for true big-digit
;;     π you'd want bigfloats / libraries; this is a demo.
;; ============================================================================

;; ----------------------------------------------------------------------------
;; Utilities: printing, formatting, simple timing
;; ----------------------------------------------------------------------------

(define (println . xs)
  (for-each display xs)
  (newline))

(define (string->number* s default)
  (let ((n (string->number s)))
    (if n n default)))

(define (now-ms)
  ;; Chez: (current-time) returns a time record; (time-second ...) gives seconds.
  ;; Convert to milliseconds (coarse but fine for a demo timer).
  (inexact->exact (floor (* 1000 (time-second (current-time))))))

(define (time-thunk label thunk)
  (let ((t0 (now-ms)))
    (let ((v (thunk)))
      (let ((t1 (now-ms)))
        (println label ": " (- t1 t0) " ms")
        v))))

(define (abs x) (if (< x 0) (- x) x))

(define (approx=? a b eps)
  (< (abs (- a b)) eps))

;; ----------------------------------------------------------------------------
;; CLI parsing
;; ----------------------------------------------------------------------------

;; Very small args parser:
;;  --algo machin|gauss|mc|leibniz
;;  --terms N         (machin arctan series terms)
;;  --iters N         (gauss/leibniz iterations)
;;  --samples N       (monte carlo samples)
;;  --seed N          (monte carlo random seed)
;;  --help
;;
;; Returns an alist: '((algo . "machin") (terms . 1000) ...)
;; ----------------------------------------------------------------------------

(define (args->alist argv)
  (let loop ((i 1) ; argv[0] is script name
             (acc '()))
    (if (>= i (vector-length argv))
        acc
        (let ((a (vector-ref argv i)))
          (cond
            ((string=? a "--help")
             (loop (+ i 1) (cons (cons 'help #t) acc)))
            ((string=? a "--algo")
             (let ((v (if (< (+ i 1) (vector-length argv))
                          (vector-ref argv (+ i 1))
                          "machin")))
               (loop (+ i 2) (cons (cons 'algo v) acc))))
            ((string=? a "--terms")
             (let ((v (if (< (+ i 1) (vector-length argv))
                          (string->number* (vector-ref argv (+ i 1)) 1000)
                          1000)))
               (loop (+ i 2) (cons (cons 'terms v) acc))))
            ((string=? a "--iters")
             (let ((v (if (< (+ i 1) (vector-length argv))
                          (string->number* (vector-ref argv (+ i 1)) 6)
                          6)))
               (loop (+ i 2) (cons (cons 'iters v) acc))))
            ((string=? a "--samples")
             (let ((v (if (< (+ i 1) (vector-length argv))
                          (string->number* (vector-ref argv (+ i 1)) 2000000)
                          2000000)))
               (loop (+ i 2) (cons (cons 'samples v) acc))))
            ((string=? a "--seed")
             (let ((v (if (< (+ i 1) (vector-length argv))
                          (string->number* (vector-ref argv (+ i 1)) 12345)
                          12345)))
               (loop (+ i 2) (cons (cons 'seed v) acc))))
            (else
             ;; ignore unknown flags to keep the demo tolerant
             (loop (+ i 1) acc)))))))

(define (alist-ref al k default)
  (let ((p (assq k al)))
    (if p (cdr p) default)))

(define (usage)
  (println "Usage:")
  (println "  scheme --script pi-demo.ss [options]")
  (println "")
  (println "Options:")
  (println "  --algo machin|gauss|mc|leibniz")
  (println "  --terms N       (Machin arctan series terms; default 1000)")
  (println "  --iters N       (Gauss/Leibniz iters; default 6 for gauss, 2e7 suggested for leibniz)")
  (println "  --samples N     (Monte Carlo samples; default 2000000)")
  (println "  --seed N        (Monte Carlo seed; default 12345)")
  (println "  --help")
  (println ""))

;; ----------------------------------------------------------------------------
;; π reference (double precision) for error reporting
;; ----------------------------------------------------------------------------

(define PI-REF 3.14159265358979323846264338327950288419716939937510)

;; ----------------------------------------------------------------------------
;; Algorithm 1: Machin-like π using arctan series
;;   π = 16*atan(1/5) - 4*atan(1/239)
;;
;; Taylor:
;;   atan(x) = x - x^3/3 + x^5/5 - ...
;; ----------------------------------------------------------------------------

(define (atan-series x terms)
  ;; Compute atan(x) with `terms` terms using an incremental recurrence.
  ;; term_k = (-1)^k * x^(2k+1)
  ;; sum += term_k / (2k+1)
  (let loop ((k 0)
             (term x)
             (sum 0.0))
    (if (= k terms)
        sum
        (let* ((den (+ (* 2 k) 1))
               (sum2 (+ sum (/ term den)))
               ;; next term: term * x^2 * -1
               (term2 (* term x x -1.0)))
          (loop (+ k 1) term2 sum2)))))

(define (pi-machin terms)
  (let ((a (atan-series (/ 1.0 5.0) terms))
        (b (atan-series (/ 1.0 239.0) terms)))
    (- (* 16.0 a) (* 4.0 b))))

;; ----------------------------------------------------------------------------
;; Algorithm 2: Gauss–Legendre
;;   a0 = 1
;;   b0 = 1/sqrt(2)
;;   t0 = 1/4
;;   p0 = 1
;;   a_{n+1} = (a_n + b_n)/2
;;   b_{n+1} = sqrt(a_n*b_n)
;;   t_{n+1} = t_n - p_n*(a_n - a_{n+1})^2
;;   p_{n+1} = 2*p_n
;;   π ≈ (a_n + b_n)^2 / (4*t_n)
;; ----------------------------------------------------------------------------

(define (pi-gauss-legendre iters)
  (let loop ((n 0)
             (a 1.0)
             (b (/ 1.0 (sqrt 2.0)))
             (t 0.25)
             (p 1.0))
    (if (= n iters)
        (/ (* (+ a b) (+ a b)) (* 4.0 t))
        (let* ((a2 (/ (+ a b) 2.0))
               (b2 (sqrt (* a b)))
               (diff (- a a2))
               (t2 (- t (* p diff diff)))
               (p2 (* 2.0 p)))
          (loop (+ n 1) a2 b2 t2 p2)))))

;; ----------------------------------------------------------------------------
;; Algorithm 3: Monte Carlo π
;;   Random points (x,y) in [0,1]^2
;;   π ≈ 4 * (# inside quarter circle) / N
;;
;; Chez Scheme has a built-in random generator:
;;   (random n) -> integer 0..n-1
;; We'll build random in [0,1) using a large integer range.
;; ----------------------------------------------------------------------------

(define (make-rand01 seed)
  ;; Simple LCG for reproducibility across runs/platforms.
  ;; Returns a thunk that yields a uniform-ish float in [0,1).
  (let ((state (modulo seed 2147483647)))
    (lambda ()
      ;; Park-Miller LCG-ish
      (set! state (modulo (* state 48271) 2147483647))
      (/ state 2147483647.0))))

(define (pi-monte-carlo samples seed)
  (let ((r (make-rand01 seed)))
    (let loop ((i 0)
               (inside 0))
      (if (= i samples)
          (* 4.0 (/ inside samples))
          (let* ((x (r))
                 (y (r))
                 (d (+ (* x x) (* y y)))
                 (inside2 (if (<= d 1.0) (+ inside 1) inside)))
            (loop (+ i 1) inside2))))))

;; ----------------------------------------------------------------------------
;; Algorithm 4: Leibniz series (slow)
;;   π = 4 * sum_{k=0..N-1} (-1)^k / (2k+1)
;; ----------------------------------------------------------------------------

(define (pi-leibniz iters)
  (let loop ((k 0)
             (sign 1.0)
             (sum 0.0))
    (if (= k iters)
        (* 4.0 sum)
        (let* ((den (+ (* 2.0 k) 1.0))
               (sum2 (+ sum (* sign (/ 1.0 den)))))
          (loop (+ k 1) (- sign) sum2)))))

;; ----------------------------------------------------------------------------
;; Reporting helpers
;; ----------------------------------------------------------------------------

(define (report name pi-est)
  (let ((err (abs (- pi-est PI-REF))))
    (println "")
    (println "Algorithm: " name)
    (println "pi        : " pi-est)
    (println "abs error : " err)
    (println "ok?       : " (if (< err 1e-9) "yes (<1e-9)" "no"))))

;; ----------------------------------------------------------------------------
;; Tiny tests (not a full framework)
;; ----------------------------------------------------------------------------

(define (run-tests)
  (println "Running quick sanity checks...")
  (let ((p1 (pi-machin 200))
        (p2 (pi-gauss-legendre 4))
        (p3 (pi-monte-carlo 200000 12345))
        (p4 (pi-leibniz 2000000)))
    (println "  Machin 200 terms close? " (approx=? p1 PI-REF 1e-12))
    (println "  Gauss  4 iters close?   " (approx=? p2 PI-REF 1e-12))
    (println "  MC 200k samples close?  " (approx=? p3 PI-REF 5e-3))
    (println "  Leibniz 2e6 close?      " (approx=? p4 PI-REF 5e-4))
    (println "Done.")
    (newline)))

;; ----------------------------------------------------------------------------
;; Main dispatcher
;; ----------------------------------------------------------------------------

(define (main)
  (let* ((argv (list->vector (command-line)))
         (opts (args->alist argv))
         (help? (alist-ref opts 'help #f))
         (algo (alist-ref opts 'algo "machin"))
         (terms (alist-ref opts 'terms 1000))
         (iters (alist-ref opts 'iters 6))
         (samples (alist-ref opts 'samples 2000000))
         (seed (alist-ref opts 'seed 12345)))
    (when help?
      (usage)
      (exit 0))

    (println "Chez Scheme π demo")
    (println "------------------------------------------------------------")
    (println "algo   : " algo)
    (println "terms  : " terms)
    (println "iters  : " iters)
    (println "samples: " samples)
    (println "seed   : " seed)
    (println "------------------------------------------------------------")

    ;; Optional tests for confidence in the demo program
    (run-tests)

    (cond
      ((or (string=? algo "machin") (string=? algo "m"))
       (let ((pi (time-thunk "Machin time"
                             (lambda () (pi-machin terms)))))
         (report "Machin (arctan series)" pi)))

      ((or (string=? algo "gauss") (string=? algo "gl"))
       (let ((pi (time-thunk "Gauss–Legendre time"
                             (lambda () (pi-gauss-legendre iters)))))
         (report "Gauss–Legendre" pi)))

      ((or (string=? algo "mc") (string=? algo "montecarlo"))
       (let ((pi (time-thunk "Monte Carlo time"
                             (lambda () (pi-monte-carlo samples seed)))))
         (report "Monte Carlo" pi)))

      ((or (string=? algo "leibniz") (string=? algo "l"))
       (let ((pi (time-thunk "Leibniz time"
                             (lambda () (pi-leibniz iters)))))
         (report "Leibniz series" pi)))

      (else
       (println "Unknown --algo: " algo)
       (println "")
       (usage)
       (exit 2)))

    (newline)
    (println "Tip: For good precision, try:")
    (println "  --algo machin --terms 2000")
    (println "  --algo gauss  --iters 6")
    (println "For fun stats (no precision), try:")
    (println "  --algo mc --samples 5000000 --seed 42")
    (newline)))

(main)