[ create a new paste ] login | about

Project: programmingpraxis
Link: http://programmingpraxis.codepad.org/P9bxsjXo    [ raw code | output | fork ]

programmingpraxis - Scheme, pasted on Jan 14:
; three binary algorithms

(define (lshift x) (* x 2))
(define (rshift x) (quotient x 2))
(define (add1 x) (+ x 1))

(define (multiply left right)
  (let loop ((left left) (right right) (prod 0))
    (if (zero? left) prod
      (loop (rshift left) (lshift right)
            (if (odd? left) (+ prod right) prod)))))

(define (divide n d)
  (let loop ((t d))
    (if (<= t n) (loop (lshift t))
      (let loop ((t (rshift t)) (q 0) (r n))
        (cond ((< t d) (values q r))
              ((<= t r) (loop (rshift t) (add1 (lshift q)) (- r t)))
              (else (loop (rshift t) (lshift q) r)))))))

(define (stein-gcd n m)
  (let loop ((n n) (m m))
    (if (zero? n) m (if (zero? m) n
      (if (even? n)
          (if (even? m)
              (lshift (loop (rshift n) (rshift m)))
              (loop (rshift n) m))
          (if (even? m)
              (loop n (rshift m))
              (if (< n m)
                  (loop n (- m n))
                  (loop (- n m) m))))))))

(display (multiply 14 12)) (newline)
(let-values (((q r) (divide 837 43)))
  (display q) (display " ") (display r) (newline))
(display (stein-gcd 2322 654)) (newline)


Output:
1
2
3
168
19 20
6


Create a new paste based on this one


Comments: