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) |
|||
| (22 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 3,238 ⟶ 3,541:
if (!terminated && m < needed)
{
if (
{
// Increase the space to twice what might be needed
Line 4,287 ⟶ 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 4,424 ⟶ 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,648 ⟶ 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,765 ⟶ 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 5,846 ⟶ 7,276:
(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,945 ⟶ 7,892:
{{trans|Kotlin}}
{{libheader|Wren-dynamic}}
<syntaxhighlight lang="
var CFData = Tuple.create("Tuple", ["str", "ng", "r", "gen"])
| |||