Merge lima

This commit is contained in:
radrow
2020-04-02 15:32:26 +02:00
35 changed files with 3544 additions and 140 deletions
+183
View File
@@ -0,0 +1,183 @@
namespace Frac =
private function gcd(a : int, b : int) =
if (b == 0) a else gcd(b, a mod b)
private function abs_int(a : int) = if (a < 0) -a else a
datatype frac = Pos(int, int) | Zero | Neg(int, int)
/** Checks if the internal representation is correct.
* Numerator and denominator must be positive.
* Exposed for debug purposes
*/
function is_sane(f : frac) : bool = switch(f)
Pos(n, d) => n > 0 && d > 0
Zero => true
Neg(n, d) => n > 0 && d > 0
function num(f : frac) : int = switch(f)
Pos(n, _) => n
Neg(n, _) => -n
Zero => 0
function den(f : frac) : int = switch(f)
Pos(_, d) => d
Neg(_, d) => d
Zero => 1
function to_pair(f : frac) : int * int = switch(f)
Pos(n, d) => (n, d)
Neg(n, d) => (-n, d)
Zero => (0, 1)
function sign(f : frac) : int = switch(f)
Pos(_, _) => 1
Neg(_, _) => -1
Zero => 0
function to_str(f : frac) : string = switch(f)
Pos(n, d) => String.concat(Int.to_str(n), if (d == 1) "" else String.concat("/", Int.to_str(d)))
Neg(n, d) => String.concat("-", to_str(Pos(n, d)))
Zero => "0"
/** Reduce fraction to normal form
*/
function simplify(f : frac) : frac =
switch(f)
Neg(n, d) =>
let cd = gcd(n, d)
Neg(n / cd, d / cd)
Zero => Zero
Pos(n, d) =>
let cd = gcd(n, d)
Pos(n / cd, d / cd)
/** Integer to rational division
*/
function make_frac(n : int, d : int) : frac =
if (d == 0) abort("Zero denominator")
elif (n == 0) Zero
elif ((n < 0) == (d < 0)) simplify(Pos(abs_int(n), abs_int(d)))
else simplify(Neg(abs_int(n), abs_int(d)))
function one() : frac = Pos(1, 1)
function zero() : frac = Zero
function eq(a : frac, b : frac) : bool =
let (na, da) = to_pair(a)
let (nb, db) = to_pair(b)
(na == nb && da == db) || na * db == nb * da // they are more likely to be normalized
function neq(a : frac, b : frac) : bool =
let (na, da) = to_pair(a)
let (nb, db) = to_pair(b)
(na != nb || da != db) && na * db != nb * da
function geq(a : frac, b : frac) : bool = num(a) * den(b) >= num(b) * den(a)
function leq(a : frac, b : frac) : bool = num(a) * den(b) =< num(b) * den(a)
function gt(a : frac, b : frac) : bool = num(a) * den(b) > num(b) * den(a)
function lt(a : frac, b : frac) : bool = num(a) * den(b) < num(b) * den(a)
function min(a : frac, b : frac) : frac = if (leq(a, b)) a else b
function max(a : frac, b : frac) : frac = if (geq(a, b)) a else b
function abs(f : frac) : frac = switch(f)
Pos(n, d) => Pos(n, d)
Zero => Zero
Neg(n, d) => Pos(n, d)
function from_int(n : int) : frac =
if (n > 0) Pos(n, 1)
elif (n < 0) Neg(-n, 1)
else Zero
function floor(f : frac) : int = switch(f)
Pos(n, d) => n / d
Zero => 0
Neg(n, d) => -(n + d - 1) / d
function ceil(f : frac) : int = switch(f)
Pos(n, d) => (n + d - 1) / d
Zero => 0
Neg(n, d) => -n / d
function round_to_zero(f : frac) : int = switch(f)
Pos(n, d) => n / d
Zero => 0
Neg(n, d) => -n / d
function round_from_zero(f : frac) : int = switch(f)
Pos(n, d) => (n + d - 1) / d
Zero => 0
Neg(n, d) => -(n + d - 1) / d
/** Round towards nearest integer. If two integers are in the same
* distance, choose the even one.
*/
function round(f : frac) : int =
let fl = floor(f)
let cl = ceil(f)
let dif_fl = abs(sub(f, from_int(fl)))
let dif_cl = abs(sub(f, from_int(cl)))
if (gt(dif_fl, dif_cl)) cl
elif (gt(dif_cl, dif_fl)) fl
elif (fl mod 2 == 0) fl
else cl
function add(a : frac, b : frac) : frac =
let (na, da) = to_pair(a)
let (nb, db) = to_pair(b)
if (da == db) make_frac(na + nb, da)
else make_frac(na * db + nb * da, da * db)
function neg(a : frac) : frac = switch(a)
Neg(n, d) => Pos(n, d)
Zero => Zero
Pos(n, d) => Neg(n, d)
function sub(a : frac, b : frac) : frac = add(a, neg(b))
function inv(a : frac) : frac = switch(a)
Neg(n, d) => Neg(d, n)
Zero => abort("Inversion of zero")
Pos(n, d) => Pos(d, n)
function mul(a : frac, b : frac) : frac = make_frac(num(a) * num(b), den(a) * den(b))
function div(a : frac, b : frac) : frac = switch(b)
Neg(n, d) => mul(a, Neg(d, n))
Zero => abort("Division by zero")
Pos(n, d) => mul(a, Pos(d, n))
/** `b` to the power of `e`
*/
function int_exp(b : frac, e : int) : frac =
if (sign(b) == 0 && e == 0) abort("Zero to the zero exponentation")
elif (e < 0) inv(int_exp_(b, -e))
else int_exp_(b, e)
private function int_exp_(b : frac, e : int) =
if (e == 0) from_int(1)
elif (e == 1) b
else
let half = int_exp_(b, e / 2)
if (e mod 2 == 1) mul(mul(half, half), b)
else mul(half, half)
/** Reduces the fraction's in-memory size by dividing its components by two until the
* the error is bigger than `loss` value
*/
function optimize(f : frac, loss : frac) : frac =
require(geq(loss, Zero), "negative loss optimize")
let s = sign(f)
mul(from_int(s), run_optimize(abs(f), abs(f), loss))
private function run_optimize(orig : frac, f : frac, loss : frac) : frac =
let (n, d) = to_pair(f)
let t = make_frac((n+1)/2, (d+1)/2)
if(gt(abs(sub(t, orig)), loss)) f
elif (eq(t, f)) f
else run_optimize(orig, t, loss)
+41 -10
View File
@@ -12,35 +12,66 @@ namespace Func =
function rapply(x : 'a, f : 'a => 'b) : 'b = f(x)
/* The Z combinator - replacement for local and anonymous recursion.
*/
/** The Z combinator - replacement for local and anonymous recursion.
*/
function recur(f : ('arg => 'res, 'arg) => 'res) : 'arg => 'res =
(x) => f(recur(f), x)
/** n-times composition with itself
*/
function iter(n : int, f : 'a => 'a) : 'a => 'a = iter_(n, f, (x) => x)
private function iter_(n : int, f : 'a => 'a, acc : 'a => 'a) : 'a => 'a =
if(n == 0) acc
elif(n == 1) comp(f, acc)
else iter_(n / 2, comp(f, f), if(n mod 2 == 0) acc else comp(f, acc))
function curry2(f : ('a, 'b) => 'c) : 'a => ('b => 'c) =
/** Turns an ugly, bad and disgusting arity-n function into
* a beautiful and sweet function taking the first argument
* and returning a function watiting for the remaining ones
* in the same manner
*/
function curry2(f : ('a, 'b) => 'x) : 'a => ('b => 'x) =
(x) => (y) => f(x, y)
function curry3(f : ('a, 'b, 'c) => 'd) : 'a => ('b => ('c => 'd)) =
function curry3(f : ('a, 'b, 'c) => 'x) : 'a => ('b => ('c => 'x)) =
(x) => (y) => (z) => f(x, y, z)
function curry4(f : ('a, 'b, 'c, 'd) => 'x) : 'a => ('b => ('c => ('d => 'x))) =
(x) => (y) => (z) => (w) => f(x, y, z, w)
function curry5(f : ('a, 'b, 'c, 'd, 'e) => 'x) : 'a => ('b => ('c => ('d => ('e => 'x)))) =
(x) => (y) => (z) => (w) => (q) => f(x, y, z, w, q)
function uncurry2(f : 'a => ('b => 'c)) : ('a, 'b) => 'c =
/** Opposite of curry. Gross
*/
function uncurry2(f : 'a => ('b => 'x)) : ('a, 'b) => 'x =
(x, y) => f(x)(y)
function uncurry3(f : 'a => ('b => ('c => 'd))) : ('a, 'b, 'c) => 'd =
function uncurry3(f : 'a => ('b => ('c => 'x))) : ('a, 'b, 'c) => 'x =
(x, y, z) => f(x)(y)(z)
function uncurry4(f : 'a => ('b => ('c => ('d => 'x)))) : ('a, 'b, 'c, 'd) => 'x =
(x, y, z, w) => f(x)(y)(z)(w)
function uncurry5(f : 'a => ('b => ('c => ('d => ('e => 'x))))) : ('a, 'b, 'c, 'd, 'e) => 'x =
(x, y, z, w, q) => f(x)(y)(z)(w)(q)
function tuplify2(f : ('a, 'b) => 'c) : (('a * 'b)) => 'c =
/** Turns an arity-n function into a function taking n-tuple
*/
function tuplify2(f : ('a, 'b) => 'x) : (('a * 'b)) => 'x =
(t) => switch(t)
(x, y) => f(x, y)
function tuplify3(f : ('a, 'b, 'c) => 'd) : 'a * 'b * 'c => 'd =
function tuplify3(f : ('a, 'b, 'c) => 'x) : 'a * 'b * 'c => 'x =
(t) => switch(t)
(x, y, z) => f(x, y, z)
function tuplify4(f : ('a, 'b, 'c, 'd) => 'x) : 'a * 'b * 'c * 'd => 'x =
(t) => switch(t)
(x, y, z, w) => f(x, y, z, w)
function tuplify5(f : ('a, 'b, 'c, 'd, 'e) => 'x) : 'a * 'b * 'c * 'd * 'e => 'x =
(t) => switch(t)
(x, y, z, w, q) => f(x, y, z, w, q)
function untuplify2(f : 'a * 'b => 'c) : ('a, 'b) => 'c =
/** Opposite of tuplify
*/
function untuplify2(f : 'a * 'b => 'x) : ('a, 'b) => 'x =
(x, y) => f((x, y))
function untuplify3(f : 'a * 'b * 'c => 'd) : ('a, 'b, 'c) => 'd =
function untuplify3(f : 'a * 'b * 'c => 'x) : ('a, 'b, 'c) => 'x =
(x, y, z) => f((x, y, z))
function untuplify4(f : 'a * 'b * 'c * 'd => 'x) : ('a, 'b, 'c, 'd) => 'x =
(x, y, z, w) => f((x, y, z, w))
function untuplify5(f : 'a * 'b * 'c * 'd * 'e => 'x) : ('a, 'b, 'c, 'd, 'e) => 'x =
(x, y, z, w, q) => f((x, y, z, w, q))
+44 -14
View File
@@ -28,10 +28,15 @@ namespace List =
h::t => h::drop_last_unsafe(t)
[] => abort("drop_last_unsafe: list empty")
/** Finds first element of `l` fulfilling predicate `p` as `Some` or `None`
* if no such element exists.
*/
function find(p : 'a => bool, l : list('a)) : option('a) = switch(l)
[] => None
h::t => if(p(h)) Some(h) else find(p, t)
/** Returns list of all indices of elements from `l` that fulfill the predicate `p`.
*/
function find_indices(p : 'a => bool, l : list('a)) : list(int) = find_indices_(p, l, 0)
private function find_indices_( p : 'a => bool
, l : list('a)
@@ -60,8 +65,15 @@ namespace List =
_::t => length_(t, acc + 1)
/** Creates an ascending sequence of all integer numbers
* between `a` and `b` (including `a` and `b`)
*/
function from_to(a : int, b : int) : list(int) = [a..b]
/** Creates an ascending sequence of integer numbers betweeen
* `a` and `b` jumping by given `step`. Includes `a` and takes
* `b` only if `(b - a) mod step == 0`. `step` should be bigger than 0.
*/
function from_to_step(a : int, b : int, s : int) : list(int) =
from_to_step_(a, b - (b-a) mod s, s, [])
private function from_to_step_(a : int, b : int, s : int, acc : list(int)) : list(int) =
@@ -69,8 +81,8 @@ namespace List =
else from_to_step_(a, b - s, s, b::acc)
/* Unsafe. Replaces `n`th element of `l` with `e`. Crashes on over/underflow */
/** Unsafe. Replaces `n`th element of `l` with `e`. Crashes on over/underflow
*/
function replace_at(n : int, e : 'a, l : list('a)) : list('a) =
if(n<0) abort("insert_at underflow") else replace_at_(n, e, l)
private function replace_at_(n : int, e : 'a, l : list('a)) : list('a) =
@@ -79,7 +91,8 @@ namespace List =
h::t => if (n == 0) e::t
else h::replace_at_(n-1, e, t)
/* Unsafe. Adds `e` to `l` to be its `n`th element. Crashes on over/underflow */
/** Unsafe. Adds `e` to `l` to be its `n`th element. Crashes on over/underflow
*/
function insert_at(n : int, e : 'a, l : list('a)) : list('a) =
if(n<0) abort("insert_at underflow") else insert_at_(n, e, l)
private function insert_at_(n : int, e : 'a, l : list('a)) : list('a) =
@@ -88,6 +101,9 @@ namespace List =
[] => abort("insert_at overflow")
h::t => h::insert_at_(n-1, e, t)
/** Assuming that cmp represents `<` comparison, inserts `x` before
* the first element in the list `l` which is greater than it
*/
function insert_by(cmp : (('a, 'a) => bool), x : 'a, l : list('a)) : list('a) =
switch(l)
[] => [x]
@@ -122,6 +138,8 @@ namespace List =
[] => []
h::t => f(h)::map(f, t)
/** Effectively composition of `map` and `flatten`
*/
function flat_map(f : 'a => list('b), l : list('a)) : list('b) =
ListInternal.flat_map(f, l)
@@ -131,7 +149,8 @@ namespace List =
let rest = filter(p, t)
if(p(h)) h::rest else rest
/* Take up to `n` first elements */
/** Take up to `n` first elements
*/
function take(n : int, l : list('a)) : list('a) =
if(n < 0) abort("Take negative number of elements") else take_(n, l)
private function take_(n : int, l : list('a)) : list('a) =
@@ -140,7 +159,8 @@ namespace List =
[] => []
h::t => h::take_(n-1, t)
/* Drop up to `n` first elements */
/** Drop up to `n` first elements
*/
function drop(n : int, l : list('a)) : list('a) =
if(n < 0) abort("Drop negative number of elements") else drop_(n, l)
private function drop_(n : int, l : list('a)) : list('a) =
@@ -149,17 +169,22 @@ namespace List =
[] => []
h::t => drop_(n-1, t)
/* Get the longest prefix of a list in which every element matches predicate `p` */
/** Get the longest prefix of a list in which every element
* matches predicate `p`
*/
function take_while(p : 'a => bool, l : list('a)) : list('a) = switch(l)
[] => []
h::t => if(p(h)) h::take_while(p, t) else []
/* Drop elements from `l` until `p` holds */
/** Drop elements from `l` until `p` holds
*/
function drop_while(p : 'a => bool, l : list('a)) : list('a) = switch(l)
[] => []
h::t => if(p(h)) drop_while(p, t) else l
/* Splits list into two lists of elements that respectively match and don't match predicate `p` */
/** Splits list into two lists of elements that respectively
* match and don't match predicate `p`
*/
function partition(p : 'a => bool, l : list('a)) : (list('a) * list('a)) = switch(l)
[] => ([], [])
h::t =>
@@ -183,7 +208,9 @@ namespace List =
function product(l : list(int)) : int = foldl((a, b) => a * b, 1, l)
/* Zips two list by applying bimapping function on respective elements. Drops longer tail. */
/** Zips two list by applying bimapping function on respective elements.
* Drops the tail of the longer list.
*/
private function zip_with( f : ('a, 'b) => 'c
, l1 : list('a)
, l2 : list('b)
@@ -191,7 +218,9 @@ namespace List =
(h1::t1, h2::t2) => f(h1, h2)::zip_with(f, t1, t2)
_ => []
/* Zips two lists into list of pairs. Drops longer tail. */
/** Zips two lists into list of pairs.
* Drops the tail of the longer list.
*/
function zip(l1 : list('a), l2 : list('b)) : list('a * 'b) = zip_with((a, b) => (a, b), l1, l2)
function unzip(l : list('a * 'b)) : (list('a) * list('b)) = switch(l)
@@ -207,15 +236,16 @@ namespace List =
h::t => switch (partition((x) => lesser_cmp(x, h), t))
(lesser, bigger) => sort(lesser_cmp, lesser) ++ h::sort(lesser_cmp, bigger)
/** Puts `delim` between every two members of the list
*/
function intersperse(delim : 'a, l : list('a)) : list('a) = switch(l)
[] => []
[e] => [e]
h::t => h::delim::intersperse(delim, t)
/** Effectively a zip with an infinite sequence of natural numbers
*/
function enumerate(l : list('a)) : list(int * 'a) = enumerate_(l, 0)
private function enumerate_(l : list('a), n : int) : list(int * 'a) = switch(l)
[] => []
h::t => (n, h)::enumerate_(t, n + 1)
h::t => (n, h)::enumerate_(t, n + 1)
+20 -2
View File
@@ -10,13 +10,18 @@ namespace Option =
None => false
Some(_) => true
/** Catamorphism on `option`. Also known as inlined pattern matching.
*/
function match(n : 'b, s : 'a => 'b, o : option('a)) : 'b = switch(o)
None => n
Some(x) => s(x)
/** Escape option providing default if `None`
*/
function default(def : 'a, o : option('a)) : 'a = match(def, (x) => x, o)
/** Assume it is `Some`
*/
function force(o : option('a)) : 'a = default(abort("Forced None value"), o)
function on_elem(o : option('a), f : 'a => unit) : unit = match((), f, o)
@@ -40,10 +45,14 @@ namespace Option =
(Some(x1), Some(x2), Some(x3)) => Some(f(x1, x2, x3))
_ => None
/** Like `map`, but the function is in `option`
*/
function app_over(f : option ('a => 'b), o : option('a)) : option('b) = switch((f, o))
(Some(ff), Some(xx)) => Some(ff(xx))
_ => None
/** Monadic bind
*/
function flat_map(f : 'a => option('b), o : option('a)) : option('b) = switch(o)
None => None
Some(x) => f(x)
@@ -53,11 +62,17 @@ namespace Option =
None => []
Some(x) => [x]
/** Turns list of options into a list of elements that are under `Some`s.
* Safe.
*/
function filter_options(l : list(option('a))) : list('a) = switch(l)
[] => []
None::t => filter_options(t)
Some(x)::t => x::filter_options(t)
/** Just like `filter_options` but requires all elements to be `Some` and returns
* None if any of them is not
*/
function seq_options(l : list (option('a))) : option (list('a)) = switch(l)
[] => Some([])
None::_ => None
@@ -66,11 +81,14 @@ namespace Option =
Some(st) => Some(x::st)
/** Choose `Some` out of two if possible
*/
function choose(o1 : option('a), o2 : option('a)) : option('a) =
if(is_some(o1)) o1 else o2
/** Choose `Some` from list of options if possible
*/
function choose_first(l : list(option('a))) : option('a) = switch(l)
[] => None
None::t => choose_first(t)
Some(x)::_ => Some(x)
+6
View File
@@ -6,12 +6,18 @@ namespace Pair =
function snd(t : ('a * 'b)) : 'b = switch(t)
(_, y) => y
/** Map over first
*/
function map1(f : 'a => 'c, t : ('a * 'b)) : ('c * 'b) = switch(t)
(x, y) => (f(x), y)
/** Map over second
*/
function map2(f : 'b => 'c, t : ('a * 'b)) : ('a * 'c) = switch(t)
(x, y) => (x, f(y))
/** Map over both
*/
function bimap(f : 'a => 'c, g : 'b => 'd, t : ('a * 'b)) : ('c * 'd) = switch(t)
(x, y) => (f(x), g(y))
+12
View File
@@ -10,15 +10,23 @@ namespace Triple =
(_, _, z) => z
/** Map over first
*/
function map1(f : 'a => 'm, t : ('a * 'b * 'c)) : ('m * 'b * 'c) = switch(t)
(x, y, z) => (f(x), y, z)
/** Map over second
*/
function map2(f : 'b => 'm, t : ('a * 'b * 'c)) : ('a * 'm * 'c) = switch(t)
(x, y, z) => (x, f(y), z)
/** Map over third
*/
function map3(f : 'c => 'm, t : ('a * 'b * 'c)) : ('a * 'b * 'm) = switch(t)
(x, y, z) => (x, y, f(z))
/** Map over all elements
*/
function trimap( f : 'a => 'x
, g : 'b => 'y
, h : 'c => 'z
@@ -29,9 +37,13 @@ namespace Triple =
function swap(t : ('a * 'b * 'c)) : ('c * 'b * 'a) = switch(t)
(x, y, z) => (z, y, x)
/** Right rotation
*/
function rotr(t : ('a * 'b * 'c)) : ('c * 'a * 'b) = switch(t)
(x, y, z) => (z, x, y)
/** Left rotation
*/
function rotl(t : ('a * 'b * 'c)) : ('b * 'c * 'a) = switch(t)
(x, y, z) => (y, z, x)