June 2018 Update

Task/Continued-fraction/Scheme/continued-fraction-1.ss

@@ -0,0 +1,50 @@
+#!r6rs
+(import (rnrs base (6))
+        (srfi :41 streams))
+
+(define nats (stream-cons 0 (stream-map (lambda (x) (+ x 1)) nats)))
+
+(define (build-stream fn) (stream-map fn nats))
+
+(define (stream-cycle s . S)
+  (cond
+    ((stream-null? (car S)) stream-null)
+    (else (stream-cons (stream-car s)
+                       (apply stream-cycle (append S (list (stream-cdr s))))))))
+
+(define (cf-floor cf) (stream-car cf))
+(define (cf-num cf) (stream-car (stream-cdr cf)))
+(define (cf-denom cf) (stream-cdr (stream-cdr cf)))
+
+(define (cf-integer? x) (stream-null? (stream-cdr x)))
+
+(define (cf->real x)
+  (let refine ((x x) (n 65536))
+    (cond
+      ((= n 0) +inf.0)
+      ((cf-integer? x) (cf-floor x))
+      (else (+ (cf-floor x)
+               (/ (cf-num x)
+                  (refine (cf-denom x) (- n 1))))))))
+
+(define (real->cf x)
+  (let-values (((integer-part fractional-part) (div-and-mod x 1)))
+    (if (= fractional-part 0.0)
+        (stream (exact integer-part))
+        (stream-cons
+         (exact integer-part)
+         (stream-cons
+          1
+          (real->cf (/ fractional-part)))))))
+
+
+(define sqrt2 (stream-cons 1 (stream-constant 1 2)))
+
+(define napier
+  (stream-append (stream 2 1)
+                 (stream-cycle (stream-cdr nats) (stream-cdr nats))))
+
+(define pi
+  (stream-cons 3
+               (stream-cycle (build-stream (lambda (n) (expt (- (* 2 (+ n 1)) 1) 2)))
+                             (stream-constant 6))))

Task/Continued-fraction/Scheme/continued-fraction-2.ss

@@ -0,0 +1,6 @@
+> (cf->real sqrt2)
+1.4142135623730951
+> (cf->real napier)
+2.7182818284590455
+> (cf->real pi)
+3.141592653589794