horse: implement inheritance

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

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

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
+  uma: uma-id
-  stat: spark<stat>
+  sparks: list<spark-id>
-  aptitude: spark<aptitude>
-  unique: maybe<spark<unique>>
-  generic: list<spark<generic>>
   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)

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")

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
+pub fun decimal/base-proc(id: spark-id, ?spark-type: (spark-id) -> spark-type, ?rarity: (spark-id) -> rarity): decimal
-  match s
+  val t = id.spark-type
-    Spark-detail(_, Stat, One) -> 70.decimal(-2)
+  val r = id.rarity
-    Spark-detail(_, Stat, Two) -> 80.decimal(-2)
+  match (t, r)
-    Spark-detail(_, Stat, Three) -> 90.decimal(-2)
+    (Stat, One) -> 70.decimal(-2)
-    Spark-detail(_, Aptitude, One) -> 1.decimal(-2)
+    (Stat, Two) -> 80.decimal(-2)
-    Spark-detail(_, Aptitude, Two) -> 3.decimal(-2)
+    (Stat, Three) -> 90.decimal(-2)
-    Spark-detail(_, Aptitude, Three) -> 5.decimal(-2)
+    (Aptitude, One) -> 1.decimal(-2)
-    Spark-detail(_, Unique, One) -> 5.decimal(-2)
+    (Aptitude, Two) -> 3.decimal(-2)
-    Spark-detail(_, Unique, Two) -> 10.decimal(-2)
+    (Aptitude, Three) -> 5.decimal(-2)
-    Spark-detail(_, Unique, Three) -> 15.decimal(-2)
+    (Unique, One) -> 5.decimal(-2)
-    Spark-detail(_, Race, One) -> 1.decimal(-2)
+    (Unique, Two) -> 10.decimal(-2)
-    Spark-detail(_, Race, Two) -> 2.decimal(-2)
+    (Unique, Three) -> 15.decimal(-2)
-    Spark-detail(_, Race, Three) -> 3.decimal(-2)
+    (Race, One) -> 1.decimal(-2)
-    Spark-detail(_, _, One) -> 3.decimal(-2)
+    (Race, Two) -> 2.decimal(-2)
-    Spark-detail(_, _, Two) -> 6.decimal(-2)
+    (Race, Three) -> 3.decimal(-2)
-    Spark-detail(_, _, Three) -> 9.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

test/example.kk

