horse/prob: first pass on P(A xor B)

horse/prob/kfl.kk

@@ -0,0 +1,158 @@
+module horse/prob/kfl
+
+// kfl is a semiring of probabilities formed by vibes.
+pub type kfl
+  // Effectively if not literally impossible events.
+  Impossible
+  // Not worth aiming for, but can technically still happen.
+  Probably-Not
+  // You expect it not to happen most of the time, but it might still be worth
+  // trying for it if you're being forced to play to your outs.
+  Doubtful
+  // More likely that it won't happen, but a success isn't surprising.
+  Unlikely
+  // Either it does or it doesn't.
+  Mayhapsibly
+  // Decent chance it doesn't happen, but you still expect it to.
+  Probably
+  // You expect it to happen most of the time, but accept that there will be failures.
+  Most-Likely
+  // Very close to guaranteed, but technically with a small chance to fail.
+  Cry-If-Not
+  // Absolutely guaranteed events.
+  Guaranteed
+
+// Automatically generated.
+// Comparison of the `kfl` type.
+pub fun cmp(this : kfl, other : kfl) : e order
+  match (this, other)
+    (Impossible, Impossible) -> Eq
+    (Impossible, _) -> Lt
+    (_, Impossible) -> Gt
+    (Probably-Not, Probably-Not) -> Eq
+    (Probably-Not, _) -> Lt
+    (_, Probably-Not) -> Gt
+    (Doubtful, Doubtful) -> Eq
+    (Doubtful, _) -> Lt
+    (_, Doubtful) -> Gt
+    (Unlikely, Unlikely) -> Eq
+    (Unlikely, _) -> Lt
+    (_, Unlikely) -> Gt
+    (Mayhapsibly, Mayhapsibly) -> Eq
+    (Mayhapsibly, _) -> Lt
+    (_, Mayhapsibly) -> Gt
+    (Probably, Probably) -> Eq
+    (Probably, _) -> Lt
+    (_, Probably) -> Gt
+    (Most-Likely, Most-Likely) -> Eq
+    (Most-Likely, _) -> Lt
+    (_, Most-Likely) -> Gt
+    (Cry-If-Not, Cry-If-Not) -> Eq
+    (Cry-If-Not, _) -> Lt
+    (_, Cry-If-Not) -> Gt
+    (Guaranteed, Guaranteed) -> Eq
+
+// Shows a string representation of the `kfl` type.
+pub fun show(this : kfl) : e string
+  match this
+    Impossible -> "impossible"
+    Probably-Not -> "probably not"
+    Doubtful -> "doubtful"
+    Unlikely -> "unlikely"
+    Mayhapsibly -> "mayhapsibly"
+    Probably -> "probably"
+    Most-Likely -> "most likely"
+    Cry-If-Not -> "cry if not"
+    Guaranteed -> "guaranteed"
+
+// KFL multiplication, or the probability of cooccurrence of two independent events.
+pub fun (*)(a: kfl, b: kfl): e kfl
+  val (l, h) = match a.cmp(b) // this operation is commutative
+    Gt -> (b, a)
+    _ -> (a, b)
+  match (l, h)
+    (r, Guaranteed) -> r // factor out Guaranteed cases
+    (Impossible, _) -> Impossible
+    (Probably-Not, _) -> Impossible
+    (r, Cry-If-Not) -> r // factor out further Cry-If-Not cases
+    (Doubtful, Most-Likely) -> Probably-Not
+    (Doubtful, _) -> Impossible
+    (Unlikely, Most-Likely) -> Doubtful
+    (Unlikely, Probably) -> Doubtful
+    (Unlikely, Mayhapsibly) -> Probably-Not
+    (Unlikely, _) -> Probably-Not // (Unlikely, Unlikely) because commutative
+    (Mayhapsibly, Most-Likely) -> Unlikely
+    (Mayhapsibly, Probably) -> Unlikely
+    (Mayhapsibly, _) -> Unlikely
+    (Probably, Most-Likely) -> Mayhapsibly
+    (Probably, _) -> Unlikely
+    (Most-Likely, _) -> Probably
+    // These two are only needed because the type system doesn't understand commutativity.
+    (Cry-If-Not, _) -> Cry-If-Not
+    (Guaranteed, _) -> Guaranteed
+
+// KFL addition, or the probability of occurrence of at least one of two independent events.
+pub fun (+)(a: kfl, b: kfl): e kfl
+  val (l, h) = match a.cmp(b) // this operation is commutative
+    Gt -> (b, a)
+    _ -> (a, b)
+  match (l, h)
+    // Cases with _ on the right are (a, a) due to commutativity.
+    // Cases with _ on the left simplify later cases that all absorb to the right.
+    (Guaranteed, _) -> Guaranteed
+    (_, Guaranteed) -> Guaranteed
+    (Cry-If-Not, _) -> Guaranteed
+    (Most-Likely, Cry-If-Not) -> Cry-If-Not
+    (Most-Likely, _) -> Cry-If-Not
+    (_, Cry-If-Not) -> Cry-If-Not
+    (Probably, Most-Likely) -> Cry-If-Not
+    (Probably, _) -> Most-Likely
+    (_, Most-Likely) -> Most-Likely
+    (Mayhapsibly, Probably) -> Most-Likely
+    (Mayhapsibly, _) -> Probably
+    (Unlikely, Probably) -> Most-Likely
+    (Unlikely, Mayhapsibly) -> Probably
+    (Unlikely, _) -> Mayhapsibly
+    (_, Probably) -> Probably
+    (Doubtful, Mayhapsibly) -> Probably
+    (Doubtful, Unlikely) -> Mayhapsibly
+    (Doubtful, _) -> Unlikely
+    (_, Mayhapsibly) -> Mayhapsibly
+    (_, Unlikely) -> Unlikely
+    (Probably-Not, Doubtful) -> Unlikely
+    (Probably-Not, _) -> Probably-Not
+    (_, Doubtful) -> Doubtful
+    (_, Probably-Not) -> Probably-Not
+    (_, Impossible) -> Impossible
+
+// KFL union, or the probability of occurrence of exactly one of two independent events.
+pub fun either(a: kfl, b: kfl): e kfl
+  val (l, h) = match a.cmp(b) // this operation is commutative
+    Gt -> (b, a)
+    _ -> (a, b)
+  match (l, h)
+    (Impossible, r) -> r
+    (Probably-Not, Guaranteed) -> Cry-If-Not
+    (Probably-Not, r) -> r
+    (Doubtful, Guaranteed) -> Most-Likely
+    (Doubtful, Cry-If-Not) -> Most-Likely
+    (Doubtful, Most-Likely) -> Probably
+    (Doubtful, Probably) -> Mayhapsibly
+    (Doubtful, Mayhapsibly) -> Mayhapsibly
+    (Doubtful, Unlikely) -> Mayhapsibly
+    (Doubtful, _) -> Unlikely
+    (Unlikely, Guaranteed) -> Probably
+    (Unlikely, Cry-If-Not) -> Mayhapsibly
+    (Unlikely, Most-Likely) -> Mayhapsibly
+    (Unlikely, _) -> Probably
+    (Mayhapsibly, Guaranteed) -> Mayhapsibly
+    (Mayhapsibly, Cry-If-Not) -> Mayhapsibly
+    (Mayhapsibly, Most-Likely) -> Mayhapsibly
+    (Mayhapsibly, _) -> Probably
+    (Probably, Guaranteed) -> Unlikely
+    (Probably, Cry-If-Not) -> Unlikely
+    (Probably, Most-Likely) -> Unlikely
+    (Probably, _) -> Mayhapsibly
+    (Most-Likely, _) -> Doubtful
+    (Cry-If-Not, _) -> Probably-Not
+    (Guaranteed, _) -> Impossible

