Calkin-Wilf sequence: Difference between revisions
Content added Content deleted
(→{{header|ALGOL 68}}: Use the Algol 68 MOD operator as per the revised Algol 68 sample for the Continued fraction/Arithmetic/Construct from rational number task) |
(Added a Scheme implementation.) |
||
Line 2,258: | Line 2,258: | ||
20: 3/8 |
20: 3/8 |
||
83116/51639 is the 123456789th term of the sequence. |
83116/51639 is the 123456789th term of the sequence. |
||
</pre> |
|||
=={{header|Scheme}}== |
|||
{{works with|Chez Scheme}} |
|||
'''Continued Fraction support''' |
|||
<lang scheme>; Create a terminating Continued Fraction generator for the given rational number. |
|||
; Returns one term per call; returns #f when no more terms remaining. |
|||
(define make-continued-fraction-gen |
|||
(lambda (rat) |
|||
(let ((num (numerator rat)) (den (denominator rat))) |
|||
(lambda () |
|||
(if (= den 0) |
|||
#f |
|||
(let ((ret (quotient num den)) |
|||
(rem (modulo num den))) |
|||
(set! num den) |
|||
(set! den rem) |
|||
ret)))))) |
|||
; Return the continued fraction representation of a rational number as a list of terms. |
|||
(define rat->cf-list |
|||
(lambda (rat) |
|||
(let ((cf (make-continued-fraction-gen rat)) |
|||
(lst '())) |
|||
(let loop ((term (cf))) |
|||
(when term |
|||
(set! lst (append lst (list term))) |
|||
(loop (cf)))) |
|||
lst))) |
|||
; Enforce the length of the given continued fraction list to be odd. |
|||
; Changes the list in situ (if needed), and returns its possibly changed value. |
|||
(define continued-fraction-list-enforce-odd-length! |
|||
(lambda (cf) |
|||
(when (even? (length cf)) |
|||
(let ((cf-last-cons (list-tail cf (1- (length cf))))) |
|||
(set-car! cf-last-cons (1- (car cf-last-cons))) |
|||
(set-cdr! cf-last-cons (cons 1 '())))) |
|||
cf))</lang> |
|||
'''Calkin-Wilf sequence''' |
|||
<lang scheme>; Create a Calkin-Wilf sequence generator. |
|||
(define make-calkin-wilf-gen |
|||
(lambda () |
|||
(let ((an 1)) |
|||
(lambda () |
|||
(let ((ret an)) |
|||
(set! an (/ 1 (+ (* 2 (floor an)) 1 (- an)))) |
|||
ret))))) |
|||
; Return the position in the Calkin-Wilf sequence of the given rational number. |
|||
(define calkin-wilf-position |
|||
(lambda (rat) |
|||
; Run-length encodes binary value. Assumes first run is 1's. Args: initial value, |
|||
; starting place value (a power of 2), and list of run lengths (list must be odd length). |
|||
(define encode-list-of-runs |
|||
(lambda (value placeval lstruns) |
|||
; Encode a single run in a binary value. Args: initial value, bit value (0 or 1), |
|||
; starting place value (a power of 2), number of places (bits) to encode. |
|||
; Returns multiple values: the encoded value, and the new place value. |
|||
(define encode-run |
|||
(lambda (value bitval placeval places) |
|||
(if (= places 1) |
|||
(values (+ value (* bitval placeval)) (* 2 placeval)) |
|||
(encode-run (+ value (* bitval placeval)) bitval (* 2 placeval) (1- places))))) |
|||
; Loop through the list of runs two at a time. If list of length 1, do a final |
|||
; '1'-bit encode and return the value. Otherwise, do a '1'-bit then '0'-bit encode, |
|||
; and recurse to do the next two runs. |
|||
(let-values (((value-1 placeval-1) (encode-run value 1 placeval (car lstruns)))) |
|||
(if (= 1 (length lstruns)) |
|||
value-1 |
|||
(let-values (((value-2 placeval-2) (encode-run value-1 0 placeval-1 (cadr lstruns)))) |
|||
(encode-list-of-runs value-2 placeval-2 (cddr lstruns))))))) |
|||
; Return the run-length binary encoding from the odd-length Calkin-Wilf sequence of the |
|||
; given rational number. This is equal to the number's position in the sequence. |
|||
(encode-list-of-runs 0 1 (continued-fraction-list-enforce-odd-length! (rat->cf-list rat)))))</lang> |
|||
'''The Task''' |
|||
<lang scheme>(let ((count 20) |
|||
(cw (make-calkin-wilf-gen))) |
|||
(printf "~%First ~a terms of the Calkin-Wilf sequence:~%" count) |
|||
(do ((num 1 (1+ num))) |
|||
((> num count)) |
|||
(printf "~2d : ~a~%" num (cw)))) |
|||
(printf "~%Positions in Calkin-Wilf sequence of given numbers:~%") |
|||
(let ((num 9/4)) |
|||
(printf "~a @ ~a~%" num (calkin-wilf-position num))) |
|||
(let ((num 83116/51639)) |
|||
(printf "~a @ ~a~%" num (calkin-wilf-position num)))</lang> |
|||
{{out}} |
|||
<pre> |
|||
First 20 terms of the Calkin-Wilf sequence: |
|||
1 : 1 |
|||
2 : 1/2 |
|||
3 : 2 |
|||
4 : 1/3 |
|||
5 : 3/2 |
|||
6 : 2/3 |
|||
7 : 3 |
|||
8 : 1/4 |
|||
9 : 4/3 |
|||
10 : 3/5 |
|||
11 : 5/2 |
|||
12 : 2/5 |
|||
13 : 5/3 |
|||
14 : 3/4 |
|||
15 : 4 |
|||
16 : 1/5 |
|||
17 : 5/4 |
|||
18 : 4/7 |
|||
19 : 7/3 |
|||
20 : 3/8 |
|||
Positions in Calkin-Wilf sequence of given numbers: |
|||
9/4 @ 35 |
|||
83116/51639 @ 123456789 |
|||
</pre> |
</pre> |
||