codepad

Language:

; ancient algorithms

(define (product left right)
  (let loop ((left left) (right right) (prod 0))
    (if (zero? left) prod
      (loop (quotient left 2) (* right 2)
            (if (odd? left) (+ prod right) prod)))))

(display (product 7 8)) (newline)

(define (hero n)
  (cond ((< n 1) (/ (hero (* n 4)) 2))
        ((<= 4 n) (* (hero (/ n 4)) 2))
        (else (let* ((x (/ (+ n 1.0) 2))
                     (x (/ (+ x (/ n x)) 2))
                     (x (/ (+ x (/ n x)) 2))
                     (x (/ (+ x (/ n x)) 2))
                     (x (/ (+ x (/ n x)) 2))
                     (x (/ (+ x (/ n x)) 2)))
                x))))

(display (hero 1000)) (newline)
(display (hero 0.001)) (newline)

(define (triple m n)
  (values (- (* m m) (* n n))
          (* 2 m n)
          (+ (* m m) (* n n))))

(call-with-values
  (lambda () (triple 2 1))
  (lambda (a b c)
    (display a) (display " ")
    (display b) (display " ")
    (display c) (newline)))

(define (ancient m n)
  (cond ((< m n) (ancient m (- n m)))
        ((< n m) (ancient (- m n) n))
        (else m)))

(display (ancient 21 35)) (newline)
(display (ancient 35 21)) (newline)

(define (modern m n)
  (if (zero? n) m
    (modern n (modulo m n))))

(display (modern 21 35)) (newline)
(display (modern 35 21)) (newline)

(define (pi n)
  (let ((outer (* 3 (sqrt 3))))
    (let loop ((n n) (outer outer) (inner (/ outer 2)))
      (if (= n 1) (values inner outer)
        (let ((outer (/ 2 (+ (/ outer) (/ inner)))))
          (loop (- n 1) outer (sqrt (* outer inner))))))))

(call-with-values
  (lambda () (pi 6))
  (lambda (lo hi)
    (display lo) (display " ")
    (display hi) (newline)))

(define (primes n)
  (let ((sieve (make-vector (+ n 1) #t)))
    (do ((p 2 (+ p 1))) ((< n p) (newline))
      (when (vector-ref sieve p)
        (display p) (display " ")
        (do ((i (* p p) (+ i p))) ((< n i))
          (vector-set! sieve i #f))))))

(primes 100)

Private [?]

Run code