1(define (string-for-each proc str1 . str2) 2 (apply for-each proc (string->list str1) 3 (map string->list str2))) 4 5(define (exact-non-negative-integer? k) 6 (and (integer? k) (exact? k) (>= k 0))) 7 8(define (exact-integer-sqrt k) 9 (unless (exact-non-negative-integer? k) 10 (assertion-violation 'exact-integer-sqrt "exact non-negative integer required" (list k))) 11 (let* ([s (exact (truncate (sqrt k)))] 12 [r (- k (* s s))]) 13 (values s r))) 14 15(define (mod x y) 16 (- x (* (div x y) y))) 17 18(define (div-and-mod x y) 19 (let ([d (div x y)]) 20 (values d (- x (* d y))))) 21 22(define (mod0 x y) 23 (- x (* (div0 x y) y))) 24 25(define (div0-and-mod0 x y) 26 (let ([d0 (div0 x y)]) 27 (values d0 (- x (* d0 y))))) 28 29;; Originally from Ypsilon Scheme start 30(define (rationalize x e) 31 (or (real? x) (assertion-violation 'rationalize (format "expected real, but got ~s as argument 1" x) (list x e))) 32 (or (real? e) (assertion-violation 'rationalize (format "expected real, but got ~s as argument 2" e) (list x e))) 33 (cond ((infinite? e) 34 (if (infinite? x) +nan.0 0.0)) 35 ((= x 0) x) 36 ((= x e) (- x e)) 37 ((negative? x) 38 (- (rationalize (- x) e))) 39 (else 40 (let ((e (abs e))) 41 (let loop ((bottom (- x e)) (top (+ x e))) 42 (cond ((= bottom top) bottom) 43 (else 44 (let ((x (ceiling bottom))) 45 (cond ((< x top) x) 46 (else 47 (let ((a (- x 1))) 48 (+ a (/ 1 (loop (/ 1 (- top a)) (/ 1 (- bottom a)))))))))))))))) 49;; Originally from Ypsilon Scheme end 50 51;; N.B. We can implement much faster version for Bignum using GMP. 52(define (gcd2 m n) 53 (if (zero? n) 54 (if (inexact? n) (inexact (abs m)) (abs m)) 55 (gcd2 n (mod m n)))) 56 57(define (gcd . n*) 58 (unless (for-all integer-valued? n*) 59 (assertion-violation 'gcd "integer valued numbers required")) 60 (case (length n*) 61 [(0) 0] 62 [(1) (abs (first n*))] 63 [(2) (gcd2 (first n*) (second n*))] 64 [else 65 (apply gcd (gcd2 (first n*) (second n*)) (cddr n*))])) 66 67(define (lcm2 a b) 68 (abs (/ (* a b) (gcd2 a b)))) 69 70(define (lcm . n*) 71 (unless (for-all integer-valued? n*) 72 (assertion-violation 'lcm "integer valued numbers required")) 73 (case (length n*) 74 [(0) 1] 75 [(1) (abs (first n*))] 76 [(2) (lcm2 (first n*) (second n*))] 77 [else 78 (apply lcm (lcm2 (first n*) (second n*)) (cddr n*))])) 79