horse/prob/pmf.kk

@@ -0,0 +1,36 @@
+module horse/prob/pmf
+
+import std/core/list
+
+// Discrete-support probability distribution implemented as a list with the invariant
+// that support is always given in increasing order.
+pub type pmf<s, v>
+  Event(s: s, v: v, next: pmf<s, v>)
+  End
+
+// Add an independent event to the distribution.
+pub fun add(p: pmf<s, v>, s: s, v: v, ?s/cmp: (a: s, b: s) -> order, ?v/(+): (new: v, old: v) -> e v): e pmf<s, v>
+  match p
+    End -> Event(s, v, End)
+    Event(s', v', next) -> match s.cmp(s')
+      Lt -> Event(s, v, Event(s', v', next))
+      Eq -> Event(s, v + v', next)
+      Gt -> Event(s', v', add(next, s, v))
+
+// Replace an event in the distribution.
+pub inline fun set(p: pmf<s, v>, s: s, v: v, ?s/cmp: (a: s, b: s) -> order): e pmf<s, v>
+  p.add(s, v, cmp, fn(new, old) new)
+
+// Construct a pmf from a list of (support, value) entries.
+pub fun list/pmf(l: list<(s, v)>, ?s/cmp: (a: s, b: s) -> order, ?v/(+): (new: v, old: v) -> e v): e pmf<s, v>
+  l.foldl(End) fn(p, (s, v)) p.add(s, v)
+
+// Fold over the entries of the distribution.
+pub tail fun foldl(p: pmf<s, v>, init: a, f: (a, s, v) -> e a): e a
+  match p
+    End -> init
+    Event(s, v, next) -> foldl(next, f(init, s, v), f)
+
+// Convert the distribution to a list of entries.
+pub fun pmf/list(p: pmf<s, v>): list<(s, v)>
+  p.foldl(Nil) fn(l, s, v) Cons((s, v), l)