@@ -0,0 +1,293 @@
+module test/example
+
+import std/num/decimal
+import std/data/linearmap
+import horse/game-id
+import horse/global
+import horse/global/character
+import horse/global/saddle
+import horse/global/skill
+import horse/global/spark
+import horse/global/uma
+import horse/legacy
+
+val p1 = Legacy(
+  uma = Veteran(
+    uma = Uma-id(102001), // seiun sky
+    sparks = [
+      301, // 1* power
+      2102, // 2* front runner
+      10200103, // 3* angling and scheming
+      1000302, // 2* osaka hai
+      1001001, // 1* japanese derby
+      1001101, // 1* yasuda kinen
+      1001701, // 1* qe2
+      2001402, // 2* non-standard distance
+      2004301, // 1* focus
+      2005301, // 1* early lead
+      2012401, // 1* front runner straightaways
+      2012502, // 2* front runner corners
+      2015201, // 1* front runner savvy
+      2016001, // 1* groundwork
+      2016102, // 2* thh
+      2016402, // 2* lone wolf
+      3000201, // 1* unity cup
+    ].map(Spark-id(_)),
+    saddles = [
+      1, // classic triple crown
+      2, // senior autumn triple crown
+      4, // senior spring triple crown
+      5, // tenno sweep
+      6, // dual grand prix
+      7, // dual miles
+      10, // arima kinen
+      11, // japan cup
+      12, // derby
+      13, // tss
+      14, // takarazuka kinen
+      15, // tsa
+      16, // kikuka sho
+      17, // osaka hai
+      18, // satsuki sho
+      21, // yasuda kinen
+      23, // mile championship
+      25, // victoria mile
+      26, // qe2
+      33, // asahi hai fs
+      34, // hopeful stakes
+      96, // mainichi hai
+    ].map(Saddle-id(_))
+  ),
+  sub1 = Veteran(
+    uma = Uma-id(102601), // mihono bourbon
+    sparks = [
+      302, // 2* power
+      3303, // 3* medium
+      10260102, // 2* g00 1st
+      1001201, // 1* takarazuka kinen
+      1001702, // 2* qe2
+      1001901, // 1* japan cup
+      2004302, // 2* focus
+      2004502, // 2* prudent positioning
+      2012502, // 2* front corners
+      2015202, // 2* front savvy
+      2016002, // 2* groundwork
+      2016401, // 1* lone wolf
+      3000201, // 1* unity cup
+    ].map(Spark-id(_)),
+    saddles = [
+      2, // senior autumn triple crown
+      6, // dual grand prix
+      7, // dual miles
+      10, // arima kinen
+      11, // japan cup
+      12, // derby
+      14, // takarazuka kinen
+      15, // tsa
+      17, // osaka hai
+      18, // satsuki sho
+      21, // yasuda kinen
+      23, // mile championship
+      25, // victoria mile
+      26, // qe2
+      27, // nhk mile cup
+      33, // asahi hai fs
+      34, // hopeful stakes
+      49, // spring stakes
+    ].map(Saddle-id(_))
+  ),
+  sub2 = Veteran(
+    uma = Uma-id(102401), // mayano top gun
+    sparks = [
+      302, // 2* power
+      1103, // 3* turf
+      10240101, // 1* flashy landing
+      1000601, // 1* tss
+      1001202, // 2* takarazuka kinen
+      1001502, // 2* kikuka sho
+      1001601, // 1* tsa
+      1002102, // 2* hanshin jf
+      1002301, // 1* arima kinen
+      2003503, // 3* corner recovery
+      2003802, // 2* straightaway recovery
+      2004602, // 2* ramp up
+      2005502, // 2* final push
+      2012702, // 2* leader's pride
+      2016002, // 2* groundwork
+      3000102, // 2* ura finale
+    ].map(Spark-id(_)),
+    saddles = [
+      1, // classic triple crown
+      2, // senior autumn triple crown
+      4, // senior spring triple crown
+      5, // tenno sweep
+      6, // dual grand prix
+      7, // dual miles
+      10, // arima kinen
+      11, // japan cup
+      12, // derby
+      13, // tss
+      14, // takarazuka kinen
+      15, // tsa
+      16, // kikuka sho
+      18, // satsuki sho
+      21, // yasuda kinen
+      23, // mile championship
+      25, // victoria mile
+      26, // qe2
+      34, // hopeful stakes
+      35, // hanshin jf
+    ].map(Saddle-id(_))
+  )
+)
+
+val p2 = Legacy(
+  uma = Veteran(
+    uma = Uma-id(100201), // silence suzuka
+    sparks = [
+      202, // 2* stamina
+      3301, // 1* medium
+      10020101, // 1* view from the lead
+      1000302, // 2* osaka hai
+      1001201, // 1* takarazuka kinen
+      1001502, // 2* kikuka sho
+      1001601, // 1* tsa
+      1002201, // 1* asahi hai fs
+      1002301, // 1* arima kinen
+      2003302, // 2* corner adept
+      2004302, // 2* focus
+      2004502, // 2* prudent positioning
+      2005301, // 1* early lead
+      2012602, // 2* dodging danger
+      2012802, // 2* moxie
+      2016002, // 2* groundwork
+    ].map(Spark-id(_)),
+    saddles = [
+      1, // classic triple crown
+      2, // senior autumn triple crown
+      6, // dual grand prix
+      10, // arima kinen
+      11, // japan cup
+      12, // derby
+      14, // takarazuka kinen
+      15, // tsa
+      16, // kikuka sho
+      17, // osaka hai
+      18, // satsuki sho
+      21, // yasuda kinen
+      25, // victoria mile
+      26, // qe2
+      33, // asahi hai fs
+      34, // hopeful stakes
+      45, // yayoi sho
+      46, // kinko sho
+      63, // kobe shimbun hai
+      65, // mainichi okan
+    ].map(Saddle-id(_))
+  ),
+  sub1 = Veteran(
+    uma = Uma-id(102001), // seiun sky
+    sparks = [
+      301, // 1* power
+      2102, // 2* front runner
+      10200103, // 3* angling and scheming
+      1000302, // 2* osaka hai
+      1001001, // 1* japanese derby
+      1001101, // 1* yasuda kinen
+      1001701, // 1* qe2
+      2001402, // 2* non-standard distance
+      2004301, // 1* focus
+      2005301, // 1* early lead
+      2012401, // 1* front runner straightaways
+      2012502, // 2* front runner corners
+      2015201, // 1* front runner savvy
+      2016001, // 1* groundwork
+      2016102, // 2* thh
+      2016402, // 2* lone wolf
+      3000201, // 1* unity cup
+    ].map(Spark-id(_)),
+    saddles = [
+      1, // classic triple crown
+      2, // senior autumn triple crown
+      4, // senior spring triple crown
+      5, // tenno sweep
+      6, // dual grand prix
+      7, // dual miles
+      10, // arima kinen
+      11, // japan cup
+      12, // derby
+      13, // tss
+      14, // takarazuka kinen
+      15, // tsa
+      16, // kikuka sho
+      17, // osaka hai
+      18, // satsuki sho
+      21, // yasuda kinen
+      23, // mile championship
+      25, // victoria mile
+      26, // qe2
+      33, // asahi hai fs
+      34, // hopeful stakes
+      96, // mainichi hai
+    ].map(Saddle-id(_))
+  ),
+  sub2 = Veteran(
+    uma = Uma-id(102601), // mihono bourbon
+    sparks = [
+      102, // 2* speed
+      3402, // 2* long
+      10260101, // 1* g00 1st
+      1000502, // 2* satsuki sho
+      1000701, // 1* nhk mile cup
+      1001201, // 1* takarazuka kinen
+      1001702, // 2* qe2
+      2000101, // 1* right-handed
+      2002102, // 2* sunny days
+      2004302, // 2* focus
+      2005301, // 1* early lead
+      2012502, // 2* front corners
+      2016001, // 1* groundwork
+    ].map(Spark-id(_)),
+    saddles = [
+      1, // classic triple crown
+      2, // senior autumn triple crown
+      6, // dual grand prix
+      10, // arima kinen
+      11, // japan cup
+      12, // derby
+      14, // takarazuka kinen
+      15, // tsa
+      16, // kikuka sho
+      17, // osaka hai
+      18, // satsuki sho
+      26, // qe2
+      27, // nhk mile cup
+      33, // asahi hai fs
+      49, // spring stakes
+    ].map(Saddle-id(_))
+  )
+)
+
+val trainee = Uma-id(102402) // wedding mayano
+
+pub fun main()
+  val p1a = parent-affinity(trainee, p1, p2.uma.uma)
+  val p2a = parent-affinity(trainee, p2, p1.uma.uma)
+  val (s11a, s12a) = sub-affinity(trainee, p1)
+  val (s21a, s22a) = sub-affinity(trainee, p2)
+  println("trainee: " ++ trainee.show)
+  println("p1: " ++ p1.uma.uma.show ++ " affinity " ++ p1a.show)
+  println("s1-1: " ++ p1.sub1.uma.show ++ " affinity " ++ s11a.show)
+  println("s1-2: " ++ p1.sub2.uma.show ++ " affinity " ++ s12a.show)
+  println("p2: " ++ p2.uma.uma.show ++ " affinity " ++ p1a.show)
+  println("s1-1: " ++ p2.sub1.uma.show ++ " affinity " ++ s21a.show)
+  println("s1-2: " ++ p2.sub2.uma.show ++ " affinity " ++ s22a.show)
+  val inspo = inspiration(trainee, p1, p2)
+  val s = inspiration-gives(inspo, legacy/skills)
+  val a = inspiration-gives(inspo, legacy/aptitudes)
+  println("\nskills:")
+  s.list.foreach() fn((skill, pmf))
+    println("  " ++ skill.show ++ ": " ++ pmf.show)
+  println("\naptitudes:")
+  a.list.foreach() fn((apt, pmf))
+    println("  " ++ apt.show ++ ": " ++ pmf.show)