Continued fraction/Arithmetic/G(matrix ng, continued fraction n): Difference between revisions
Continued fraction/Arithmetic/G(matrix ng, continued fraction n) (view source)
Revision as of 17:16, 20 November 2023
, 5 months ago→{{header|Wren}}: Minor tidy
m (→{{header|Wren}}: Minor tidy) |
|||
| (29 intermediate revisions by 2 users not shown) | |||
Line 1,831:
{{out}}
[[File:Univariate-continued-fraction-task-no-gc.dats.png|alt=The output of the program.]]
===Using lazy non-linear types===
{{trans|Haskell}}
{{trans|Mercury}}
This method is simple, and it memoizes terms. However, the memoization is in a linked list rather than a randomly accessible array.
The '''recurs''' routines do not execute recursions, but instead (thanks to '''$delay''') create what I will call "recursive thunks". Otherwise the stack would overflow.
The code leaks memory, so using a garbage collector may be a good idea.
<syntaxhighlight lang="ats">
(*------------------------------------------------------------------*)
#include "share/atspre_staload.hats"
staload UN = "prelude/SATS/unsafe.sats"
(* For convenience (because the prelude provides it), we will use
integer division with truncation towards zero. *)
infixl ( / ) div
infixl ( mod ) rem
macdef div = g0int_div
macdef rem = g0int_mod
(*------------------------------------------------------------------*)
(* The definition of a continued fraction, and a few simple ones. *)
typedef cf (tk : tkind) = stream (g0int tk)
(* A "continued fraction" with no terms. *)
fn {tk : tkind}
cfnil ()
: cf tk =
stream_make_nil<g0int tk> ()
(* A continued fraction of one term followed by more terms. *)
fn {tk : tkind}
cfcons (term : g0int tk,
more : cf tk)
: cf tk =
stream_make_cons<g0int tk> (term, more)
(* A continued fraction with all terms equal. *)
fn {tk : tkind}
repeat_forever (term : g0int tk)
: cf tk =
let
fun recurs () : stream_con (g0int tk) =
stream_cons (term, $delay recurs ())
in
$delay recurs ()
end
(* The square root of two. *)
fn {tk : tkind}
sqrt2 ()
: cf tk =
cfcons<tk> (g0i2i 1, repeat_forever<tk> (g0i2i 2))
(*------------------------------------------------------------------*)
(* A continued fraction for a rational number. *)
typedef ratnum (tk : tkind) = @(g0int tk, g0int tk)
fn {tk : tkind}
r2cf_integers (n : g0int tk,
d : g0int tk)
: cf tk =
let
fun recurs (n : g0int tk,
d : g0int tk)
: cf tk =
if iseqz d then
cfnil<tk> ()
else
cfcons<tk> (n div d, recurs (d, n rem d))
in
recurs (n, d)
end
fn {tk : tkind}
r2cf_ratnum (r : ratnum tk)
: cf tk =
r2cf_integers (r.0, r.1)
overload r2cf with r2cf_integers
overload r2cf with r2cf_ratnum
(*------------------------------------------------------------------*)
(* Application of a homographic function to a continued fraction. *)
typedef ng4 (tk : tkind) = @(g0int tk, g0int tk,
g0int tk, g0int tk)
fn {tk : tkind}
apply_ng4 (ng4 : ng4 tk,
other_cf : cf tk)
: cf tk =
let
typedef t = g0int tk
fun
recurs (a1 : t,
a : t,
b1 : t,
b : t,
other_cf : cf tk)
: stream_con t =
let
fn {}
eject_term (a1 : t,
a : t,
b1 : t,
b : t,
other_cf : cf tk,
term : t)
: stream_con t =
stream_cons (term, $delay recurs (b1, b, a1 - (b1 * term),
a - (b * term), other_cf))
fn {}
absorb_term (a1 : t,
a : t,
b1 : t,
b : t,
other_cf : cf tk)
: stream_con t =
case+ !other_cf of
| stream_nil () =>
recurs (a1, a1, b1, b1, other_cf)
| stream_cons (term, rest) =>
recurs (a + (a1 * term), a1, b + (b1 * term), b1, rest)
in
if iseqz b1 && iseqz b then
stream_nil ()
else if iseqz b1 || iseqz b then
absorb_term (a1, a, b1, b, other_cf)
else
let
val q1 = a1 div b1
and q = a div b
in
if q1 = q then
eject_term (a1, a, b1, b, other_cf, q)
else
absorb_term (a1, a, b1, b, other_cf)
end
end
val @(a1, a, b1, b) = ng4
in
$delay recurs (a1, a, b1, b, other_cf)
end
(*------------------------------------------------------------------*)
(* Some special cases of homographic functions. *)
fn {tk : tkind}
integer_add_cf (n : g0int tk,
cf : cf tk)
: cf tk =
apply_ng4 (@(g0i2i 1, n, g0i2i 0, g0i2i 1), cf)
fn {tk : tkind}
cf_add_ratnum (cf : cf tk,
r : ratnum tk)
: cf tk =
let
val @(n, d) = r
in
apply_ng4 (@(d, n, g0i2i 0, d), cf)
end
fn {tk : tkind}
cf_mul_ratnum (cf : cf tk,
r : ratnum tk)
: cf tk =
let
val @(n, d) = r
in
apply_ng4 (@(n, g0i2i 0, g0i2i 0, d), cf)
end
fn {tk : tkind}
cf_div_integer (cf : cf tk,
n : g0int tk)
: cf tk =
apply_ng4 (@(g0i2i 1, g0i2i 0, g0i2i 0, g0i2i n), cf)
fn {tk : tkind}
integer_div_cf (n : g0int tk,
cf : cf tk)
: cf tk =
apply_ng4 (@(g0i2i 0, g0i2i n, g0i2i 1, g0i2i 0), cf)
overload + with integer_add_cf
overload + with cf_add_ratnum
overload * with cf_mul_ratnum
overload / with cf_div_integer
overload / with integer_div_cf
(*------------------------------------------------------------------*)
(* cf2string: convert a continued fraction to a string. *)
fn {tk : tkind}
cf2string_max_terms_given
(cf : cf tk,
max_terms : intGte 1)
: string =
let
fun
loop (i : intGte 0,
cf : cf tk,
accum : List0 string)
: List0 string =
case+ !cf of
| stream_nil () => list_cons ("]", accum)
| stream_cons (term, rest) =>
if i = max_terms then
list_cons (",...]", accum)
else
let
val accum =
list_cons
(tostring_val<g0int tk> term,
(case+ i of
| 0 => accum
| 1 => list_cons (";", accum)
| _ => list_cons (",", accum)) : List0 string)
in
loop (succ i, rest, accum)
end
val string_lst = list_vt2t (reverse (loop (0, cf, list_sing "[")))
in
strptr2string (stringlst_concat string_lst)
end
extern fn {tk : tkind}
cf2string$max_terms :
() -> intGte 1
implement {tk} cf2string$max_terms () = 20
fn {tk : tkind}
cf2string_max_terms_default
(cf : cf tk)
: string =
cf2string_max_terms_given<tk> (cf, cf2string$max_terms<tk> ())
overload cf2string with cf2string_max_terms_given
overload cf2string with cf2string_max_terms_default
(*------------------------------------------------------------------*)
fn {tk : tkind}
show (expression : string,
cf : cf tk)
: void =
begin
print! expression;
print! " => ";
println! (cf2string<tk> cf);
end
implement
main () =
let
val cf_13_11 = r2cf (13, 11)
val cf_22_7 = r2cf (22, 7)
val cf_sqrt2 = sqrt2<intknd> ()
val cf_1_sqrt2 = 1 / cf_sqrt2
in
show ("13/11", cf_13_11);
show ("22/7", cf_22_7);
show ("sqrt(2)", cf_sqrt2);
show ("13/11 + 1/2", cf_13_11 + @(1, 2));
show ("22/7 + 1/2", cf_22_7 + @(1, 2));
show ("(22/7)/4", cf_22_7 * @(1, 4));
show ("1/sqrt(2)", cf_1_sqrt2);
show ("(2 + sqrt(2))/4", apply_ng4 (@(1, 2, 0, 4), cf_sqrt2));
(* To show it can be done, write the following without using
results already obtained: *)
show ("(1 + 1/sqrt(2))/2", (1 + 1/sqrt2())/2);
0
end
(*------------------------------------------------------------------*)
</syntaxhighlight>
{{out}}
<pre>$ patscc -g -O2 -std=gnu2x -DATS_MEMALLOC_GCBDW univariate-continued-fraction-task-lazy.dats -lgc && ./a.out
13/11 => [1;5,2]
22/7 => [3;7]
sqrt(2) => [1;2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,...]
13/11 + 1/2 => [1;1,2,7]
22/7 + 1/2 => [3;1,1,1,4]
(22/7)/4 => [0;1,3,1,2]
1/sqrt(2) => [0;1,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,...]
(2 + sqrt(2))/4 => [0;1,5,1,4,1,4,1,4,1,4,1,4,1,4,1,4,1,4,1,...]
(1 + 1/sqrt(2))/2 => [0;1,5,1,4,1,4,1,4,1,4,1,4,1,4,1,4,1,4,1,...]</pre>
=={{header|C}}==
Line 2,967 ⟶ 3,270:
1 4 1 4 1 4 1 4 1 4 3 2 1 9 5
</pre>
=={{header|Common Lisp}}==
{{trans|ATS}}
{{trans|Scheme}}
This implementation memoizes terms of continued fractions. It mostly follows the coding of the Scheme, which itself was translated from ATS. Tail recursions in the Scheme have been replaced with ordinary loops. (Common Lisp standards do not require optimization of tail calls.)
I have tested with various CL implementations, including SBCL, CLISP, ECL, Clozure CL.
<syntaxhighlight lang="lisp">
(defstruct cf-record
terminated-p ; Are these all the terms there are?
m ; How many terms are memoized so far?
memo ; Where terms are memoized.
gen) ; A thunk that generates terms.
(deftype continued-fraction 'cf-record)
(defun make-continued-fraction (gen)
(make-cf-record :terminated-p nil
:m 0
:memo (make-array '(8))
:gen gen))
(defun cf-get-more-terms (cf needed)
(loop with term
for i from (cf-record-m cf) upto needed
do (setf term (funcall (cf-record-gen cf)))
unless term
do (setf (cf-record-terminated-p cf) t)
end
while term do (setf (aref (cf-record-memo cf) i) term)
finally (setf (cf-record-m cf) i)))
(defun cf-update (cf needed)
(cond ((cf-record-terminated-p cf) (progn))
((<= needed (cf-record-m cf)) (progn))
((<= needed (array-dimension (cf-record-memo cf) 0))
(cf-get-more-terms cf needed))
(t ;; Provide twice the room that might be needed.
(let* ((n1 (+ needed needed))
(memo1 (make-array (list n1))))
(loop for i from 0 upto (1- (cf-record-m cf))
do (setf (aref memo1 i)
(aref (cf-record-memo cf) i)))
(setf (cf-record-memo cf) memo1)
(cf-get-more-terms cf needed)))))
(defun continued-fraction-ref (cf i)
(cf-update cf (1+ i))
(and (< i (cf-record-m cf))
(aref (cf-record-memo cf) i)))
(defun continued-fraction-to-thunk (cf)
;; Make a generator from a continued fraction.
(let ((i 0))
(lambda ()
(let ((term (continued-fraction-ref cf i)))
(setf i (1+ i))
term))))
(defun continued-fraction-to-string (cf &optional (max-terms 20))
(loop with sep = 0
with accum = "["
with term
for i from 0 upto (1- max-terms)
do (setf term (continued-fraction-ref cf i))
if term
do (let ((sep-str (case sep
((0) "")
((1) ";")
((2) ","))))
(setf sep (min (1+ sep) 2))
(setf accum (concatenate 'string accum sep-str
(format nil "~A" term))))
else
do (setf accum (concatenate 'string accum "]"))
(return accum)
end
finally (setf accum (concatenate 'string accum ",...]"))
(return accum)))
(defun r2cf (x)
;; This algorithm works directly with exact rationals, rather
;; than numerator and denominator separately.
(let ((ratnum (coerce x 'rational))
(terminated-p nil))
(make-continued-fraction
(lambda ()
(and (not terminated-p)
(multiple-value-bind (q r) (floor ratnum)
(if (zerop r)
(setf terminated-p t)
(setf ratnum (/ r)))
q))))))
(defstruct homographic-function a1 a b1 b)
(defun apply-homographic-function (hfunc cf)
(let* ((gen (continued-fraction-to-thunk cf))
(state (copy-homographic-function hfunc)))
(make-continued-fraction
(lambda ()
(loop
do (let ((a1 (homographic-function-a1 state))
(a (homographic-function-a state))
(b1 (homographic-function-b1 state))
(b (homographic-function-b state)))
(cond ((and (zerop b1) (zerop b)) (return nil))
((and (not (zerop b1)) (not (zerop b)))
(let ((q1 (nth-value 0 (floor a1 b1)))
(q (nth-value 0 (floor a b))))
(when (= q1 q)
(setf state (make-homographic-function
:a1 b1
:a b
:b1 (- a1 (* b1 q))
:b (- a (* b q))))
(return q)))))
(let ((term (funcall gen)))
(if term
(setf state
(make-homographic-function
:a1 (+ a (* a1 term))
:a a1
:b1 (+ b (* b1 term))
:b b1))
(progn
(setf (homographic-function-a state) a1)
(setf (homographic-function-b state)
b1))))))))))
(defun make-hf (a1 a b1 b)
(make-homographic-function :a1 a1 :a a :b1 b1 :b b))
(defun apply-hf (hfunc cf)
(apply-homographic-function hfunc cf))
(defun cf2string (cf)
(continued-fraction-to-string cf))
(defvar cf+1/2 (make-hf 2 1 0 2))
(defvar cf/2 (make-hf 1 0 0 2))
(defvar cf/4 (make-hf 1 0 0 4))
(defvar 1/cf (make-hf 0 1 1 0))
(defvar 2+cf./4 (make-hf 1 2 0 4))
(defvar 1+cf./2 (make-hf 1 1 0 2))
(defvar cf_13/11 (r2cf 13/11))
(defvar cf_22/7 (r2cf 22/7))
(defvar cf_sqrt2
(let ((next-term 1))
(make-continued-fraction
(lambda ()
(let ((term next-term))
(setf next-term 2)
term)))))
(format t "13/11 => ~A~%" (cf2string cf_13/11))
(format t "22/7 => ~A~%" (cf2string cf_22/7))
(format t "sqrt(2) => ~A~%" (cf2string cf_sqrt2))
(format t "13/11 + 1/2 => ~A~%"
(cf2string (apply-hf cf+1/2 cf_13/11)))
(format t "22/7 + 1/2 => ~A~%"
(cf2string (apply-hf cf+1/2 cf_22/7)))
(format t "(22/7)/4 => ~A~%"
(cf2string (apply-hf cf/4 cf_22/7)))
(format t "sqrt(2)/2 => ~A~%"
(cf2string (apply-hf cf/2 cf_sqrt2)))
(format t "1/sqrt(2) => ~A~%"
(cf2string (apply-hf 1/cf cf_sqrt2)))
(format t "(2 + sqrt(2))/4 => ~A~%"
(cf2string (apply-hf 2+cf./4 cf_sqrt2)))
(format t "(1 + 1/sqrt(2))/2 => ~A~%"
(cf2string (apply-hf 1+cf./2 (apply-hf 1/cf cf_sqrt2))))
(format t "sqrt(2)/4 + 1/2 => ~A~%"
(cf2string (apply-hf cf+1/2 (apply-hf cf/4 cf_sqrt2))))
(format t "(sqrt(2)/2)/2 + 1/2 => ~A~%"
(cf2string (apply-hf cf+1/2
(apply-hf cf/2
(apply-hf cf/2 cf_sqrt2)))))
(format t "(1/sqrt(2))/2 + 1/2 => ~A~%"
(cf2string (apply-hf cf+1/2
(apply-hf cf/2
(apply-hf 1/cf cf_sqrt2)))))
</syntaxhighlight>
{{out}}
SBCL might be the most likely CL implementation to be installed:
<pre>$ sbcl --script univariate-continued-fraction-task.lisp
13/11 => [1;5,2]
22/7 => [3;7]
sqrt(2) => [1;2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,...]
13/11 + 1/2 => [1;1,2,7]
22/7 + 1/2 => [3;1,1,1,4]
(22/7)/4 => [0;1,3,1,2]
sqrt(2)/2 => [0;1,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,...]
1/sqrt(2) => [0;1,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,...]
(2 + sqrt(2))/4 => [0;1,5,1,4,1,4,1,4,1,4,1,4,1,4,1,4,1,4,1,...]
(1 + 1/sqrt(2))/2 => [0;1,5,1,4,1,4,1,4,1,4,1,4,1,4,1,4,1,4,1,...]
sqrt(2)/4 + 1/2 => [0;1,5,1,4,1,4,1,4,1,4,1,4,1,4,1,4,1,4,1,...]
(sqrt(2)/2)/2 + 1/2 => [0;1,5,1,4,1,4,1,4,1,4,1,4,1,4,1,4,1,4,1,...]
(1/sqrt(2))/2 + 1/2 => [0;1,5,1,4,1,4,1,4,1,4,1,4,1,4,1,4,1,4,1,...]</pre>
=={{header|D}}==
{{trans|ATS}}
{{works with|Digital Mars D|2.099.1}}
{{works with|GCC|12.2.1}}
This implementation memoizes terms of a continued fraction. It leaks memory, but D provides a garbage collector.
<syntaxhighlight lang="D">
import std.conv;
import std.stdio;
alias index_t = uint; // The type for indexing terms of a continued
// fraction.
alias integer = long; // The type for terms of a continued fraction.
class cf_t // A continued fraction, with memoization of its terms.
{
protected bool terminated; // Are there more terms to be memoized?
protected index_t m; // How many terms are memoized so far?
private integer[] memo; // Memoized terms.
public index_t maxTerms = 20; // Maximum number of terms in the
// string representation.
this ()
{
terminated = false;
m = 0;
memo.length = 8;
}
protected void generate (ref bool termExists, ref integer term)
{
// Return terms for zero. To get different terms, override this
// method. (I am used to using a closure or similar for the
// generator, and not having to derive a new continued fraction
// type, to have a new kind of generator. However, I am trying to
// do what is more natural within the programming language.)
termExists = (m == 0);
term = 0;
}
public void getAt (index_t i, ref bool termExists, ref integer term)
{
void memoizeMoreTerms (index_t needed)
{
while (m != needed && !terminated)
{
bool termExists;
integer term;
generate (termExists, term);
if (termExists)
{
memo[m] = term;
m += 1;
}
else
terminated = true;
}
}
void update (index_t needed)
{
// If necessary, memoize more terms, perhaps increasing the
// space in which to store them.
if (!terminated && m < needed)
{
if (memo.length < needed)
{
// Increase the space to twice what might be needed
// right now.
memo.length = 2 * needed;
}
memoizeMoreTerms (needed);
}
}
update (i + 1);
termExists = (i < m);
if (termExists)
term = memo[i];
}
public override string toString ()
{
string s = "[";
int sep = 0;
index_t i = 0;
bool done = false;
while (!done)
{
if (i == maxTerms)
{
s ~= ",...]";
done = true;
}
else
{
bool termExists;
integer term;
getAt (i, termExists, term);
if (termExists)
{
final switch (sep)
{
case 0 :
sep = 1;
break;
case 1 :
s ~= ";";
sep = 2;
break;
case 2 :
s ~= ",";
break;
}
s ~= to!string (term);
i += 1;
}
else
{
s ~= "]";
done = true;
}
}
}
return s;
}
}
class cfSqrt2_t : cf_t // A continued fraction for sqrt(2).
{
override final void generate (ref bool termExists, ref integer term)
{
termExists = true;
term = (m == 0 ? 1 : 2);
}
}
class cfRational : cf_t // A continued fraction for a rational number.
{
private integer n; // Numerator.
private integer d; // Denominator.
this (integer numerator, integer denominator)
{
assert (denominator != 0);
n = numerator;
d = denominator;
}
override void generate (ref bool termExists, ref integer term)
{
termExists = (d != 0);
if (termExists)
{
auto q = n / d;
auto r = n % d;
n = d;
d = r;
term = q;
}
}
}
class hfunc_t // A homographic function.
{
public integer a1;
public integer a;
public integer b1;
public integer b;
this (integer a1, integer a, integer b1, integer b)
{
this.a1 = a1;
this.a = a;
this.b1 = b1;
this.b = b;
}
}
class cfHfunc_t : cf_t // A continued fraction that is a homographic
// function of some other continued fraction.
{
private integer a1;
private integer a;
private integer b1;
private integer b;
private cf_t gen;
private index_t index;
this (hfunc_t hfunc, cf_t gen)
{
a1 = hfunc.a1;
a = hfunc.a;
b1 = hfunc.b1;
b = hfunc.b;
this.gen = gen;
index = 0;
}
override void generate (ref bool termExists, ref integer term)
{
bool done = false;
while (!done)
{
if (b1 == 0 && b == 0)
{
termExists = false;
done = true;
}
else if (b1 != 0 && b != 0)
{
auto q1 = a1 / b1;
auto q = a / b;
if (q1 == q)
{
const a1_ = a1;
const a_ = a;
const b1_ = b1;
const b_ = b;
a1 = b1_;
a = b_;
b1 = a1_ - (b1_ * q);
b = a_ - (b_ * q);
termExists = true;
term = q;
done = true;
}
}
if (!done)
{
gen.getAt (index, termExists, term);
index += 1;
if (termExists)
{
const a1_ = a1;
const a_ = a;
const b1_ = b1;
const b_ = b;
a1 = a_ + (a1_ * term);
a = a1_;
b1 = b_ + (b1_ * term);
b = b1_;
}
else
{
a = a1;
b = b1;
}
}
}
}
}
int
main (char[][] args)
{
auto hf_cf_add_1_2 = new hfunc_t (2, 1, 0, 2);
auto hf_cf_div_2 = new hfunc_t (1, 0, 0, 2);
auto hf_cf_div_4 = new hfunc_t (1, 0, 0, 4);
auto hf_1_div_cf = new hfunc_t (0, 1, 1, 0);
auto cf_13_11 = new cfRational (13, 11);
auto cf_22_7 = new cfRational (22, 7);
auto cf_sqrt2 = new cfSqrt2_t ();
auto cf_13_11_add_1_2 = new cfHfunc_t (hf_cf_add_1_2, cf_13_11);
auto cf_22_7_add_1_2 = new cfHfunc_t (hf_cf_add_1_2, cf_22_7);
auto cf_22_7_div_4 = new cfHfunc_t (hf_cf_div_4, cf_22_7);
auto cf_sqrt2_div_2 = new cfHfunc_t (hf_cf_div_2, cf_sqrt2);
auto cf_1_div_sqrt2 = new cfHfunc_t (hf_1_div_cf, cf_sqrt2);
auto cf_2_add_sqrt2__div_4 =
new cfHfunc_t (new hfunc_t (1, 2, 0, 4), cf_sqrt2);
auto cf_1_add_1_div_sqrt2__div_2 =
new cfHfunc_t (new hfunc_t (1, 1, 0, 2), cf_1_div_sqrt2);
auto cf_sqrt2_div_4_add_1_2 =
new cfHfunc_t (hf_cf_add_1_2,
new cfHfunc_t (hf_cf_div_4, cf_sqrt2));
void show (string expr, cf_t cf)
{
writeln (expr, cf.toString());
}
show ("13/11 => ", cf_13_11);
show ("22/7 => ", cf_22_7);
show ("sqrt(2) => ", cf_sqrt2);
show ("13/11 + 1/2 => ", cf_13_11_add_1_2);
show ("22/7 + 1/2 => ", cf_22_7_add_1_2);
show ("(22/7)/4 => ", cf_22_7_div_4);
show ("sqrt(2)/2 => ", cf_sqrt2_div_2);
show ("1/sqrt(2) => ", cf_1_div_sqrt2);
show ("(2 + sqrt(2))/4 => ", cf_2_add_sqrt2__div_4);
show ("(1 + 1/sqrt(2))/2 => ", cf_1_add_1_div_sqrt2__div_2);
show ("sqrt(2)/4 + 1/2 => ", cf_sqrt2_div_4_add_1_2);
show ("(sqrt(2)/2)/2 + 1/2 => ",
new cfHfunc_t (hf_cf_add_1_2,
new cfHfunc_t (hf_cf_div_2,
cf_sqrt2_div_2)));
// Demonstrate a deeper nesting of anonymous cf_t.
show ("(1/sqrt(2))/2 + 1/2 => ",
new cfHfunc_t (hf_cf_add_1_2,
new cfHfunc_t (hf_cf_div_2,
new cfHfunc_t (hf_1_div_cf,
cf_sqrt2))));
return 0;
}
</syntaxhighlight>
{{out}}
<pre>$ dmd -g univariate_continued_fraction_task.d && ./univariate_continued_fraction_task
13/11 => [1;5,2]
22/7 => [3;7]
sqrt(2) => [1;2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,...]
13/11 + 1/2 => [1;1,2,7]
22/7 + 1/2 => [3;1,1,1,4]
(22/7)/4 => [0;1,3,1,2]
sqrt(2)/2 => [0;1,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,...]
1/sqrt(2) => [0;1,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,...]
(2 + sqrt(2))/4 => [0;1,5,1,4,1,4,1,4,1,4,1,4,1,4,1,4,1,4,1,...]
(1 + 1/sqrt(2))/2 => [0;1,5,1,4,1,4,1,4,1,4,1,4,1,4,1,4,1,4,1,...]
sqrt(2)/4 + 1/2 => [0;1,5,1,4,1,4,1,4,1,4,1,4,1,4,1,4,1,4,1,...]
(sqrt(2)/2)/2 + 1/2 => [0;1,5,1,4,1,4,1,4,1,4,1,4,1,4,1,4,1,4,1,...]
(1/sqrt(2))/2 + 1/2 => [0;1,5,1,4,1,4,1,4,1,4,1,4,1,4,1,4,1,4,1,...]</pre>
=={{header|Fortran}}==
Line 2,975 ⟶ 3,810:
(Fortran standards allow garbage collection, but the NAG compiler is the only Fortran compiler I know of that offers garbage collection as an option. I am using GNU Fortran.)
I have been liberal in the use of '''recursive''' declarations and '''block''' constructs. In this program they can only help, not hurt.
<syntaxhighlight lang="fortran">
Line 3,056 ⟶ 3,893:
contains
recursive subroutine cf_generator_make (gen, proc, env)
type(cf_generator_t), intent(out), pointer :: gen
interface
Line 3,082 ⟶ 3,919:
end subroutine cf_generator_t_refcount_decr
recursive subroutine cf_generator_t_finalize (gen)
type(cf_generator_t), intent(inout) :: gen
deallocate (gen%env)
Line 3,097 ⟶ 3,934:
end subroutine cf_memo_t_refcount_decr
recursive subroutine cf_memo_t_finalize (memo)
type(cf_memo_t), intent(inout) :: memo
deallocate (memo%storage)
end subroutine cf_memo_t_finalize
recursive subroutine cf_make (cf, gen)
type(cf_t), pointer, intent(out) :: cf
type(cf_generator_t), pointer, intent(inout) :: gen
Line 3,120 ⟶ 3,957:
end subroutine cf_make
recursive subroutine cf_t_finalize (cf)
type(cf_t), intent(inout) :: cf
Line 3,130 ⟶ 3,967:
end subroutine cf_t_finalize
recursive subroutine cf_generator_make_from_cf (gen, cf)
!
! TAKE NOTE: deallocating gen DOES NOT deallocate cf. (Most likely
Line 3,149 ⟶ 3,986:
end subroutine cf_generator_make_from_cf
recursive subroutine cf_generator_from_cf_proc (env, term_exists, term)
class(*), intent(inout) :: env
logical, intent(out) :: term_exists
Line 3,161 ⟶ 3,998:
end subroutine cf_generator_from_cf_proc
recursive subroutine cf_get_more_terms (cf, needed)
class(cf_t), intent(inout) :: cf
integer, intent(in) :: needed
Line 3,191 ⟶ 4,028:
end subroutine cf_get_more_terms
recursive subroutine cf_update (cf, needed)
class(cf_t), intent(inout) :: cf
integer, intent(in) :: needed
integer, pointer :: storage1(:)
if (cf%terminated .or. needed <= cf%m) then
Line 3,206 ⟶ 4,042:
cf%n = 2 * needed
allocate (storage1(0:cf%n - 1))
storage1(0:cf%m - 1) = cf%memo%storage(0:cf%m - 1)
deallocate (cf%memo%storage)
cf%memo%storage => storage1
Line 3,213 ⟶ 4,049:
end subroutine cf_update
recursive subroutine cf_get_at (cf, i, term_exists, term)
class(cf_t), intent(inout) :: cf
integer, intent(in) :: i
Line 3,224 ⟶ 4,060:
end subroutine cf_get_at
recursive function cf2string_max_terms (cf, max_terms) result (s)
class(cf_t), intent(inout) :: cf
integer, intent(in) :: max_terms
Line 3,275 ⟶ 4,111:
end function cf2string_max_terms
recursive function cf2string_default_max_terms (cf) result (s)
class(cf_t), intent(inout) :: cf
character(len = :), allocatable :: s
Line 3,303 ⟶ 4,139:
contains
recursive subroutine r2cf_generator_make (gen, n, d)
type(cf_generator_t), pointer, intent(out) :: gen
integer, intent(in) :: n, d
Line 3,318 ⟶ 4,154:
end subroutine r2cf_generator_make
recursive subroutine r2cf_generator_proc (env, term_exists, term)
class(*), intent(inout) :: env
logical, intent(out) :: term_exists
Line 3,343 ⟶ 4,179:
end subroutine r2cf_generator_proc
recursive subroutine r2cf_make (cf, n, d)
type(cf_t), pointer, intent(out) :: cf
integer, intent(in) :: n, d
Line 3,376 ⟶ 4,212:
contains
recursive subroutine sqrt2_generator_make (gen)
type(cf_generator_t), pointer, intent(out) :: gen
Line 3,389 ⟶ 4,225:
end subroutine sqrt2_generator_make
recursive subroutine sqrt2_generator_proc (env, term_exists, term)
class(*), intent(inout) :: env
logical, intent(out) :: term_exists
Line 3,402 ⟶ 4,238:
end subroutine sqrt2_generator_proc
recursive subroutine sqrt2_make (cf)
type(cf_t), pointer, intent(out) :: cf
Line 3,434 ⟶ 4,270:
contains
recursive subroutine hfunc_generator_make (gen, a1, a, b1, b, source_gen)
type(cf_generator_t), pointer, intent(out) :: gen
integer, intent(in) :: a1, a, b1, b
Line 3,453 ⟶ 4,289:
end subroutine hfunc_generator_make
recursive subroutine hfunc_generator_proc (env, term_exists, term)
class(*), intent(inout) :: env
logical, intent(out) :: term_exists
Line 3,463 ⟶ 4,299:
select type (env)
class is (hfunc_generator_env_t)
done = .false.
do while (.not. done)
Line 3,487 ⟶ 4,322:
env%b1 = a1 - (b1 * q)
env%b = a - (b * q)
term_exists = .true.
term = q
done = .true.
end block
end
end
end do
Line 3,519 ⟶ 4,354:
end subroutine hfunc_generator_proc
recursive subroutine hfunc_make (cf, a1, a, b1, b, source_cf)
type(cf_t), pointer, intent(out) :: cf
integer, intent(in) :: a1, a, b1, b
Line 3,556 ⟶ 4,391:
type(cf_t), pointer :: cf_one_way
type(cf_t), pointer :: cf_another_way
type(cf_t), pointer :: cf_half_of_1_div_sqrt2
type(cf_t), pointer :: cf_a_third_way
call r2cf_make (cf_13_11, 13, 11)
Line 3,568 ⟶ 4,406:
call hfunc_make (cf_one_way, 1, 2, 0, 4, cf_sqrt2)
call hfunc_make (cf_another_way, 1, 1, 0, 2, cf_1_div_sqrt2)
call hfunc_make (cf_half_of_1_div_sqrt2, 1, 0, 0, 2, cf_1_div_sqrt2)
call hfunc_make (cf_a_third_way, 2, 1, 0, 2, cf_half_of_1_div_sqrt2)
write (*, '("13/11 => ", A)') cf2string (cf_13_11)
Line 3,580 ⟶ 4,421:
write (*, '("(2 + sqrt(2))/4 => ", A)') cf2string (cf_one_way)
write (*, '("(1 + 1/sqrt(2))/2 => ", A)') cf2string (cf_another_way)
write (*, '("(1/sqrt(2))/2 + 1/2 => ", A)') cf2string (cf_a_third_way)
deallocate (cf_13_11)
Line 3,592 ⟶ 4,433:
deallocate (cf_one_way)
deallocate (cf_another_way)
deallocate (cf_half_of_1_div_sqrt2)
deallocate (cf_a_third_way)
end program univariate_continued_fraction_task
Line 3,599 ⟶ 4,442:
{{out}}
<pre>$ gfortran -fbounds-check -Wall -Wextra -g -std=f2018 univariate_continued_fraction_task.f90 && ./a.out
13/11 => [1;5,2]
22/7 => [3;7]
Line 3,609 ⟶ 4,452:
1/sqrt(2) => [0;1,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,...]
(2 + sqrt(2))/4 => [0;1,5,1,4,1,4,1,4,1,4,1,4,1,4,1,4,1,4,1,...]
(1 + 1/sqrt(2))/2 => [0;1,5,1,4,1,4,1,4,1,4,1,4,1,4,1,4,1,4,1,...]
(1/sqrt(2))/2 + 1/2 => [0;1,5,1,4,1,4,1,4,1,4,1,4,1,4,1,4,1,4,1,...]</pre>
=={{header|Go}}==
Line 3,746 ⟶ 4,590:
(1+√2)/2 = [1; 4, 1, 4, 1, 4, 1, 4, 1, 4, 1, 4, 1, 4, 1, 4, 1, 4, 1, 4, ...]
</pre>
=={{header|Haskell}}==
{{works with|GHC|9.0.2}}
One might note that a lazy list automatically memoizes terms, but not with O(1) access times.
The continued fraction generated here for sqrt(2) is actually the continued fraction for a close rational approximation to sqrt(2). I borrowed the definition along with that of '''real2cf'''. The approximation is probably ''not'' what you would want in a practical application, but I thought the implementation was cool, and I did not feel like being pedantic (until writing this commentary). :)
<syntaxhighlight lang="haskell">
-- A continued fraction is represented as a lazy list of Int.
-- We borrow real2cf from
-- https://rosettacode.org/wiki/Continued_fraction/Arithmetic/Construct_from_rational_number#Haskell
-- though here some names in it are changed.
import Data.Ratio ((%))
real2cf frac =
let (quotient, remainder) = properFraction frac
in (quotient : (if remainder == 0
then []
else real2cf (1 / remainder)))
apply_hfunc (a1, a, b1, b) cf =
recurs (a1, a, b1, b, cf)
where recurs (a1, a, b1, b, cf) =
if b1 == 0 && b == 0 then
[]
else if b1 /= 0 && b /= 0 then
let q1 = div a1 b1
q = div a b
in
if q1 == q then
q : recurs (b1, b, a1 - (b1 * q), a - (b * q), cf)
else
recurs (take_term (a1, a, b1, b, cf))
else recurs (take_term (a1, a, b1, b, cf))
where take_term (a1, a, b1, b, cf) =
case cf of
[] -> (a1, a1, b1, b1, cf)
(term : cf1) -> (a + (a1 * term), a1,
b + (b1 * term), b1,
cf1)
cf_13_11 = real2cf (13 % 11)
cf_22_7 = real2cf (22 % 7)
cf_sqrt2 = real2cf (sqrt 2)
cfToString cf =
loop 0 0 "[" cf
where loop i sep s lst =
case lst of
[] -> s ++ "]"
(term : tail) ->
if i == 20
then s ++ ",...]"
else
do loop (i + 1) sep1 s1 tail
where sepStr = case sep of
0 -> ""
1 -> ";"
_ -> ","
sep1 = min (sep + 1) 2
termStr = show term
s1 = s ++ sepStr ++ termStr
show_cf expr cf =
do putStr expr;
putStr " => ";
putStrLn (cfToString cf)
main =
do show_cf "13/11" cf_13_11;
show_cf "22/7" cf_22_7;
show_cf "sqrt(2)" cf_sqrt2;
show_cf "13/11 + 1/2" (apply_hfunc (2, 1, 0, 2) cf_13_11);
show_cf "22/7 + 1/2" (apply_hfunc (2, 1, 0, 2) cf_22_7);
show_cf "(22/7)/4" (apply_hfunc (1, 0, 0, 4) cf_22_7);
show_cf "1/sqrt(2)" (apply_hfunc (0, 1, 1, 0) cf_sqrt2);
show_cf "(2 + sqrt(2))/4" (apply_hfunc (1, 2, 0, 4) cf_sqrt2);
show_cf "(1 + 1/sqrt(2))/2" (apply_hfunc (2, 1, 0, 2) -- cf + 1/2
(apply_hfunc (1, 0, 0, 2) -- cf/2
(apply_hfunc (0, 1, 1, 0) -- 1/cf
cf_sqrt2)))
</syntaxhighlight>
{{out}}
<pre>$ ghc univariate_continued_fraction_task.hs && ./univariate_continued_fraction_task
13/11 => [1;5,2]
22/7 => [3;7]
sqrt(2) => [1;2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,...]
13/11 + 1/2 => [1;1,2,7]
22/7 + 1/2 => [3;1,1,1,4]
(22/7)/4 => [0;1,3,1,2]
1/sqrt(2) => [0;1,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,...]
(2 + sqrt(2))/4 => [0;1,5,1,4,1,4,1,4,1,4,1,4,1,4,1,4,1,4,1,...]
(1 + 1/sqrt(2))/2 => [0;1,5,1,4,1,4,1,4,1,4,1,4,1,4,1,4,1,4,1,...]</pre>
=={{header|Icon}}==
{{works with|Icon|9.5.22e}}
{{trans|ATS}}
This implementation memoizes terms of a continued fraction.
<syntaxhighlight lang="icon">
# An implementation in Icon, using co-expressions as generators.
$define YES 1
$define NO &null
# terminated = are there no more terms to memoize?
# memo = memoized terms.
# generate = a co-expression to generate more terms.
record continued_fraction (terminated, memo, generate)
procedure main ()
local cf_13_11, cf_22_7, cf_sqrt2, cf_1_div_sqrt2
cf_13_11 := make_cf_rational (13, 11)
cf_22_7 := make_cf_rational (22, 7)
cf_sqrt2 := make_cf_sqrt2()
cf_1_div_sqrt2 := make_cf_hfunc (0, 1, 1, 0, cf_sqrt2)
show ("13/11", cf_13_11)
show ("22/7", cf_22_7)
show ("sqrt(2)", cf_sqrt2)
show ("13/11 + 1/2", make_cf_hfunc (2, 1, 0, 2, cf_13_11))
show ("22/7 + 1/2", make_cf_hfunc (2, 1, 0, 2, cf_22_7))
show ("(22/7)/4", make_cf_hfunc (1, 0, 0, 4, cf_22_7))
show ("1/sqrt(2)", cf_1_div_sqrt2)
show ("(2 + sqrt(2))/4", make_cf_hfunc (1, 2, 0, 4, cf_sqrt2))
show ("(1 + 1/sqrt(2))/2", make_cf_hfunc (1, 1, 0, 2,
cf_1_div_sqrt2))
end
procedure show (expr, cf)
write (expr, " => ", cf2string (cf))
end
procedure make_cf_sqrt2 ()
return make_continued_fraction (create gen_sqrt2 ())
end
procedure make_cf_rational (n, d)
return make_continued_fraction (create gen_rational (n, d))
end
procedure make_cf_hfunc (a1, a, b1, b, other_cf)
return make_continued_fraction (create gen_hfunc (a1, a, b1, b,
other_cf))
end
procedure gen_sqrt2 ()
suspend 1
repeat suspend 2
end
procedure gen_rational (n, d)
local q, r
repeat {
if d = 0 then fail
q := n / d
r := n % d
n := d
d := r
suspend q
}
end
procedure gen_hfunc (a1, a, b1, b, other_cf)
local a1_tmp, a_tmp, b1_tmp, b_tmp
local i, term, skip_getting_a_term
local q1, q
i := 0
repeat {
skip_getting_a_term := NO
if b1 = b = 0 then {
fail
} else if b1 ~= 0 & b ~= 0 then {
q1 := a1 / b1
q := a / b
if q1 = q then {
a1_tmp := a1
a_tmp := a
b1_tmp := b1
b_tmp := b
a1 := b1_tmp
a := b_tmp
b1 := a1_tmp - (b1_tmp * q)
b := a_tmp - (b_tmp * q)
suspend q
skip_getting_a_term := YES
}
}
if /skip_getting_a_term then {
if term := get_term (other_cf, i) then {
i +:= 1
a1_tmp := a1
a_tmp := a
b1_tmp := b1
b_tmp := b
a1 := a_tmp + (a1_tmp * term)
a := a1_tmp
b1 := b_tmp + (b1_tmp * term)
b := b1_tmp
} else {
a := a1
b := b1
}
}
}
end
procedure make_continued_fraction (gen)
return continued_fraction (NO, [], gen)
end
procedure get_term (cf, i)
local j, term
if *cf.memo <= i then {
if \cf.terminated then {
fail
} else {
every j := *cf.memo to i do {
if term := @(cf.generate) then {
put (cf.memo, term)
} else {
cf.terminated := YES
fail
}
}
}
}
return cf.memo[i + 1]
end
procedure cf2string (cf, max_terms)
local s, sep, i, done, term
/max_terms := 20
s := "["
sep := 0
i := 0
done := NO
while /done do {
if i = max_terms then {
# We have reached the maximum of terms to print. Stick an
# ellipsis in the notation.
s ||:= ",...]"
done := YES
} else if term := get_term (cf, i) then {
# Getting a term succeeded. Include the term.
s ||:= sep_str (sep) || term
sep := sep + 1
if 2 < sep then sep := 2
i +:= 1
} else {
# Getting a term failed. We are done.
s ||:= "]"
done := YES
}
}
return s
end
procedure sep_str (sep)
return (if sep = 0 then "" else if sep = 1 then ";" else ",")
end
</syntaxhighlight>
{{out}}
<pre>icon univariate-continued-fraction-task.icn
13/11 => [1;5,2]
22/7 => [3;7]
sqrt(2) => [1;2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,...]
13/11 + 1/2 => [1;1,2,7]
22/7 + 1/2 => [3;1,1,1,4]
(22/7)/4 => [0;1,3,1,2]
1/sqrt(2) => [0;1,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,...]
(2 + sqrt(2))/4 => [0;1,5,1,4,1,4,1,4,1,4,1,4,1,4,1,4,1,4,1,...]
(1 + 1/sqrt(2))/2 => [0;1,5,1,4,1,4,1,4,1,4,1,4,1,4,1,4,1,4,1,...]</pre>
=={{header|J}}==
Line 3,883 ⟶ 5,012:
(+%)/plus1r2times1r2 0 1,999$2
0.853553</syntaxhighlight>
=={{header|Java}}==
<syntaxhighlight lang="java">
import java.util.List;
public final class ContinuedFractionArithmeticG1 {
public static void main(String[] aArgs) {
List<CFData> cfData = List.of(
new CFData("[1; 5, 2] + 1 / 2 ", new int[] { 2, 1, 0, 2 }, (CFIterator) new R2cfIterator(13, 11) ),
new CFData("[3; 7] + 1 / 2 ", new int[] { 2, 1, 0, 2 }, (CFIterator) new R2cfIterator(22, 7) ),
new CFData("[3; 7] divided by 4 ", new int[] { 1, 0, 0, 4 }, (CFIterator) new R2cfIterator(22, 7) ),
new CFData("sqrt(2) ", new int[] { 0, 1, 1, 0 }, (CFIterator) new ReciprocalRoot2() ),
new CFData("1 / sqrt(2) ", new int[] { 0, 1, 1, 0 }, (CFIterator) new Root2() ),
new CFData("(1 + sqrt(2)) / 2 ", new int[] { 1, 1, 0, 2 }, (CFIterator) new Root2() ),
new CFData("(1 + 1 / sqrt(2)) / 2", new int[] { 1, 1, 0, 2 }, (CFIterator) new ReciprocalRoot2() ) );
for ( CFData data : cfData ) {
System.out.print(data.text + " -> ");
NG ng = new NG(data.arguments);
CFIterator iterator = data.iterator;
int nextTerm = 0;
for ( int i = 1; i <= 20 && iterator.hasNext(); i++ ) {
nextTerm = iterator.next();
if ( ! ng.needsTerm() ) {
System.out.print(ng.egress() + " ");
}
ng.ingress(nextTerm);
}
while ( ! ng.done() ) {
System.out.print(ng.egressDone() + " ");
}
System.out.println();
}
}
private static class NG {
public NG(int[] aArgs) {
a1 = aArgs[0]; a = aArgs[1]; b1 = aArgs[2]; b = aArgs[3];
}
public void ingress(int aN) {
int temp = a; a = a1; a1 = temp + a1 * aN;
temp = b; b = b1; b1 = temp + b1 * aN;
}
public int egress() {
final int n = a / b;
int temp = a; a = b; b = temp - b * n;
temp = a1; a1 = b1; b1 = temp - b1 * n;
return n;
}
public boolean needsTerm() {
return ( b == 0 || b1 == 0 ) || ( a * b1 != a1 * b );
}
public int egressDone() {
if ( needsTerm() ) {
a = a1;
b = b1;
}
return egress();
}
public boolean done() {
return ( b == 0 || b1 == 0 );
}
private int a1, a, b1, b;
}
private static abstract class CFIterator {
public abstract boolean hasNext();
public abstract int next();
}
private static class R2cfIterator extends CFIterator {
public R2cfIterator(int aNumerator, int aDenominator) {
numerator = aNumerator; denominator = aDenominator;
}
public boolean hasNext() {
return denominator != 0;
}
public int next() {
int div = numerator / denominator;
int rem = numerator % denominator;
numerator = denominator;
denominator = rem;
return div;
}
private int numerator, denominator;
}
private static class Root2 extends CFIterator {
public Root2() {
firstReturn = true;
}
public boolean hasNext() {
return true;
}
public int next() {
if ( firstReturn ) {
firstReturn = false;
return 1;
}
return 2;
}
private boolean firstReturn;
}
private static class ReciprocalRoot2 extends CFIterator {
public ReciprocalRoot2() {
firstReturn = true;
secondReturn = true;
}
public boolean hasNext() {
return true;
}
public int next() {
if ( firstReturn ) {
firstReturn = false;
return 0;
}
if ( secondReturn ) {
secondReturn = false;
return 1;
}
return 2;
}
private boolean firstReturn, secondReturn;
}
private static record CFData(String text, int[] arguments, CFIterator iterator) {}
}
</syntaxhighlight>
{{ out }}
<pre>
[1; 5, 2] + 1 / 2 -> 1 1 2 7
[3; 7] + 1 / 2 -> 3 1 1 1 4
[3; 7] divided by 4 -> 0 1 3 1 2
sqrt(2) -> 1 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2
1 / sqrt(2) -> 0 1 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2
(1 + sqrt(2)) / 2 -> 1 4 1 4 1 4 1 4 1 4 1 4 1 4 1 4 1 4 1 4
(1 + 1 / sqrt(2)) / 2 -> 0 1 5 1 4 1 4 1 4 1 4 1 4 1 4 1 4 1 5
</pre>
=={{header|Julia}}==
Line 4,107 ⟶ 5,404:
(1 + 1 / sqrt(2)) / 2 -> 0 1 5 1 4 1 4 1 4 1 4 1 4 1 4 1 4 1 4 1
</pre>
=={{header|Mercury}}==
{{trans|Haskell}}
<syntaxhighlight lang="mercury">
%%%-------------------------------------------------------------------
:- module univariate_continued_fraction_task_lazy.
:- interface.
:- import_module io.
:- pred main(io::di, io::uo) is det.
:- implementation.
:- import_module integer. % Arbitrary-precision integers.
:- import_module lazy. % Lazy evaluation.
:- import_module list.
:- import_module rational. % Arbitrary-precision fractions.
:- import_module string.
%%%-------------------------------------------------------------------
%%%
%%% The following lazy list implementation is suggested in the Mercury
%%% Library Reference, although (for convenience) I have changed the
%%% names.
%%%
:- type lzlist(T)
---> lzlist(lazy(lzcell(T))).
:- type lzcell(T)
---> lzcons(T, lzlist(T))
; lznil.
%%%-------------------------------------------------------------------
%%%
%%% Types of interest.
%%%
:- type cf == lzlist(integer). % A continued fraction.
:- type hf == {integer, integer,
integer, integer}. % A homographic function.
:- type ng4 == hf. % A synonym for hf.
%%%-------------------------------------------------------------------
%%%
%%% Make a "continued fraction" that has no terms.
%%%
:- func cfnil = cf.
cfnil = lzlist(delay((func) = lznil)).
%%%-------------------------------------------------------------------
%%%
%%% Make a continued fraction that repeats the same term forever.
%%%
:- func repeat_forever(integer) = cf.
repeat_forever(N) = CF :-
CF = lzlist(delay(Cons)),
Cons = ((func) = lzcons(N, repeat_forever(N))).
%%%-------------------------------------------------------------------
%%%
%%% sqrt2 is a continued fraction for the square root of two.
%%%
:- func sqrt2 = cf.
sqrt2 = lzlist(delay((func) = lzcons(one, repeat_forever(two)))).
%%%-------------------------------------------------------------------
%%%
%%% r2cf takes a fraction, and returns a continued fraction as a lazy
%%% list of terms.
%%%
:- func r2cf(rational) = cf.
:- func r2cf(integer, integer) = cf.
r2cf(Ratnum) = CF :-
r2cf(numer(Ratnum), denom(Ratnum)) = CF.
r2cf(Numerator, Denominator) = CF :-
(if (Denominator = zero)
then (CF = cfnil)
else (CF = lzlist(delay(Cons)),
((func) = X :-
(X = lzcons(Quotient, r2cf(Denominator, Remainder)),
%% What follows is division with truncation towards zero.
divide_with_rem(Numerator, Denominator,
Quotient, Remainder))) = Cons)).
%%%-------------------------------------------------------------------
%%%
%%% Homographic functions of continued fractions.
%%%
:- func apply_ng4(ng4, cf) = cf.
:- func add_integer(cf, integer) = cf.
:- func add_rational(cf, rational) = cf.
:- func mul_integer(cf, integer) = cf.
:- func mul_rational(cf, rational) = cf.
:- func div_integer(cf, integer) = cf.
:- func reciprocal(cf) = cf.
add_integer(CF, I) = apply_ng4({one, I, zero, one}, CF).
add_rational(CF, R) = CF1 :-
N = (rational.numer(R)),
D = (rational.denom(R)),
CF1 = apply_ng4({D, N, zero, D}, CF).
mul_integer(CF, I) = apply_ng4({I, zero, zero, one}, CF).
mul_rational(CF, R) = apply_ng4({numer(R), zero, zero, denom(R)}, CF).
div_integer(CF, I) = apply_ng4({one, zero, zero, I}, CF).
reciprocal(CF) = apply_ng4({zero, one, one, zero}, CF).
apply_ng4({ A1, A, B1, B }, Other_CF) = CF :-
(if (B1 = zero, B = zero)
then (CF = cfnil)
else if (B1 \= zero, B \= zero)
then (
% The integer divisions here truncate towards zero. Say "div"
% instead of "//" to truncate towards negative infinity.
Q1 = A1 // B1,
Q = A // B,
(if (Q1 = Q)
then (CF = lzlist(delay(Cons)),
Cons = ((func) = lzcons(Q, ng4_eject_term(A1, A, B1, B,
Other_CF, Q))))
else (CF = ng4_absorb_term(A1, A, B1, B, Other_CF)))
)
else (CF = ng4_absorb_term(A1, A, B1, B, Other_CF))).
:- func ng4_eject_term(integer, integer, integer, integer, cf,
integer) = cf.
ng4_eject_term(A1, A, B1, B, Other_CF, Term) = CF :-
CF = apply_ng4({ B1, B, A1 - (B1 * Term), A - (B * Term) },
Other_CF).
:- func ng4_absorb_term(integer, integer, integer, integer, cf) = cf.
ng4_absorb_term(A1, A, B1, B, Other_CF) = CF :-
(Other_CF = lzlist(Cell),
CF = (if (force(Cell) = lzcons(Term, Rest))
then apply_ng4({ A + (A1 * Term), A1,
B + (B1 * Term), B1 },
Rest)
else apply_ng4({ A1, A1, B1, B1 }, cfnil))).
%%%-------------------------------------------------------------------
%%%
%%% cf2string and cf2string_with_max_terms convert a continued
%%% fraction to a printable string.
%%%
:- func cf2string(cf) = string.
:- func cf2string_with_max_terms(cf, integer) = string.
cf2string(CF) = cf2string_with_max_terms(CF, integer(20)).
cf2string_with_max_terms(CF, MaxTerms) = S :-
S = cf2string_loop(CF, MaxTerms, zero, "[").
:- func cf2string_loop(cf, integer, integer, string) = string.
cf2string_loop(CF, MaxTerms, I, Accum) = S :-
(CF = lzlist(ValCell),
force(ValCell) = Cell,
(if (Cell = lzcons(Term, Tail))
then (if (I = MaxTerms) then (S = Accum ++ ",...]")
else ((Separator = (if (I = zero) then ""
else if (I = one) then ";"
else ",")),
TermStr = to_string(Term),
S = cf2string_loop(Tail, MaxTerms, I + one,
Accum ++ Separator ++ TermStr)))
else (S = Accum ++ "]"))).
%%%-------------------------------------------------------------------
:- pred show(string::in, cf::in, io::di, io::uo) is det.
show(Expression, CF, !IO) :-
print(Expression, !IO),
print(" => ", !IO),
print(cf2string(CF), !IO),
nl(!IO).
main(!IO) :-
CF_13_11 = r2cf(rational(13, 11)),
CF_22_7 = r2cf(rational(22, 7)),
show("13/11", CF_13_11, !IO),
show("22/7", CF_22_7, !IO),
show("sqrt(2)", sqrt2, !IO),
show("13/11 + 1/2", add_rational(CF_13_11, rational(1, 2)), !IO),
show("22/7 + 1/2", add_rational(CF_22_7, rational(1, 2)), !IO),
show("(22/7)/4", div_integer(CF_22_7, integer(4)), !IO),
show("(22/7)*(1/4)", mul_rational(CF_22_7, rational(1, 4)), !IO),
show("1/sqrt(2)", reciprocal(sqrt2), !IO),
show("sqrt(2)/2", div_integer(sqrt2, two), !IO),
show("sqrt(2)*(1/2)", mul_rational(sqrt2, rational(1, 2)), !IO),
%% Getting (1 + 1/sqrt(2))/2 in a single step.
show("(2 + sqrt(2))/4",
apply_ng4({one, two, zero, integer(4)}, sqrt2),
!IO),
%% Different ways to compute the same thing.
show("(1/sqrt(2) + 1)/2",
div_integer(add_integer(reciprocal(sqrt2), one),
two),
!IO),
show("(1/sqrt(2))*(1/2) + 1/2",
add_rational(mul_rational(reciprocal(sqrt2),
rational(1, 2)),
rational(1, 2)),
!IO),
show("((sqrt(2)/2 + 1)/4)*2", % Contrived, to get in mul_integer.
mul_integer(div_integer(add_integer(div_integer(sqrt2, two),
one),
integer(4)),
two),
!IO),
true.
%%%-------------------------------------------------------------------
%%% local variables:
%%% mode: mercury
%%% prolog-indent-width: 2
%%% end:
</syntaxhighlight>
{{out}}
<pre>$ mmc -m univariate_continued_fraction_task_lazy && ./univariate_continued_fraction_task_lazy
Making Mercury/int3s/univariate_continued_fraction_task_lazy.int3
Making Mercury/ints/univariate_continued_fraction_task_lazy.int
Making Mercury/cs/univariate_continued_fraction_task_lazy.c
Making Mercury/os/univariate_continued_fraction_task_lazy.o
Making univariate_continued_fraction_task_lazy
13/11 => [1;5,2]
22/7 => [3;7]
sqrt(2) => [1;2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,...]
13/11 + 1/2 => [1;1,2,7]
22/7 + 1/2 => [3;1,1,1,4]
(22/7)/4 => [0;1,3,1,2]
(22/7)*(1/4) => [0;1,3,1,2]
1/sqrt(2) => [0;1,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,...]
sqrt(2)/2 => [0;1,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,...]
sqrt(2)*(1/2) => [0;1,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,...]
(2 + sqrt(2))/4 => [0;1,5,1,4,1,4,1,4,1,4,1,4,1,4,1,4,1,4,1,...]
(1/sqrt(2) + 1)/2 => [0;1,5,1,4,1,4,1,4,1,4,1,4,1,4,1,4,1,4,1,...]
(1/sqrt(2))*(1/2) + 1/2 => [0;1,5,1,4,1,4,1,4,1,4,1,4,1,4,1,4,1,4,1,...]
((sqrt(2)/2 + 1)/4)*2 => [0;1,5,1,4,1,4,1,4,1,4,1,4,1,4,1,4,1,4,1,...]</pre>
=={{header|Nim}}==
Line 4,224 ⟶ 5,778:
(1 + sqrt(2)) / 2 → 1 4 1 4 1 4 1 4 1 4 1 4 1 4 1 4 1 4 1 4
(1 + 1 / sqrt(2)) / 2 → 0 1 5 1 4 1 4 1 4 1 4 1 4 1 4 1 4 1 4 1</pre>
=={{header|ObjectIcon}}==
{{trans|ATS}}
{{trans|Icon}}
This is essentially the Icon implementation, but with the data and procedures encapsulated in classes.
(The generators are likely to run faster than in recent versions of Arizona Icon, due to a faster implementation of co-expressions. Unicon might run the conventional Icon implementation quickly, however.)
<syntaxhighlight lang="objecticon">
# -*- ObjectIcon -*-
import io
procedure main ()
local cf_13_11, cf_22_7, cf_sqrt2, cf_1_div_sqrt2
cf_13_11 := CF_rational (13, 11)
cf_22_7 := CF_rational (22, 7)
cf_sqrt2 := CF_sqrt2()
cf_1_div_sqrt2 := CF_hfunc (0, 1, 1, 0, cf_sqrt2)
show ("13/11", cf_13_11)
show ("22/7", cf_22_7)
show ("sqrt(2)", cf_sqrt2)
show ("13/11 + 1/2", CF_hfunc (2, 1, 0, 2, cf_13_11))
show ("22/7 + 1/2", CF_hfunc (2, 1, 0, 2, cf_22_7))
show ("(22/7)/4", CF_hfunc (1, 0, 0, 4, cf_22_7))
show ("1/sqrt(2)", cf_1_div_sqrt2)
show ("(2 + sqrt(2))/4", CF_hfunc (1, 2, 0, 4, cf_sqrt2))
show ("(1 + 1/sqrt(2))/2", CF_hfunc (1, 1, 0, 2,
cf_1_div_sqrt2))
end
procedure show (expr, cf)
io.write (expr, " => ", cf.to_string())
end
class CF () # A continued fraction.
private terminated # Are there no more terms to memoize?
private memo # Memoized terms.
private generate # A co-expression to generate more terms.
public new (gen)
terminated := &no
memo := []
generate := gen
return
end
public get_term (i)
local j, term
if *memo <= i then {
if \terminated then {
fail
} else {
every j := *memo to i do {
if term := @generate then {
put (memo, term)
} else {
terminated := &yes
fail
}
}
}
}
return memo[i + 1]
end
public to_string (max_terms)
local s, sep, i, done, term
/max_terms := 20
s := "["
sep := 0
i := 0
done := &no
while /done do {
if i = max_terms then {
# We have reached the maximum of terms to print. Stick an
# ellipsis in the notation.
s ||:= ",...]"
done := &yes
} else if term := get_term (i) then {
# Getting a term succeeded. Include the term.
s ||:= sep_str (sep) || term
sep := min (sep + 1, 2)
i +:= 1
} else {
# Getting a term failed. We are done.
s ||:= "]"
done := &yes
}
}
return s
end
private sep_str (sep)
return (if sep = 0 then "" else if sep = 1 then ";" else ",")
end
end # class CF
class CF_sqrt2 (CF) # A continued fraction for sqrt(2).
public override new ()
CF.new (create gen ())
return
end
private gen ()
suspend 1
repeat suspend 2
end
end # class CF_sqrt2
class CF_rational (CF) # A continued fraction for a rational number.
public override new (numerator, denominator)
CF.new (create gen (numerator, denominator))
return
end
private gen (n, d)
local q, r
repeat {
if d = 0 then fail
q := n / d
r := n % d
n := d
d := r
suspend q
}
end
end # class CF_rational
class CF_hfunc (CF) # A continued fraction for a homographic function
# of some other continued fraction.
public override new (a1, a, b1, b, other_cf)
CF.new (create gen (a1, a, b1, b, other_cf))
return
end
private gen (a1, a, b1, b, other_cf)
local a1_tmp, a_tmp, b1_tmp, b_tmp
local i, term, skip_getting_a_term
local q1, q
i := 0
repeat {
skip_getting_a_term := &no
if b1 = b = 0 then {
fail
} else if b1 ~= 0 & b ~= 0 then {
q1 := a1 / b1
q := a / b
if q1 = q then {
a1_tmp := a1
a_tmp := a
b1_tmp := b1
b_tmp := b
a1 := b1_tmp
a := b_tmp
b1 := a1_tmp - (b1_tmp * q)
b := a_tmp - (b_tmp * q)
suspend q
skip_getting_a_term := &yes
}
}
if /skip_getting_a_term then {
if term := other_cf.get_term (i) then {
i +:= 1
a1_tmp := a1
a_tmp := a
b1_tmp := b1
b_tmp := b
a1 := a_tmp + (a1_tmp * term)
a := a1_tmp
b1 := b_tmp + (b1_tmp * term)
b := b1_tmp
} else {
a := a1
b := b1
}
}
}
end
end # class CF_hfunc
</syntaxhighlight>
{{out}}
<pre>$ oiscript univariate-continued-fraction-task-OI.icn
13/11 => [1;5,2]
22/7 => [3;7]
sqrt(2) => [1;2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,...]
13/11 + 1/2 => [1;1,2,7]
22/7 + 1/2 => [3;1,1,1,4]
(22/7)/4 => [0;1,3,1,2]
1/sqrt(2) => [0;1,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,...]
(2 + sqrt(2))/4 => [0;1,5,1,4,1,4,1,4,1,4,1,4,1,4,1,4,1,4,1,...]
(1 + 1/sqrt(2))/2 => [0;1,5,1,4,1,4,1,4,1,4,1,4,1,4,1,4,1,4,1,...]</pre>
=={{header|OCaml}}==
{{trans|ATS}}
This implementation memoizes terms of a continued fraction.
<syntaxhighlight lang="ocaml">
module CF = (* A continued fraction. *)
struct
type record_t =
{
terminated : bool; (* Are there no more terms to memoize? *)
m : int; (* The number of memoized terms. *)
memo : int Array.t; (* Storage for the memoized terms. *)
gen : unit -> int option; (* A generator of new terms. *)
}
type t = record_t ref
let make gen =
ref { terminated = false;
m = 0;
memo = Array.make (8) 0;
gen = gen }
let get cf i =
let get_more_terms record needed =
let rec loop j =
if j = needed then
{ record with terminated = false; m = needed }
else
match record.gen () with
| None -> { record with terminated = true; m = i }
| Some term ->
begin
record.memo.(i) <- term;
loop (j + 1)
end
in
loop record.m
in
let update record needed =
if record.terminated then
record
else if needed <= record.m then
record
else if needed <= Array.length record.memo then
get_more_terms record needed
else
(* Provide twice the room that might be needed. *)
let n1 = needed + needed in
let memo1 = Array.make (n1) 0 in
let record =
begin
for j = 0 to record.m - 1 do
memo1.(j) <- record.memo.(j)
done;
{ record with memo = memo1 }
end
in
get_more_terms record needed
in
let record = update !cf (i + 1) in
begin
cf := record;
if i < record.m then
Some record.memo.(i)
else
None
end
let to_string ?max_terms:(max_terms = 20) cf =
let rec loop i sep accum =
if i = max_terms then
accum ^ ",...]"
else
match get cf i with
| None -> accum ^ "]"
| Some term ->
let sep_str =
match sep with
| 0 -> ""
| 1 -> ";"
| _ -> ","
in
let sep = min (sep + 1) 2 in
let term_str = string_of_int term in
let accum = accum ^ sep_str ^ term_str in
loop (i + 1) sep accum
in
loop 0 0 "["
let to_thunk cf = (* To use a CF.t as a generator of terms. *)
let index = ref 0 in
fun () -> let i = !index in
begin
index := i + 1;
get cf i
end
end
let cf_sqrt2 = (* A continued fraction for sqrt(2). *)
CF.make (let next_term = ref 1 in
fun () -> let term = !next_term in
begin
next_term := 2;
Some term
end)
let cf_rational n d = (* Make a continued fraction for a rational
number. *)
CF.make (let ratnum = ref (n, d) in
fun () -> let (n, d) = !ratnum in
if d = 0 then
None
else
let q = n / d and r = n mod d in
begin
ratnum := (d, r);
Some q
end)
let cf_hfunc (a1, a, b1, b) other_cf =
let gen = CF.to_thunk other_cf in
let state = ref (a1, a, b1, b, gen) in
let hgen () =
let rec loop () =
let (a1, a, b1, b, gen) = !state in
let absorb_term () =
match gen () with
| None -> state := (a1, a1, b1, b1, gen)
| Some term -> state := (a + (a1 * term), a1,
b + (b1 * term), b1,
gen)
in
if b1 = 0 && b = 0 then
None
else if b1 <> 0 && b <> 0 then
let q1 = a1 / b1 and q = a / b in
if q1 = q then
begin
state := (b1, b, a1 - (b1 * q), a - (b * q), gen);
Some q
end
else
begin
absorb_term ();
loop ()
end
else
begin
absorb_term ();
loop ()
end
in
loop ()
in
CF.make hgen
;;
let show expr cf =
begin
print_string expr;
print_string " => ";
print_string (CF.to_string cf);
print_newline ()
end ;;
let hf_cf_add_1_2 = (2, 1, 0, 2) ;;
let hf_cf_add_1 = (1, 1, 0, 1) ;;
let hf_cf_div_2 = (1, 0, 0, 2) ;;
let hf_cf_div_4 = (1, 0, 0, 4) ;;
let hf_1_div_cf = (0, 1, 1, 0) ;;
let cf_13_11 = cf_rational 13 11 ;;
let cf_22_7 = cf_rational 22 7 ;;
let cf_1_div_sqrt2 = cf_hfunc hf_1_div_cf cf_sqrt2 ;;
show "13/11" cf_13_11 ;;
show "22/7" cf_22_7 ;;
show "sqrt(2)" cf_sqrt2 ;;
show "13/11 + 1/2" (cf_hfunc hf_cf_add_1_2 cf_13_11) ;;
show "22/7 + 1/2" (cf_hfunc hf_cf_add_1_2 cf_22_7) ;;
show "(22/7)/4" (cf_hfunc hf_cf_div_4 cf_22_7) ;;
show "1/sqrt(2)" cf_1_div_sqrt2 ;;
show "(2 + sqrt(2))/4" (cf_hfunc (1, 2, 0, 4) cf_sqrt2) ;;
(* Demonstrate a chain of operations. *)
show "(1 + 1/sqrt(2))/2" (cf_1_div_sqrt2
|> cf_hfunc hf_cf_add_1
|> cf_hfunc hf_cf_div_2) ;;
(* Demonstrate a slightly longer chain of operations. *)
show "((sqrt(2)/2) + 1)/2" (cf_sqrt2
|> cf_hfunc hf_cf_div_2
|> cf_hfunc hf_cf_add_1
|> cf_hfunc hf_cf_div_2) ;;
</syntaxhighlight>
{{out}}
<pre>$ ocaml univariate_continued_fraction_task.ml
13/11 => [1;5,2]
22/7 => [3;7]
sqrt(2) => [1;2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,...]
13/11 + 1/2 => [1;1,2,7]
22/7 + 1/2 => [3;1,1,1,4]
(22/7)/4 => [0;1,3,1,2]
1/sqrt(2) => [0;1,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,...]
(2 + sqrt(2))/4 => [0;1,5,1,4,1,4,1,4,1,4,1,4,1,4,1,4,1,4,1,...]
(1 + 1/sqrt(2))/2 => [0;1,5,1,4,1,4,1,4,1,4,1,4,1,4,1,4,1,4,1,...]
((sqrt(2)/2) + 1)/2 => [0;1,5,1,4,1,4,1,4,1,4,1,4,1,4,1,4,1,4,1,...]</pre>
=={{header|Phix}}==
Line 4,715 ⟶ 6,686:
=={{header|Scheme}}==
===Translated from Racket===
{{trans|Racket}}
{{works with|Gauche Scheme|0.9.12}}
Line 4,992 ⟶ 6,964:
(1+sqrt(2))/2 => [1;4,1,4,1,4,1,4,1,4,1,4,1,4,1,4,1,4,1,4,...]
(2+sqrt(2))/4 = (1+1/sqrt(2))/2 => [0;1,5,1,4,1,4,1,4,1,4,1,4,1,4,1,4,1,4,1,...]</pre>
===Translated from ATS===
{{trans|ATS}}
{{works with|Gauche Scheme|0.9.12}}
{{works with|CHICKEN Scheme|5.3.0}}
For CHICKEN Scheme you need the '''r7rs''' egg.
This implementation memoizes terms of a continued fraction.
<syntaxhighlight lang="scheme">(cond-expand
(r7rs)
(chicken (import (r7rs))))
(define-library (continued-fraction)
(export make-continued-fraction
continued-fraction?
continued-fraction-ref
continued-fraction->thunk)
(export continued-fraction->string
continued-fraction-max-terms)
(import (scheme base)
(scheme case-lambda))
(begin
(define-record-type <cf-record>
;; terminated? -- are these all the terms there are?
;; m -- how many terms are memoized so far?
;; memo -- where terms are memoized.
;; gen -- a thunk that generates terms.
(cf-record terminated? m memo gen)
cf-record?
(terminated? cf-record-terminated?
set-cf-record-terminated?!)
(m cf-record-m set-cf-record-m!)
(memo cf-record-memo set-cf-record-memo!)
(gen cf-record-gen set-cf-record-gen!))
(define cf-record-memo-start-size 8)
(define (make-continued-fraction gen)
(cf-record #f 0 (make-vector cf-record-memo-start-size) gen))
(define continued-fraction? cf-record?)
;; The following is an updating operation, but nevertheless I
;; leave out the "!" from the name.
(define (continued-fraction-ref cf i)
(cf-update! cf (+ i 1))
(and (< i (cf-record-m cf))
(vector-ref (cf-record-memo cf) i)))
(define (cf-get-more-terms! cf needed)
(define (loop i)
(if (= i needed)
(begin
(set-cf-record-terminated?! cf #f)
(set-cf-record-m! cf needed))
(let ((term ((cf-record-gen cf))))
(if term
(begin
(vector-set! (cf-record-memo cf) i term)
(loop (+ i 1)))
(begin
(set-cf-record-terminated?! cf #t)
(set-cf-record-m! cf i))))))
(loop (cf-record-m cf)))
(define (cf-update! cf needed)
(cond ((cf-record-terminated? cf) (begin))
((<= needed (cf-record-m cf)) (begin))
((<= needed (vector-length (cf-record-memo cf)))
(cf-get-more-terms! cf needed))
(else
;; Provide twice the room that might be needed.
(let* ((n1 (+ needed needed))
(memo1 (make-vector n1)))
(vector-copy! memo1 0 (cf-record-memo cf))
(set-cf-record-memo! cf memo1)
(cf-get-more-terms! cf needed)))))
(define (continued-fraction->thunk cf)
;; Make a generator from a continued fraction.
(define i 0)
(lambda ()
(let ((term (continued-fraction-ref cf i)))
(set! i (+ i 1))
term)))
(define continued-fraction-max-terms (make-parameter 20))
;; The following is an updating operation, but nevertheless I
;; leave out the "!" from the name.
(define continued-fraction->string
(case-lambda
((cf) (continued-fraction->string
cf (continued-fraction-max-terms)))
((cf max-terms)
(let loop ((i 0)
(sep 0)
(accum "["))
(if (= i max-terms)
(string-append accum ",...]")
(let ((term (continued-fraction-ref cf i)))
(if (not term)
(string-append accum "]")
(let* ((term-str (number->string term))
(sep-str (case sep
((0) "")
((1) ";")
((2) ",")))
(accum (string-append accum sep-str
term-str))
(sep (min (+ sep 1) 2)))
(loop (+ i 1) sep accum)))))))))
)) ;; end library (continued-fraction)
(define-library (number->continued-fraction)
(export number->continued-fraction)
(import (scheme base))
(import (continued-fraction))
(begin
(define (number->continued-fraction x)
;; This algorithm works directly with exact rationals, rather
;; than numerator and denominator separately.
(unless (real? x)
(error "number->continued-fraction: argument must be real" x))
(let ((ratnum (exact x))
(terminated? #f))
(make-continued-fraction
(lambda ()
(and (not terminated?)
(let* ((q (floor ratnum))
(diff (- ratnum q)))
(if (zero? diff)
(set! terminated? #t)
(set! ratnum (/ diff)))
q))))))
)) ;; end library (number->continued-fraction)
(define-library (homographic-function)
(export make-homographic-function
homographic-function?
homographic-function-ref
homographic-function-set!
homographic-function-copy
apply-homographic-function
make-homographic-function-operator)
(import (scheme base)
(scheme case-lambda))
(import (continued-fraction))
(begin
(define-record-type <homographic-function>
(make-homographic-function a1 a b1 b)
homographic-function?
(a1 homographic-function-a1 set-homographic-function-a1!)
(a homographic-function-a set-homographic-function-a!)
(b1 homographic-function-b1 set-homographic-function-b1!)
(b homographic-function-b set-homographic-function-b!))
(define (homographic-function-ref hfunc i)
(case i
((0) (homographic-function-a1 hfunc))
((1) (homographic-function-a hfunc))
((2) (homographic-function-b1 hfunc))
((3) (homographic-function-b hfunc))
(else
(error "homographic-function-ref: index out of range" i))))
(define (homographic-function-set! hfunc i x)
(case i
((0) (set-homographic-function-a1! hfunc x))
((1) (set-homographic-function-a! hfunc x))
((2) (set-homographic-function-b1! hfunc x))
((3) (set-homographic-function-b! hfunc x))
(else
(error "homographic-function-set!: index out of range" i))))
(define (homographic-function-copy hfunc)
(make-homographic-function (homographic-function-ref hfunc 0)
(homographic-function-ref hfunc 1)
(homographic-function-ref hfunc 2)
(homographic-function-ref hfunc 3)))
(define (apply-homographic-function hfunc cf)
(define gen (continued-fraction->thunk cf))
(define state (homographic-function-copy hfunc))
(make-continued-fraction
(lambda ()
(let loop ()
(let ((a1 (homographic-function-ref state 0))
(a (homographic-function-ref state 1))
(b1 (homographic-function-ref state 2))
(b (homographic-function-ref state 3)))
(define (take-term)
(let ((term (gen)))
(if term
(set! state
(make-homographic-function
(+ a (* a1 term)) a1 (+ b (* b1 term)) b1))
(begin
(homographic-function-set! state 1 a1)
(homographic-function-set! state 3 b1)))))
(cond
((and (zero? b1) (zero? b)) #f)
((and (not (zero? b1)) (not (zero? b)))
(let ((q1 (floor-quotient a1 b1))
(q (floor-quotient a b)))
(if (= q1 q)
(begin
(set! state
(make-homographic-function
b1 b (- a1 (* b1 q)) (- a (* b q))))
q)
(begin
(take-term)
(loop)))))
(else
(take-term)
(loop))))))))
(define make-homographic-function-operator
(case-lambda
((hfunc) (lambda (cf)
(apply-homographic-function hfunc cf)))
((a1 a b1 b) (make-homographic-function-operator
(make-homographic-function a1 a b1 b)))))
)) ;; end library (number->continued-fraction)
(define-library (demonstration)
(export run-demonstration)
(import (scheme base)
(scheme write))
(import (continued-fraction)
(number->continued-fraction)
(homographic-function))
(begin
(define (run-demonstration)
(define cf+1/2 (make-homographic-function-operator 2 1 0 2))
(define cf/2 (make-homographic-function-operator 1 0 0 2))
(define cf/4 (make-homographic-function-operator 1 0 0 4))
(define 1/cf (make-homographic-function-operator 0 1 1 0))
(define 2+cf./4 (make-homographic-function-operator 1 2 0 4))
(define 1+cf./2 (make-homographic-function-operator 1 1 0 2))
(define cf:13/11 (number->continued-fraction 13/11))
(define cf:22/7 (number->continued-fraction 22/7))
(define cf:sqrt2
(let ((next-term 1))
(make-continued-fraction
(lambda ()
(let ((term next-term))
(set! next-term 2)
term)))))
(display-cf "13/11" cf:13/11)
(display-cf "22/7" cf:22/7)
(display-cf "sqrt(2)" cf:sqrt2)
(display-cf "13/11 + 1/2" (cf+1/2 cf:13/11))
(display-cf "22/7 + 1/2" (cf+1/2 cf:22/7))
(display-cf "(22/7)/4" (cf/4 cf:22/7))
(display-cf "sqrt(2)/2" (cf/2 cf:sqrt2))
(display-cf "1/sqrt(2)" (1/cf cf:sqrt2))
(display-cf "(2 + sqrt(2))/4" (2+cf./4 cf:sqrt2))
(display-cf "(1 + 1/sqrt(2))/2" (1+cf./2 (1/cf cf:sqrt2)))
(display-cf "sqrt(2)/4 + 1/2" (cf+1/2 (cf/4 cf:sqrt2)))
(display-cf "(sqrt(2)/2)/2 + 1/2" (cf+1/2 (cf/2 (cf/2 cf:sqrt2))))
(display-cf "(1/sqrt(2))/2 + 1/2" (cf+1/2 (cf/2 (1/cf cf:sqrt2)))))
(define (display-cf expr cf)
(display expr)
(display " => ")
(display (continued-fraction->string cf))
(newline))
)) ;; end library (demonstration)
(import (demonstration))
(run-demonstration)
</syntaxhighlight>
{{out}}
<pre>$ gosh univariate-continued-fraction-task.scm
13/11 + 1/2 => [1;1,2,7]
22/7 + 1/2 => [3;1,1,1,4]
(22/7)/4 => [0;1,3,1,2]
sqrt(2)/2 => [0;1,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,...]
1/sqrt(2) => [0;1,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,...]
(2 + sqrt(2))/4 => [0;1,5,1,4,1,4,1,4,1,4,1,4,1,4,1,4,1,4,1,...]
(1 + 1/sqrt(2))/2 => [0;1,5,1,4,1,4,1,4,1,4,1,4,1,4,1,4,1,4,1,...]
sqrt(2)/4 + 1/2 => [0;1,5,1,4,1,4,1,4,1,4,1,4,1,4,1,4,1,4,1,...]
(sqrt(2)/2)/2 + 1/2 => [0;1,5,1,4,1,4,1,4,1,4,1,4,1,4,1,4,1,4,1,...]
(1/sqrt(2))/2 + 1/2 => [0;1,5,1,4,1,4,1,4,1,4,1,4,1,4,1,4,1,4,1,...]</pre>
===Translated from Haskell===
{{trans|Haskell}}
{{trans|Mercury}}
{{works with|Gauche Scheme|0.9.12}}
{{works with|CHICKEN Scheme|5.3.0}}
{{works with|Chibi Scheme|0.10.0}}
For CHICKEN Scheme you need the '''r7rs''' and '''srfi-41''' eggs.
This implementation represents a continued fraction as a lazy list. Thus there is memoization of terms suitable for sequential access to them.
<syntaxhighlight lang="scheme">
;;;-------------------------------------------------------------------
;;;
;;; With continued fractions as SRFI-41 lazy lists and homographic
;;; functions as vectors of length 4.
;;;
(cond-expand
(r7rs)
(chicken (import (r7rs))))
(import (scheme base))
(import (scheme case-lambda))
(import (scheme write))
(import (srfi 41)) ; Streams (lazy lists).
;;;-------------------------------------------------------------------
;;;
;;; Some simple continued fractions.
;;;
(define nil ; A "continued fraction" that contains no terms.
stream-null)
(define (repeat term) ; Infinite repetition of one term.
(stream-cons term (repeat term)))
(define sqrt2 ; The square root of two.
(stream-cons 1 (repeat 2)))
;;;-------------------------------------------------------------------
;;;
;;; Continued fraction for a rational number.
;;;
(define r2cf
(case-lambda
((n d)
(letrec ((recurs
(stream-lambda (n d)
(if (zero? d)
stream-null
(let-values (((q r) (floor/ n d)))
(stream-cons q (recurs d r)))))))
(recurs n d)))
((ratnum)
(let ((ratnum (exact ratnum)))
(r2cf (numerator ratnum)
(denominator ratnum))))))
;;;-------------------------------------------------------------------
;;;
;;; Application of a homographic function to a continued fraction.
;;;
(define-stream (apply-ng4 ng4 other-cf)
(define (eject-term a1 a b1 b other-cf term)
(apply-ng4 (vector b1 b (- a1 (* b1 term)) (- a (* b term)))
other-cf))
(define (absorb-term a1 a b1 b other-cf)
(if (stream-null? other-cf)
(apply-ng4 (vector a1 a1 b1 b1) other-cf)
(let ((term (stream-car other-cf))
(rest (stream-cdr other-cf)))
(apply-ng4 (vector (+ a (* a1 term)) a1
(+ b (* b1 term)) b1)
rest))))
(let ((a1 (vector-ref ng4 0))
(a (vector-ref ng4 1))
(b1 (vector-ref ng4 2))
(b (vector-ref ng4 3)))
(cond ((and (zero? b1) (zero? b)) stream-null)
((or (zero? b1) (zero? b)) (absorb-term a1 a b1 b other-cf))
(else
(let ((q1 (floor-quotient a1 b1))
(q (floor-quotient a b)))
(if (= q1 q)
(stream-cons q (eject-term a1 a b1 b other-cf q))
(absorb-term a1 a b1 b other-cf)))))))
;;;-------------------------------------------------------------------
;;;
;;; Particular homographic function applications.
;;;
(define (add-number cf num)
(if (integer? num)
(apply-ng4 (vector 1 num 0 1) cf)
(let ((num (exact num)))
(let ((n (numerator num))
(d (denominator num)))
(apply-ng4 (vector d n 0 d) cf)))))
(define (mul-number cf num)
(if (integer? num)
(apply-ng4 (vector num 0 0 1) cf)
(let ((num (exact num)))
(let ((n (numerator num))
(d (denominator num)))
(apply-ng4 (vector n 0 0 d) cf)))))
(define (div-number cf num)
(if (integer? num)
(apply-ng4 (vector 1 0 0 num) cf)
(let ((num (exact num)))
(let ((n (numerator num))
(d (denominator num)))
(apply-ng4 (vector d 0 0 n) cf)))))
(define (reciprocal cf) (apply-ng4 #(0 1 1 0) cf))
;;;-------------------------------------------------------------------
;;;
;;; cf2string: conversion from a continued fraction to a string.
;;;
(define *max-terms* (make-parameter 20))
(define cf2string
(case-lambda
((cf) (cf2string cf (*max-terms*)))
((cf max-terms)
(let loop ((i 0)
(s "[")
(strm cf))
(if (stream-null? strm)
(string-append s "]")
(let ((term (stream-car strm))
(tail (stream-cdr strm)))
(if (= i max-terms)
(string-append s ",...]")
(let ((separator (case i
((0) "")
((1) ";")
(else ",")))
(term-str (number->string term)))
(loop (+ i 1)
(string-append s separator term-str)
tail)))))))))
;;;-------------------------------------------------------------------
(define (show expression cf)
(display expression)
(display " => ")
(display (cf2string cf))
(newline))
(define cf:13/11 (r2cf 13/11))
(define cf:22/7 (r2cf 22/7))
(define cf:1/sqrt2 (reciprocal sqrt2))
(show "13/11" cf:13/11)
(show "22/7" cf:22/7)
(show "sqrt(2)" sqrt2)
(show "13/11 + 1/2" (add-number cf:13/11 1/2))
(show "22/7 + 1/2" (add-number cf:22/7 1/2))
(show "(22/7)/4" (div-number cf:22/7 4))
(show "(22/7)*(1/4)" (mul-number cf:22/7 1/4))
(show "(22/49)/(4/7)" (div-number (r2cf 22 49) 4/7))
(show "(22/49)*(7/4)" (mul-number (r2cf 22/49) 7/4))
(show "1/sqrt(2)" cf:1/sqrt2)
;; The simplest way to get (1 + 1/sqrt(2))/2.
(show "(sqrt(2) + 2)/4" (apply-ng4 #(1 2 0 4) sqrt2))
;; Getting it in a more obvious way.
(show "(1/sqrt(2) + 1)/2)" (div-number (add-number cf:1/sqrt2 1) 2))
;;;-------------------------------------------------------------------
</syntaxhighlight>
{{out}}
<pre>$ gosh univariate-continued-fraction-task-srfi41.scm
13/11 => [1;5,2]
22/7 => [3;7]
sqrt(2) => [1;2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,...]
13/11 + 1/2 => [1;1,2,7]
22/7 + 1/2 => [3;1,1,1,4]
(22/7)/4 => [0;1,3,1,2]
(22/7)*(1/4) => [0;1,3,1,2]
(22/49)/(4/7) => [0;1,3,1,2]
(22/49)*(7/4) => [0;1,3,1,2]
1/sqrt(2) => [0;1,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,...]
(sqrt(2) + 2)/4 => [0;1,5,1,4,1,4,1,4,1,4,1,4,1,4,1,4,1,4,1,...]
(1/sqrt(2) + 1)/2) => [0;1,5,1,4,1,4,1,4,1,4,1,4,1,4,1,4,1,4,1,...]</pre>
=={{header|Standard ML}}==
{{trans|ATS}}
{{trans|OCaml}}
This implementation memoizes the terms of a continued fraction.
<syntaxhighlight lang="sml">
(*------------------------------------------------------------------*)
signature CF =
sig
type gen_t = unit -> int Option.option
type cf_t
val make : gen_t -> cf_t
val sub : cf_t * int -> int Option.option
val toThunk : cf_t -> gen_t (* To use a cf_t as a generator. *)
val toStringWithMaxTerms : cf_t * int -> String.string
val toString : cf_t -> String.string
end
structure Cf : CF =
struct
type gen_t = unit -> int Option.option
type record_t =
{
terminated : bool,
m : int,
memo : int Array.array,
gen : gen_t
}
type cf_t = record_t ref
fun make gen =
ref
{
terminated = false,
m = 0,
memo = Array.array (8, 0),
gen = gen
}
fun sub (cf, i) =
let
fun getMoreTerms (record : record_t, needed : int) =
let
fun loop j =
if j = needed then
{
terminated = false,
m = needed,
memo = #memo record,
gen = #gen record
}
else
(case (#gen record) () of
Option.NONE =>
{
terminated = true,
m = i,
memo = #memo record,
gen = #gen record
}
| Option.SOME term =>
(Array.update (#memo record, i, term);
loop (j + 1)))
in
loop (#m record)
end
fun updateTerms (record : record_t, needed : int) =
if #terminated record then
record
else if needed <= #m record then
record
else if needed <= Array.length (#memo record) then
getMoreTerms (record, needed)
else
(* Provide more storage for memoized terms. *)
let
val n1 = needed + needed
val memo1 = Array.array (n1, 0)
fun copy_over i =
if i = #m record then
()
else
(Array.update (memo1, i,
Array.sub (#memo record, i));
copy_over (i + 1))
val () = copy_over 0
val record =
{
terminated = false,
m = #m record,
memo = memo1,
gen = #gen record
}
in
getMoreTerms (record, needed)
end
val record = updateTerms (!cf, i + 1)
in
cf := record;
if i < #m record then
Option.SOME (Array.sub (#memo record, i))
else
Option.NONE
end
fun toThunk cf =
let
val index = ref 0
in
fn () =>
let
val i = !index
in
index := i + 1;
sub (cf, i)
end
end
fun toStringWithMaxTerms (cf, maxTerms : int) =
let
fun loop (i, sep, accum) =
if i = maxTerms then
accum ^ ",...]"
else
(case sub (cf, i) of
Option.NONE => accum ^ "]"
| Option.SOME term =>
let
val sepStr =
if i = 0 then
""
else if i = 1 then
";"
else
","
val sep = Int.min (sep + 1, 2)
val termStr = Int.toString term
in
loop (i + 1, sep, accum ^ sepStr ^ termStr)
end)
in
loop (0, 0, "[")
end
fun toString cf =
toStringWithMaxTerms (cf, 20)
end (* structure Cf : CF *)
(*------------------------------------------------------------------*)
(* A continued fraction for the square root of two. *)
val cf_sqrt2 =
Cf.make
let
val nextTerm = ref 1
in
fn () =>
let
val term = !nextTerm
in
nextTerm := 2;
Option.SOME term
end
end ;
(*------------------------------------------------------------------*)
(* Make a continued fraction for a rational number. *)
fun cfRational (n : int, d : int) =
Cf.make
let
val ratnum = ref (n, d)
in
fn () =>
let
val (n, d) = !ratnum
in
if d = 0 then
Option.NONE
else
let
(* This is floor division. For truncation towards
zero, use "quot" and "rem". *)
val q = n div d
and r = n mod d
in
ratnum := (d, r);
Option.SOME q
end
end
end ;
(*------------------------------------------------------------------*)
(* Make a continued fraction that is the application of a homographic
function to another continued fraction. *)
fun cfHFunc (a1 : int, a : int, b1 : int, b : int)
(other_cf : Cf.cf_t) =
let
val gen = Cf.toThunk other_cf
val state = ref (a1, a, b1, b, gen)
fun hgen () =
let
fun loop () =
let
val (a1, a, b1, b, gen) = !state
fun absorb_term () =
case gen () of
Option.NONE =>
state := (a1, a1, b1, b1, gen)
| Option.SOME term =>
state := (a + (a1 * term), a1,
b + (b1 * term), b1,
gen)
in
if b1 = 0 andalso b = 0 then
Option.NONE
else if b1 <> 0 andalso b <> 0 then
let
(* This is floor division. For truncation towards
zero, use "quot" instead. *)
val q1 = a1 div b1
and q = a div b
in
if q1 = q then
(state := (b1, b, a1 - (b1 * q), a - (b * q),
gen);
Option.SOME q)
else
(absorb_term ();
loop ())
end
else
(absorb_term ();
loop ())
end
in
loop ()
end
in
Cf.make hgen
end ;
(* Some unary operations. *)
val add_one_half = cfHFunc (2, 1, 0, 2) ;
val add_one = cfHFunc (1, 1, 0, 1) ;
val div_by_two = cfHFunc (1, 0, 0, 2) ;
val div_by_four = cfHFunc (1, 0, 0, 4) ;
val one_div_cf = cfHFunc (0, 1, 1, 0) ;
(*------------------------------------------------------------------*)
fun show (expr, cf) =
(print expr;
print " => ";
print (Cf.toString cf);
print "\n") ;
fun main () =
let
val cf_13_11 = cfRational (13, 11)
val cf_22_7 = cfRational (22, 7)
val cf_1_div_sqrt2 = one_div_cf cf_sqrt2
in
show ("13/11", cf_13_11);
show ("22/7", cf_22_7);
show ("sqrt(2)", cf_sqrt2);
show ("13/11 + 1/2", add_one_half cf_13_11);
show ("22/7 + 1/2", add_one_half cf_22_7);
show ("(22/7)/4", div_by_four cf_22_7);
show ("1/sqrt(2)", cf_1_div_sqrt2);
show ("(2 + sqrt(2))/4", cfHFunc (1, 2, 0, 4) cf_sqrt2);
(* Demonstrate a chain of operations. *)
show ("(1 + 1/sqrt(2))/2",
div_by_two (add_one cf_1_div_sqrt2));
(* Demonstrate a slightly longer chain of operations. *)
show ("((sqrt(2)/2) + 1)/2",
div_by_two (add_one (div_by_two cf_sqrt2)))
end ;
(*------------------------------------------------------------------*)
(* Comment out the following line, if you are using polyc, but not if
you are using mlton or "poly --script". If you are using SML/NJ, I
do not know what to do. :) *)
main () ;
(*------------------------------------------------------------------*)
(* local variables: *)
(* mode: sml *)
(* sml-indent-level: 2 *)
(* sml-indent-args: 2 *)
(* end: *)
</syntaxhighlight>
{{out}}
<pre>$ poly --script univariate_continued_fraction_task.sml
13/11 => [1;5,2]
22/7 => [3;7]
sqrt(2) => [1;2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,...]
13/11 + 1/2 => [1;1,2,7]
22/7 + 1/2 => [3;1,1,1,4]
(22/7)/4 => [0;1,3,1,2]
1/sqrt(2) => [0;1,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,...]
(2 + sqrt(2))/4 => [0;1,5,1,4,1,4,1,4,1,4,1,4,1,4,1,4,1,4,1,...]
(1 + 1/sqrt(2))/2 => [0;1,5,1,4,1,4,1,4,1,4,1,4,1,4,1,4,1,4,1,...]
((sqrt(2)/2) + 1)/2 => [0;1,5,1,4,1,4,1,4,1,4,1,4,1,4,1,4,1,4,1,...]</pre>
=={{header|Tcl}}==
Line 5,091 ⟶ 7,892:
{{trans|Kotlin}}
{{libheader|Wren-dynamic}}
<syntaxhighlight lang="
var CFData = Tuple.create("Tuple", ["str", "ng", "r", "gen"])
| |||