Continued fraction/Arithmetic/G(matrix ng, continued fraction n): Difference between revisions
Content added Content deleted
(Well I don't know what happened there) |
|||
Line 108: | Line 108: | ||
=={{header|ATS}}== |
=={{header|ATS}}== |
||
===Using non-linear types=== |
|||
For no reason despite my curiosity, the program outputs its results in MathML. |
|||
The approach used here leaks memory freely, and so a program using it may require a garbage collector. An advantage, however, is that it memoizes results. |
|||
For no reason despite my curiosity, this demo program outputs its results in MathML. |
|||
<syntaxhighlight lang="ats"> |
<syntaxhighlight lang="ats"> |
||
Line 819: | Line 823: | ||
[[File:Univariate-continued-fraction-task.dats.png|alt=The output from the program, as rendered by Firefox.]] |
[[File:Univariate-continued-fraction-task.dats.png|alt=The output from the program, as rendered by Firefox.]] |
||
===Using linear types=== |
|||
This method of implementation purposely avoids the need for a garbage collector. It does not memoize results, however. |
|||
The demo program outputs LuaTeX macro code. |
|||
<syntaxhighlight lang="ats">(*------------------------------------------------------------------*) |
|||
(* In this implementation, memory is allocated only for linear |
|||
types. Thus discipline is maintained in the freeing of allocated |
|||
space. There is, however, no memoization. *) |
|||
(*------------------------------------------------------------------*) |
|||
#include "share/atspre_staload.hats" |
|||
staload UN = "prelude/SATS/unsafe.sats" |
|||
(* We need consistent definitions of division and remainder. Let us |
|||
set those here. For convenience (because the prelude provides it), |
|||
we will use truncation towards zero. *) |
|||
infixl ( / ) div |
|||
infixl ( mod ) rem |
|||
macdef div = g0int_div |
|||
macdef rem = g0int_mod |
|||
(* We will be using linear lists. Define a convenient notation. *) |
|||
#define NIL list_vt_nil () |
|||
#define :: list_vt_cons |
|||
(*------------------------------------------------------------------*) |
|||
(* Something we will use: copy the contents of one arrayptr to |
|||
another arrayptr. *) |
|||
extern fn {a : t@ype} |
|||
arrayptr_copy_over |
|||
{n : int} |
|||
(n : int n, |
|||
src : !arrayptr (a, n), |
|||
dst : !arrayptr (a, n)) |
|||
: void |
|||
implement {a} |
|||
arrayptr_copy_over {n} (n, src, dst) = |
|||
let |
|||
fun |
|||
loop (i : intGte 0, |
|||
src : !arrayptr (a, n), |
|||
dst : !arrayptr (a, n)) |
|||
: void = |
|||
if i < n then |
|||
begin |
|||
dst[i] := src[i]; |
|||
loop (succ i, src, dst) |
|||
end |
|||
in |
|||
loop (0, src, dst) |
|||
end |
|||
overload copy_over with arrayptr_copy_over |
|||
(*------------------------------------------------------------------*) |
|||
(* The basics. *) |
|||
(* For this pedagogical example, let us choose a particular integer |
|||
type, thus avoiding the clutter of template notation. *) |
|||
typedef integer = int |
|||
(* A generator is a recursive type that forms a tree. *) |
|||
datavtype generator_vt = |
|||
| generator_vt_nil of () (* The nil generator. *) |
|||
| {n : int} |
|||
generator_vt_cons of (* A non-nil generator. *) |
|||
(generator_func_vt n, (* What does the work. *) |
|||
int n, (* The size of workspace. *) |
|||
arrayptr (integer, n), (* The initial value of workspace. *) |
|||
arrayptr (integer, n), (* The workspace. *) |
|||
List_vt generator_vt) (* The sources. *) |
|||
where generator_func_vt (n : int) = |
|||
(int n, (* The size of workspace. *) |
|||
!arrayptr (integer, n), (* The workspace. *) |
|||
!List_vt generator_vt, (* The sources. *) |
|||
&bool? >> bool b, (* Is there a term? *) |
|||
&integer? >> opt (integer, b)) (* The term, if any. *) |
|||
-> #[b : bool] void |
|||
(* Reinitializes a generator. (Needed because there is no |
|||
memoization.) *) |
|||
extern fn generator_vt_initialize : (&generator_vt) -> void |
|||
overload initialize with generator_vt_initialize |
|||
(* Frees a generator. *) |
|||
extern fn generator_vt_free : generator_vt -> void |
|||
overload free with generator_vt_free |
|||
(*------------------------------------------------------------------*) |
|||
(* A function to print the output of a generator as Plain TeX. *) |
|||
extern fn |
|||
fprinttex_generator_output |
|||
(outf : FILEref, |
|||
gen : &generator_vt, |
|||
max_terms : intGte 1) |
|||
: void |
|||
(*------------------------------------------------------------------*) |
|||
(* Some functions to make generators. *) |
|||
extern fn (* For a rational number. *) |
|||
r2cf_make (n : integer, |
|||
d : integer) |
|||
: generator_vt |
|||
extern fn (* For the square root of 2. *) |
|||
sqrt2_make () |
|||
: generator_vt |
|||
extern fn (* For a homographic function. *) |
|||
hfunc_make (a1 : integer, |
|||
a : integer, |
|||
b1 : integer, |
|||
b : integer, |
|||
sources : List1_vt generator_vt) |
|||
: generator_vt |
|||
(*------------------------------------------------------------------*) |
|||
implement |
|||
generator_vt_initialize gen = |
|||
let |
|||
fun |
|||
recurs (gen : &generator_vt) : void = |
|||
case+ gen of |
|||
| generator_vt_nil () => () |
|||
| @ generator_vt_cons (_, worksize, initial, workspace, |
|||
sources) => |
|||
let |
|||
fun |
|||
initialize_recursively |
|||
(p : !List_vt generator_vt) |
|||
: void = |
|||
case+ p of |
|||
| NIL => () |
|||
| @ (gen :: tail) => |
|||
begin |
|||
recurs gen; |
|||
initialize_recursively tail; |
|||
fold@ p |
|||
end |
|||
in |
|||
copy_over (worksize, initial, workspace); |
|||
initialize_recursively sources; |
|||
fold@ gen |
|||
end |
|||
in |
|||
recurs gen |
|||
end |
|||
implement |
|||
generator_vt_free gen = |
|||
let |
|||
fun |
|||
recurs (gen : generator_vt) : void = |
|||
case+ gen of |
|||
| ~ generator_vt_nil () => () |
|||
| ~ generator_vt_cons (_, _, initial, workspace, sources) => |
|||
begin |
|||
free initial; |
|||
free workspace; |
|||
list_vt_freelin_fun (sources, lam x =<fun1> recurs x) |
|||
end |
|||
in |
|||
recurs gen |
|||
end |
|||
(*------------------------------------------------------------------*) |
|||
implement |
|||
fprinttex_generator_output (outf, gen, max_terms) = |
|||
let |
|||
fun |
|||
loop (gen : &generator_vt >> _, |
|||
sep : int, |
|||
terms_count : intGte 0) |
|||
: void = |
|||
if terms_count = max_terms then |
|||
fprint! (outf, ",\\cdots\\,]") |
|||
else |
|||
let |
|||
var term_exists : bool? |
|||
var term : integer? |
|||
in |
|||
case+ gen of |
|||
| generator_vt_nil () => () |
|||
| @ generator_vt_cons (run, worksize, _, workspace, |
|||
sources) => |
|||
let |
|||
var term_exists : bool? |
|||
var term : integer? |
|||
in |
|||
run (worksize, workspace, sources, term_exists, term); |
|||
if term_exists then |
|||
let |
|||
prval () = opt_unsome term |
|||
prval () = fold@ gen |
|||
in |
|||
case+ sep of |
|||
| 0 => fprint! (outf, "[\\,") |
|||
| 1 => fprint! (outf, ";") |
|||
| _ => fprint! (outf, ","); |
|||
fprint! (outf, term); |
|||
loop (gen, if sep = 0 then 1 else 2, |
|||
succ terms_count) |
|||
end |
|||
else |
|||
let |
|||
prval () = opt_unnone term |
|||
prval () = fold@ gen |
|||
in |
|||
fprint! (outf, "\\,]") |
|||
end |
|||
end |
|||
end |
|||
in |
|||
initialize gen; |
|||
loop (gen, 0, 0); |
|||
initialize gen |
|||
end |
|||
(*------------------------------------------------------------------*) |
|||
fn |
|||
r2cf_run : generator_func_vt 2 = |
|||
lam (worksize, workspace, _sources, term_exists, term) => |
|||
let |
|||
prval () = lemma_arrayptr_param workspace |
|||
val () = assertloc (2 <= worksize) |
|||
val d = arrayptr_get_at<integer> (workspace, 1) |
|||
in |
|||
if d = 0 then |
|||
begin |
|||
term_exists := false; |
|||
{prval () = opt_none term} |
|||
end |
|||
else |
|||
let |
|||
val n = workspace[0] |
|||
val @(q, r) = @(n div d, n rem d) |
|||
in |
|||
workspace[0] := d; |
|||
workspace[1] := r; |
|||
term_exists := true; |
|||
term := q; |
|||
{prval () = opt_some term} |
|||
end |
|||
end |
|||
implement |
|||
r2cf_make (n, d) = |
|||
let |
|||
val workspace = arrayptr_make_elt (i2sz 2, 0) |
|||
val initial = arrayptr_make_elt (i2sz 2, 0) |
|||
val () = initial[0] := n |
|||
and () = initial[1] := d |
|||
in |
|||
copy_over (2, initial, workspace); |
|||
generator_vt_cons (r2cf_run, 2, initial, workspace, NIL) |
|||
end |
|||
(*------------------------------------------------------------------*) |
|||
fn |
|||
sqrt2_run : generator_func_vt 1 = |
|||
lam (worksize, workspace, _sources, term_exists, term) => |
|||
let |
|||
prval () = lemma_arrayptr_param workspace |
|||
val () = assertloc (1 <= worksize) |
|||
in |
|||
term_exists := true; |
|||
term := arrayptr_get_at<integer> (workspace, 0); |
|||
{prval () = opt_some term}; |
|||
arrayptr_set_at<integer> (workspace, 0, 2) |
|||
end |
|||
implement |
|||
sqrt2_make () = |
|||
let |
|||
val workspace = arrayptr_make_elt (i2sz 1, 0) |
|||
val initial = arrayptr_make_elt (i2sz 1, 0) |
|||
val () = initial[0] := 1 |
|||
in |
|||
copy_over (1, initial, workspace); |
|||
generator_vt_cons (sqrt2_run, 1, initial, workspace, NIL) |
|||
end |
|||
(*------------------------------------------------------------------*) |
|||
fn |
|||
hfunc_run : generator_func_vt 4 = |
|||
lam (worksize, workspace, sources, term_exists, term) => |
|||
let |
|||
prval () = lemma_arrayptr_param workspace |
|||
val () = assertloc (4 <= worksize) |
|||
fun |
|||
loop (workspace : !arrayptr (integer, 4), |
|||
sources : !List_vt generator_vt, |
|||
term_exists : &bool? >> bool b, |
|||
term : &integer? >> opt (integer, b)) |
|||
: #[b : bool] void = |
|||
let |
|||
val b1 = arrayptr_get_at<integer> (workspace, 2) |
|||
and b = arrayptr_get_at<integer> (workspace, 3) |
|||
in |
|||
if b1 = 0 && b = 0 then |
|||
begin |
|||
term_exists := false; |
|||
{prval () = opt_none term} |
|||
end |
|||
else |
|||
let |
|||
val a1 = workspace[0] |
|||
and a = workspace[1] |
|||
fn |
|||
take_term (workspace : !arrayptr (integer, 4), |
|||
sources : !List_vt generator_vt) |
|||
: void = |
|||
let |
|||
val- @ (source :: _) = sources |
|||
val- @ generator_vt_cons |
|||
(run1, worksize1, _, workspace1, |
|||
sources1) = source |
|||
var term_exists1 : bool? |
|||
var term1 : integer? |
|||
in |
|||
run1 (worksize1, workspace1, sources1, |
|||
term_exists1, term1); |
|||
if term_exists1 then |
|||
let |
|||
prval () = opt_unsome term1 |
|||
in |
|||
workspace[0] := a + (a1 * term1); |
|||
workspace[1] := a1; |
|||
workspace[2] := b + (b1 * term1); |
|||
workspace[3] := b1; |
|||
fold@ source; |
|||
fold@ sources |
|||
end |
|||
else |
|||
let |
|||
prval () = opt_unnone term1 |
|||
in |
|||
workspace[1] := a1; |
|||
workspace[3] := b1; |
|||
fold@ source; |
|||
fold@ sources |
|||
end |
|||
end |
|||
in |
|||
if b1 <> 0 && b <> 0 then |
|||
let |
|||
val q1 = a1 div b1 |
|||
and q = a div b |
|||
in |
|||
if q1 = q then |
|||
begin |
|||
workspace[0] := b1; |
|||
workspace[1] := b; |
|||
workspace[2] := a1 - (b1 * q); |
|||
workspace[3] := a - (b * q); |
|||
term_exists := true; |
|||
term := q; |
|||
{prval () = opt_some term} |
|||
end |
|||
else |
|||
begin |
|||
take_term (workspace, sources); |
|||
loop (workspace, sources, term_exists, term) |
|||
end |
|||
end |
|||
else |
|||
begin |
|||
take_term (workspace, sources); |
|||
loop (workspace, sources, term_exists, term) |
|||
end |
|||
end |
|||
end |
|||
in |
|||
loop (workspace, sources, term_exists, term) |
|||
end |
|||
implement |
|||
hfunc_make (a1, a, b1, b, sources) = |
|||
let |
|||
val workspace = arrayptr_make_elt (i2sz 4, 0) |
|||
val initial = arrayptr_make_elt (i2sz 4, 0) |
|||
val () = initial[0] := a1 |
|||
val () = initial[1] := a |
|||
val () = initial[2] := b1 |
|||
val () = initial[3] := b |
|||
in |
|||
copy_over (4, initial, workspace); |
|||
generator_vt_cons (hfunc_run, 4, initial, workspace, sources) |
|||
end |
|||
(*------------------------------------------------------------------*) |
|||
#define MAX_TERMS 20 |
|||
#define GOES_TO "&\\rightarrow " |
|||
#define END_LINE "\\cr\n" |
|||
fn |
|||
fprinttex_rational_number |
|||
(outf : FILEref, |
|||
n : integer, |
|||
d : integer) |
|||
: void = |
|||
let |
|||
var gen = r2cf_make (n, d) |
|||
in |
|||
fprint! (outf, n, "\\over ", d, GOES_TO); |
|||
fprinttex_generator_output (outf, gen, MAX_TERMS); |
|||
fprint! (outf, END_LINE); |
|||
free gen |
|||
end |
|||
fn |
|||
fprinttex_sqrt2 |
|||
(outf : FILEref) |
|||
: void = |
|||
let |
|||
var gen = sqrt2_make () |
|||
in |
|||
fprint! (outf, "\\sqrt 2", GOES_TO); |
|||
fprinttex_generator_output (outf, gen, MAX_TERMS); |
|||
fprint! (outf, END_LINE); |
|||
free gen |
|||
end |
|||
fn |
|||
fprinttex_hfunc_of_rational_number |
|||
(outf : FILEref, |
|||
expr : string, |
|||
a1 : integer, |
|||
a : integer, |
|||
b1 : integer, |
|||
b : integer, |
|||
n : integer, |
|||
d : integer) |
|||
: void = |
|||
let |
|||
var gen = hfunc_make (a1, a, b1, b, r2cf_make (n, d) :: NIL) |
|||
in |
|||
fprint! (outf, expr, GOES_TO); |
|||
fprinttex_generator_output (outf, gen, MAX_TERMS); |
|||
fprint! (outf, END_LINE); |
|||
free gen |
|||
end |
|||
fn |
|||
fprinttex_hfunc_of_sqrt2 |
|||
(outf : FILEref, |
|||
expr : string, |
|||
a1 : integer, |
|||
a : integer, |
|||
b1 : integer, |
|||
b : integer) |
|||
: void = |
|||
let |
|||
var gen = hfunc_make (a1, a, b1, b, sqrt2_make () :: NIL) |
|||
in |
|||
fprint! (outf, expr, GOES_TO); |
|||
fprinttex_generator_output (outf, gen, MAX_TERMS); |
|||
fprint! (outf, END_LINE); |
|||
free gen |
|||
end |
|||
fn |
|||
fprinttex_complicated |
|||
(outf : FILEref) |
|||
: void = |
|||
(* Here we demonstrate a more complicated nesting of generators. *) |
|||
let |
|||
(* gen1 = 1/sqrt(2) *) |
|||
val gen1 = hfunc_make (0, 1, 1, 0, sqrt2_make () :: NIL) |
|||
(* gen2 = 1 + gen1 *) |
|||
val gen2 = hfunc_make (1, 1, 0, 1, gen1 :: NIL) |
|||
(* gen = gen2 / 2 *) |
|||
var gen = hfunc_make (1, 0, 0, 2, gen2 :: NIL) |
|||
in |
|||
fprint! (outf, "{1 + {1\\over\\sqrt 2}}\\over 2", GOES_TO); |
|||
fprinttex_generator_output (outf, gen, MAX_TERMS); |
|||
fprint! (outf, END_LINE); |
|||
free gen |
|||
end |
|||
(*------------------------------------------------------------------*) |
|||
implement |
|||
main () = |
|||
let |
|||
val outf = stdout_ref |
|||
in |
|||
(* I assume the TeX processor is LuaTeX. *) |
|||
fprintln! (outf, "\\pagewidth 5in\\hoffset-1in\\hsize 5in"); |
|||
fprintln! (outf, "\\pageheight 4in\\voffset-1in\\vsize 4in"); |
|||
(* The page number gets cut off, but let us suppress it, |
|||
anyway. *) |
|||
fprintln! (outf, "\\footline={}"); |
|||
fprintln! (outf, "\\normallineskip 3pt"); |
|||
fprintln! (outf, "\\normalbaselines"); |
|||
fprintln! (outf, "$$\\eqalign{"); |
|||
fprinttex_rational_number (outf, 13, 11); |
|||
fprinttex_rational_number (outf, 22, 7); |
|||
fprinttex_sqrt2 (outf); |
|||
fprinttex_hfunc_of_rational_number |
|||
(outf, "{13\\over 11} + {1\\over 2}", 2, 1, 0, 2, 13, 11); |
|||
fprinttex_hfunc_of_rational_number |
|||
(outf, "{22\\over 7} + {1\\over 2}", 2, 1, 0, 2, 22, 7); |
|||
fprinttex_hfunc_of_rational_number |
|||
(outf, "{22\\over 7}\\over 4", 1, 0, 0, 4, 22, 7); |
|||
fprinttex_hfunc_of_sqrt2 |
|||
(outf, "{\\sqrt 2}\\over 2", 1, 0, 0, 2); |
|||
fprinttex_hfunc_of_sqrt2 |
|||
(outf, "1\\over\\sqrt 2", 0, 1, 1, 0); |
|||
fprinttex_hfunc_of_sqrt2 |
|||
(outf, "{2 + \\sqrt 2}\\over 4", 1, 2, 0, 4); |
|||
fprinttex_complicated outf; |
|||
fprintln! (outf, "}$$"); |
|||
fprintln! (outf, "\\bye"); |
|||
0 |
|||
end |
|||
(*------------------------------------------------------------------*) |
|||
</syntaxhighlight> |
|||
=={{header|C}}== |
=={{header|C}}== |