horse: implement inheritance

2026-03-04 13:34:10 -05:00
parent cf814c6c72
commit 424f65dc8a
6 changed files with 512 additions and 25 deletions
--- a/horse/game-id.kk
+++ b/horse/game-id.kk
@@ -74,3 +74,7 @@ pub inline fun (==)(x: a, y: a, ?a/game-id: (a) -> game-id): bool
 // Check whether a game ID is valid, i.e. nonzero.
 pub inline fun is-valid(x: a, ?a/game-id: (a) -> game-id): bool
  x.game-id != 0
+
+// Construct an invalid game ID.
+pub inline fun default/game-id(): game-id
+  0
--- a/horse/global.kk
+++ b/horse/global.kk
@@ -0,0 +1,8 @@
+module horse/global
+
+import horse/game-id
+
+// Shared saddle affinity bonus.
+// `s` should be the complete list of all saddles shared between the veterans.
+pub fun saddle-bonus(s: list<saddle-id>): int
+  s.length
--- a/horse/legacy.kk
+++ b/horse/legacy.kk
@@ -1,18 +1,124 @@
 module horse/legacy

-import horse/character
+import std/num/decimal
+import std/data/linearmap
+import std/data/linearset
 import horse/game-id
-import horse/race
 import horse/spark
+import horse/prob/dist

+// A legacy, or parent and grandparents.
 pub struct legacy
  uma: veteran
-  parents: (veteran, veteran)
+  sub1: veteran
+  sub2: veteran

+// A veteran, or the result of a completed career.
 pub struct veteran
-  character: character-id
-  stat: spark<stat>
-  aptitude: spark<aptitude>
-  unique: maybe<spark<unique>>
-  generic: list<spark<generic>>
+  uma: uma-id
+  sparks: list<spark-id>
  saddles: list<saddle-id>
