aboutsummaryrefslogtreecommitdiff
path: root/entries/jlouis/lib
diff options
context:
space:
mode:
authorBraxton Hall2022-10-25 19:55:05 +0000
committerGitHub2022-10-25 19:55:05 +0000
commit51cfdff65b200f3cb16688b79720a1ab57d2db02 (patch)
tree3d83a52d4d895990b9b3b91ebaae5e78e938c51d /entries/jlouis/lib
parent9375f87d202403e93ea4196e60de24fd9a9ea065 (diff)
parent562c485e2e7bd5330e1ccbeb9fd2dc87e3255f9f (diff)
Merge pull request #43 from jlouis/jlouis-implementation
Provide a fib implementation for jlouis
Diffstat (limited to 'entries/jlouis/lib')
-rw-r--r--entries/jlouis/lib/dune5
-rw-r--r--entries/jlouis/lib/fib.ml72
2 files changed, 77 insertions, 0 deletions
diff --git a/entries/jlouis/lib/dune b/entries/jlouis/lib/dune
new file mode 100644
index 0000000..865a6c5
--- /dev/null
+++ b/entries/jlouis/lib/dune
@@ -0,0 +1,5 @@
+(library
+ (name fib)
+ (inline_tests)
+ (preprocess
+ (pps ppx_inline_test)))
diff --git a/entries/jlouis/lib/fib.ml b/entries/jlouis/lib/fib.ml
new file mode 100644
index 0000000..9353c6a
--- /dev/null
+++ b/entries/jlouis/lib/fib.ml
@@ -0,0 +1,72 @@
+module type BASIS =
+ sig
+ type t
+ val one : t
+ val out : t -> int
+ val to_string : t -> string
+ end
+
+module type MONOIDIC =
+ sig
+ include BASIS
+ val concat : t -> t -> t
+ end
+
+(* Single Tuple, Multiple Data *)
+module STMD : MONOIDIC =
+ struct
+ type t = int * int * int * int
+
+ let one = (1, 1,
+ 1, 0)
+
+ let out (_, _, _, x) = x
+
+ let to_string (a,b,c,d) = "(" ^ (string_of_int a) ^ ", "
+ ^ (string_of_int b) ^ ", "
+ ^ (string_of_int c) ^ ", "
+ ^ (string_of_int d) ^ ")"
+
+ let concat (a11, a12, a21, a22) (b11, b12, b21, b22) =
+ let muladd a x b y = (a*x) + (b*y) in
+ (muladd a11 b11 a12 b21,
+ muladd a11 b12 a12 b22,
+ muladd a21 b11 a22 b21,
+ muladd a21 b12 a22 b22)
+ end
+
+module MkLinear(M : MONOIDIC) =
+ struct
+ let iter n =
+ let rec loop n acc =
+ match n with
+ | 0 -> acc
+ | k -> loop (k-1) (M.concat M.one acc)
+ in
+ M.out (loop n M.one)
+
+ end
+
+module MkLog(M : MONOIDIC) =
+ struct
+ let iter n =
+ let rec loop y x k =
+ if k = 0 then y
+ else if k mod 2 = 0 then loop y (M.concat x x) (k/2)
+ else loop (M.concat y x) (M.concat x x) ((k-1)/2)
+ in
+ M.out (loop M.one M.one n)
+ end
+
+module Kobold = MkLinear(STMD) (* You no take candle! *)
+module Orc = MkLog(STMD) (* Mok'ra *)
+
+let%test _ = Kobold.iter 10 = 55
+let%test _ = Kobold.iter 0 = 0
+let%test _ = Orc.iter 0 = 0
+let%test _ = Orc.iter 1 = 1
+let%test _ = Orc.iter 2 = 1
+let%test _ = Orc.iter 3 = 2
+let%test _ = Orc.iter 4 = 3
+let%test _ = Orc.iter 5 = 5
+let%test _ = Orc.iter 10 = 55