+
+// Get all saddles shared between two lists thereof.
+pub fun shared-saddles(a: list<saddle-id>, b: list<saddle-id>): list<saddle-id>
+  val sa: linearSet<saddle-id> = a.foldl(linear-set(Nil)) fn(s, id) if id.is-valid then s.add(id) else s
+  val c: linearSet<saddle-id> = b.foldl(linear-set(Nil)) fn(s, id) if sa.member(id) then s.add(id) else s
+  c.list
+
+// Get the individual affinity for a legacy.
+// Any invalid ID is treated as giving 0.
+pub fun parent-affinity(
+  trainee: uma-id,
+  legacy: legacy,
+  other-parent: uma-id,
+  ?character-id: (uma-id) -> character-id,
+  ?saddle-bonus: (list<saddle-id>) -> int,
+  ?pair-affinity: (a: character-id, b: character-id) -> int,
+  ?trio-affinity: (a: character-id, b: character-id, c: character-id) -> int
+): int
+  val t = trainee.character-id
+  val p1 = legacy.uma.uma.character-id
+  val s1 = legacy.sub1.uma.character-id
+  val s2 = legacy.sub2.uma.character-id
+  val p2 = other-parent.character-id
+  pair-affinity(t, p1) + pair-affinity(p1, p2)
+    + trio-affinity(t, p1, s1) + trio-affinity(t, p1, s2)
+    + saddle-bonus(shared-saddles(legacy.uma.saddles, legacy.sub1.saddles)) + saddle-bonus(shared-saddles(legacy.uma.saddles, legacy.sub2.saddles))
+
+// Get the individual affinities for a legacy's sub-legacies.
+// The first value is the legacy for the `legacy.sub1` and the second is for
+// `legacy.sub2`.
+// Any invalid ID is treated as giving 0.
+pub fun sub-affinity(
+  trainee: uma-id,
+  legacy: legacy,
+  ?character-id: (uma-id) -> character-id,
+  ?saddle-bonus: (list<saddle-id>) -> int,
+  ?trio-affinity: (a: character-id, b: character-id, c: character-id) -> int
+): (int, int)
+  val t = trainee.character-id
+  val p = legacy.uma.uma.character-id
+  val s1 = legacy.sub1.uma.character-id
+  val s2 = legacy.sub2.uma.character-id
+  val r1 = trio-affinity(t, p, s1) + saddle-bonus(shared-saddles(legacy.uma.saddles, legacy.sub1.saddles))
+  val r2 = trio-affinity(t, p, s2) + saddle-bonus(shared-saddles(legacy.uma.saddles, legacy.sub2.saddles))
+  (r1, r2)
+
+// Associate each spark with its actual chance to activate given an individual
+// affinity value and the possible effects when it does.
+pub fun uma/inspiration(l: list<spark-id>, affinity: int, ?spark-type: (spark-id) -> spark-type, ?rarity: (spark-id) -> rarity, ?effects: (spark-id) -> list<list<spark-effect>>): list<(spark-id, decimal, list<list<spark-effect>>)>
+  val a = decimal(1 + affinity, -2)
+  l.map() fn(id) (id, min(id.base-proc * a, 1.decimal), id.effects)
+
+// Get the complete list of effects that may occur in an inspiration event
+// and the respective probability of activation.
+// Duplicates, i.e. multiple veterans with the same spark, are preserved.
+pub fun inspiration(
+  trainee: uma-id,
+  parent1: legacy,
+  parent2: legacy,
+  ?character-id: (uma-id) -> character-id,
+  ?saddle-bonus: (list<saddle-id>) -> int,
+  ?pair-affinity: (a: character-id, b: character-id) -> int,
+  ?trio-affinity: (a: character-id, b: character-id, c: character-id) -> int,
+  ?spark-type: (spark-id) -> spark-type,
+  ?rarity: (spark-id) -> rarity,
+  ?effects: (spark-id) -> list<list<spark-effect>>
+): list<(spark-id, decimal, list<list<spark-effect>>)>
+  val p1a = parent-affinity(trainee, parent1, parent2.uma.uma)
+  val p2a = parent-affinity(trainee, parent2, parent1.uma.uma)
+  val (s11a, s12a) = sub-affinity(trainee, parent1)
+  val (s21a, s22a) = sub-affinity(trainee, parent2)
+  [
+    inspiration(parent1.uma.sparks, p1a),
+    inspiration(parent1.sub1.sparks, s11a),
+    inspiration(parent1.sub2.sparks, s12a),
+    inspiration(parent2.uma.sparks, p2a),
+    inspiration(parent2.sub1.sparks, s21a),
+    inspiration(parent2.sub2.sparks, s22a),
+  ].concat
+
+// Reduce a spark effect list to the skill it is able to give.
+pub fun skills(l: list<list<spark-effect>>): maybe<skill-id>
+  val r: linearSet<skill-id> = l.head(Nil).foldl(linear-set(Nil)) fn(s, eff)
+    match eff
+      Skill-Hint(id, _) -> s + id
+      _ -> s
+  r.list.head
+
+// Reduce a spark effect list to the aptitude it is able to give.
+pub fun aptitudes(l: list<list<spark-effect>>): maybe<aptitude>
+  val r: linearSet<aptitude> = l.head(Nil).foldl(linear-set(Nil)) fn(s, eff)
+    match eff
+      Aptitude-Up(apt) -> s + apt
+      _ -> s
+  r.list.head
+
+// Get the overall chance of each count of sparks, including zero, providing a
+// given type of effect activating in a single inspiration event.
+pub fun inspiration-gives(l: list<(spark-id, decimal, list<list<spark-effect>>)>, f: (list<list<spark-effect>>) -> maybe<a>, ?a/(==): (a, a) -> bool): linearMap<a, list<decimal>>
+  val m: linearMap<_, list<decimal>> = l.foldl(LinearMap(Nil)) fn(m, (_, p, eff))
+    match f(eff)
+      Nothing -> m
+      Just(a) -> m.map/update(a, [p]) fn(cur, pp) pp.append(cur)
+  m.map() fn(_, v) poisson-binomial(v)
--- a/horse/prob/dist.kk
+++ b/horse/prob/dist.kk
@@ -0,0 +1,22 @@
+module horse/prob/dist
+
+import std/num/decimal
+
+tail fun pb-step(pn: list<decimal>, pi: decimal, pmfkm1: decimal, pmf: list<decimal>, next: ctx<list<decimal>>): list<decimal>
+  trace("pb-step " ++ pn.show ++ " pi " ++ pi.show ++ " pmf " ++ pmf.show)
+  match pn
+    Nil -> next ++. Nil // final step overall
+    Cons(_, pp) -> match pmf
+      Cons(pmfk, pmf') ->
+        val next' = next ++ ctx Cons(pi * pmfkm1 + (1.decimal - pi) * pmfk, hole)
+        pb-step(pp, pi, pmfk, pmf', next')
+      Nil -> next ++. Cons(pi * pmfkm1, Nil) // last step of this iteration
+
+// Given `n` different Bernoulli processes with respective probabilities in `pn`,
+// find the distribution of `k` successes for `k` ranging from 0 to `n` inclusive.
+// The index in the result list corresponds to `k`.
+pub fun pmf/poisson-binomial(pn: list<decimal>): list<decimal>
+  pn.foldl([1.decimal]) fn(pmf, pi)
+    match pmf
+      Cons(pmf0, pmf') -> pb-step(pn, pi, pmf0, pmf', ctx Cons((1.decimal - pi) * pmf0, hole))
+      Nil -> impossible("fold started with non-empty pmf but got empty pmf")
--- a/horse/spark.kk
+++ b/horse/spark.kk
@@ -10,6 +10,9 @@ pub struct spark-detail
  typ: spark-type
  rarity: rarity

+pub fun detail(id: spark-id, ?spark/spark-type: (spark-id) -> spark-type, ?spark/rarity: (spark-id) -> rarity): spark-detail
+  Spark-detail(id, id.spark-type, id.rarity)
+
 pub fun spark-detail/show(s: spark-detail, ?spark/show: (spark-id) -> string): string
  s.spark-id.show ++ " " ++ "\u2605".repeat(s.rarity.int)

@@ -39,23 +42,25 @@ pub type spark-effect
  Stat-Cap-Up(s: stat, amount: int)

 // Get the base probability for a spark to trigger during a single inheritance.
-pub fun decimal/base-proc(s: spark-detail): decimal
-  match s
-    Spark-detail(_, Stat, One) -> 70.decimal(-2)
-    Spark-detail(_, Stat, Two) -> 80.decimal(-2)
-    Spark-detail(_, Stat, Three) -> 90.decimal(-2)
-    Spark-detail(_, Aptitude, One) -> 1.decimal(-2)
-    Spark-detail(_, Aptitude, Two) -> 3.decimal(-2)
-    Spark-detail(_, Aptitude, Three) -> 5.decimal(-2)
-    Spark-detail(_, Unique, One) -> 5.decimal(-2)
-    Spark-detail(_, Unique, Two) -> 10.decimal(-2)
-    Spark-detail(_, Unique, Three) -> 15.decimal(-2)
-    Spark-detail(_, Race, One) -> 1.decimal(-2)
-    Spark-detail(_, Race, Two) -> 2.decimal(-2)
-    Spark-detail(_, Race, Three) -> 3.decimal(-2)
-    Spark-detail(_, _, One) -> 3.decimal(-2)
-    Spark-detail(_, _, Two) -> 6.decimal(-2)
-    Spark-detail(_, _, Three) -> 9.decimal(-2)
+pub fun decimal/base-proc(id: spark-id, ?spark-type: (spark-id) -> spark-type, ?rarity: (spark-id) -> rarity): decimal
+  val t = id.spark-type
+  val r = id.rarity
+  match (t, r)
+    (Stat, One) -> 70.decimal(-2)
+    (Stat, Two) -> 80.decimal(-2)
+    (Stat, Three) -> 90.decimal(-2)
+    (Aptitude, One) -> 1.decimal(-2)
+    (Aptitude, Two) -> 3.decimal(-2)
+    (Aptitude, Three) -> 5.decimal(-2)
+    (Unique, One) -> 5.decimal(-2)
+    (Unique, Two) -> 10.decimal(-2)
+    (Unique, Three) -> 15.decimal(-2)
+    (Race, One) -> 1.decimal(-2)
+    (Race, Two) -> 2.decimal(-2)
+    (Race, Three) -> 3.decimal(-2)
+    (_, One) -> 3.decimal(-2)
+    (_, Two) -> 6.decimal(-2)
+    (_, Three) -> 9.decimal(-2)

 // The level or star count of a spark.
 pub type rarity
@@ -106,6 +111,55 @@ pub type aptitude
  Late-Surger
  End-Closer

+// Automatically generated.
+// Fip comparison of the `aptitude` type.
+pub fun aptitude/order2(this : aptitude, other : aptitude) : e order2<aptitude>
+  match (this, other)
+    (Turf, Turf) -> Eq2(Turf)
+    (Turf, other') -> Lt2(Turf, other')
+    (this', Turf) -> Gt2(Turf, this')
+    (Dirt, Dirt) -> Eq2(Dirt)
+    (Dirt, other') -> Lt2(Dirt, other')
+    (this', Dirt) -> Gt2(Dirt, this')
+    (Sprint, Sprint) -> Eq2(Sprint)
+    (Sprint, other') -> Lt2(Sprint, other')
+    (this', Sprint) -> Gt2(Sprint, this')
+    (Mile, Mile) -> Eq2(Mile)
+    (Mile, other') -> Lt2(Mile, other')
+    (this', Mile) -> Gt2(Mile, this')
+    (Medium, Medium) -> Eq2(Medium)
+    (Medium, other') -> Lt2(Medium, other')
+    (this', Medium) -> Gt2(Medium, this')
+    (Long, Long) -> Eq2(Long)
+    (Long, other') -> Lt2(Long, other')
+    (this', Long) -> Gt2(Long, this')
+    (Front-Runner, Front-Runner) -> Eq2(Front-Runner)
+    (Front-Runner, other') -> Lt2(Front-Runner, other')
+    (this', Front-Runner) -> Gt2(Front-Runner, this')
+    (Pace-Chaser, Pace-Chaser) -> Eq2(Pace-Chaser)
+    (Pace-Chaser, other') -> Lt2(Pace-Chaser, other')
+    (this', Pace-Chaser) -> Gt2(Pace-Chaser, this')
+    (Late-Surger, Late-Surger) -> Eq2(Late-Surger)
+    (Late-Surger, other') -> Lt2(Late-Surger, other')
+    (this', Late-Surger) -> Gt2(Late-Surger, this')
+    (End-Closer, End-Closer) -> Eq2(End-Closer)
+
+// Automatically generated.
+// Equality comparison of the `aptitude` type.
+pub fun aptitude/(==)(this : aptitude, other : aptitude) : e bool
+  match (this, other)
+    (Turf, Turf) -> True
+    (Dirt, Dirt) -> True
+    (Sprint, Sprint) -> True
+    (Mile, Mile) -> True
+    (Medium, Medium) -> True
+    (Long, Long) -> True
+    (Front-Runner, Front-Runner) -> True
+    (Pace-Chaser, Pace-Chaser) -> True
+    (Late-Surger, Late-Surger) -> True
+    (End-Closer, End-Closer) -> True
+    (_, _) -> False
+
 // Shows a string representation of the `aptitude` type.
 pub fun aptitude/show(this : aptitude): string
  match this