summaryrefslogtreecommitdiff
path: root/src/LivingVillage.Kernel.Tests/DeterminismTests.fs
blob: 0e1766ef83ee5d8491d9bc927382defac68d810b (plain)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
namespace LivingVillage.Kernel.Tests

open System
open Microsoft.VisualStudio.TestTools.UnitTesting
open LivingVillage.Kernel
open LivingVillage.Kernel.Sim

module private DriverHarness =

    let segmentTicks = 900L

    type Driver =
        { Rng: RngState
          Until: int64
          Input: Input }

    let zeroInput = { MoveX = 0.0f; MoveY = 0.0f }

    let nextSegment (rng: RngState) (until: int64) : Driver =
        let a, r1 = Rng.nextUInt64 rng
        let m, r2 = Rng.nextUInt64 r1
        let diag = 0.70710678f
        let dirX, dirY =
            match int (a &&& 7UL) with
            | 0 -> 1.0f, 0.0f
            | 1 -> diag, diag
            | 2 -> 0.0f, 1.0f
            | 3 -> -diag, diag
            | 4 -> -1.0f, 0.0f
            | 5 -> -diag, -diag
            | 6 -> 0.0f, -1.0f
            | _ -> diag, -diag
        let mag =
            match int (m % 3UL) with
            | 0 -> 0.4f
            | 1 -> 0.7f
            | _ -> 1.0f
        { Rng = r2
          Until = until + segmentTicks
          Input = { MoveX = dirX * mag; MoveY = dirY * mag } }

    let run (seed: uint64) (ticks: int64) : World list =
        let mutable world = Sim.initialWorld seed
        let mutable driver = { Rng = Rng.ofSeed seed; Until = segmentTicks; Input = zeroInput }
        let acc = ResizeArray<World> (int ticks + 1)
        acc.Add world
        for t in 1L .. ticks do
            let d, input =
                if t - 1L < driver.Until then driver, driver.Input
                else
                    let d = nextSegment driver.Rng driver.Until
                    d, d.Input
            driver <- d
            world <- Sim.step { Input = input } world
            acc.Add world
        List.ofSeq acc

[<TestClass>]
type DeterminismTests () =

    [<TestMethod>]
    member _.SameSeedSameInputSequenceTracesAreTickByTickEqual () =
        let a = DriverHarness.run 42UL 20000L
        let b = DriverHarness.run 42UL 20000L
        Assert.IsTrue(20001 = List.length a)
        CollectionAssert.AreEqual(Array.ofList a, Array.ofList b)

    [<TestMethod>]
    member _.DifferentSeedsProduceDivergentTraces () =
        let a = DriverHarness.run 42UL 20000L
        let b = DriverHarness.run 43UL 20000L
        let diverged =
            Seq.exists2 (fun (x: World) (y: World) -> x.Avatar.Pos <> y.Avatar.Pos) a b
        if not diverged then Assert.Fail("expected avatar positions to diverge across seeds")
        if a = b then Assert.Fail("expected whole traces to differ across seeds")

    [<TestMethod>]
    member _.StepIsPureAndDoesNotMutateItsInput () =
        let w = Sim.initialWorld 7UL
        let ts = { Input = { MoveX = 1.0f; MoveY = -0.5f } }
        let w1 = Sim.step ts w
        let w1' = Sim.step ts w
        if w1 <> w1' then Assert.Fail("step must be deterministic for identical (world, input)")
        Assert.IsTrue(w.Tick = 0L)
        Assert.IsTrue(w.Time = 0.0)
        Assert.IsTrue(w1.Tick = 1L)
        Assert.IsTrue(abs (w1.Time - Sim.dtSeconds) < 1e-12)

    [<TestMethod>]
    member _.WorldCarriesSeededRngState () =
        let a = Sim.initialWorld 42UL
        let b = Sim.initialWorld 43UL
        Assert.IsTrue(a.Rng.State = 42UL)
        Assert.IsTrue(b.Rng.State = 43UL)
        Assert.IsTrue(a <> b)

    [<TestMethod>]
    member _.LongRunStaysFiniteBoundedAndTimeTracksTicks () =
        let trace = DriverHarness.run 42UL 120000L
        let maxX = float32 (Sim.mapWidthTiles * Sim.tilePixels - Sim.tilePixels)
        let maxY = float32 (Sim.mapHeightTiles * Sim.tilePixels - Sim.tilePixels)
        let mutable checkedTicks = 0
        for w in trace do
            let p = w.Avatar.Pos
            if Single.IsNaN p.X then Assert.Fail($"NaN X at tick {w.Tick}")
            if Single.IsNaN p.Y then Assert.Fail($"NaN Y at tick {w.Tick}")
            if Single.IsInfinity p.X then Assert.Fail($"Infinity X at tick {w.Tick}")
            if Single.IsInfinity p.Y then Assert.Fail($"Infinity Y at tick {w.Tick}")
            if p.X < 0.0f || p.X > maxX then Assert.Fail($"X out of bounds at tick {w.Tick}: {p.X}")
            if p.Y < 0.0f || p.Y > maxY then Assert.Fail($"Y out of bounds at tick {w.Tick}: {p.Y}")
            if abs (float w.Tick * Sim.dtSeconds - w.Time) >= 1e-9 then
                Assert.Fail($"Time/Tick mismatch at tick {w.Tick}: {w.Time}")
            checkedTicks <- checkedTicks + 1
        Assert.IsTrue(120001 = checkedTicks)

    [<TestMethod>]
    member _.SplitMix64MatchesKnownVectors () =
        let expected : uint64 list =
            [ 0xbdd732262feb6e95UL
              0x28efe333b266f103UL
              0x47526757130f9f52UL
              0x581ce1ff0e4ae394UL ]
        let mutable rng = Rng.ofSeed 42UL
        for e in expected do
            let v, rng' = Rng.nextUInt64 rng
            if v <> e then Assert.Fail($"expected {e}, got {v}")
            rng <- rng'

    [<TestMethod>]
    member _.NextFloat32StaysInUnitInterval () =
        let mutable rng = Rng.ofSeed 1UL
        for _ in 1 .. 1000 do
            let f, rng' = Rng.nextFloat32 rng
            if f < 0.0f || f >= 1.0f then Assert.Fail($"out of range: {f}")
            rng <- rng'

    [<TestMethod>]
    member _.NpcDecisionTraceIsTickByTickDeterministic () =
        let runNpc (seed: uint64) (ticks: int64) : World list =
            let mutable world = Sim.initialWorld seed
            let acc = ResizeArray<World> (int ticks + 1)
            acc.Add world
            let zero = { Input = { MoveX = 0.0f; MoveY = 0.0f } }
            for _ in 1L .. ticks do
                world <- Sim.step zero world
                acc.Add world
            List.ofSeq acc
        let a = runNpc 42UL 20000L
        let b = runNpc 42UL 20000L
        Assert.IsTrue(20001 = List.length a)
        CollectionAssert.AreEqual(Array.ofList a, Array.ofList b)

    [<TestMethod>]
    member _.NpcNeedsDecayOverTimeAndActionsDifferAcrossSeeds () =
        let w0 = Sim.initialWorld 42UL
        let npc0 = List.exactlyOne w0.Npcs
        let zero = { Input = { MoveX = 0.0f; MoveY = 0.0f } }
        let mutable w = w0
        for _ in 1 .. 500 do
            w <- Sim.step zero w
        let npc1 = List.exactlyOne w.Npcs
        let n0 = npc0.Mind.Needs
        let n1 = npc1.Mind.Needs
        Assert.IsTrue(n1.Hunger < n0.Hunger, "hunger must decay")
        Assert.IsTrue(n1.Energy < n0.Energy, "energy must decay")
        Assert.IsTrue(n1.Social < n0.Social, "social must decay")
        Assert.IsTrue(n1.Money < n0.Money, "money must decay")
        let wa = Sim.initialWorld 42UL
        let wb = Sim.initialWorld 43UL
        Assert.IsTrue(wa.Npcs.[0].Mind.Personality <> wb.Npcs.[0].Mind.Personality,
                      "personalities must differ across seeds")
        let mutable ta = wa
        let mutable tb = wb
        let seqA = ResizeArray<NpcActionKind> 20000
        let seqB = ResizeArray<NpcActionKind> 20000
        for _ in 1 .. 20000 do
            ta <- Sim.step zero ta
            tb <- Sim.step zero tb
            seqA.Add ta.Npcs.[0].Mind.Action
            seqB.Add tb.Npcs.[0].Mind.Action
        if Seq.compareWith compare seqA seqB = 0 then
            Assert.Fail("npc action sequence must diverge across seeds")

    [<TestMethod>]
    member _.NpcActionPersistsAtLeastMinTicks () =
        let zero = { Input = { MoveX = 0.0f; MoveY = 0.0f } }
        let mutable w = Sim.initialWorld 42UL
        let total = 30000
        let mutable current = w.Npcs.[0].Mind.Action
        let mutable prevNeeds = w.Npcs.[0].Mind.Needs
        let mutable age = 0
        let mutable minStickyAge = System.Int32.MaxValue
        let mutable switches = 0
        let mutable urgentSwitches = 0
        for _ in 1 .. total do
            w <- Sim.step zero w
            let npc = w.Npcs.[0]
            let a = npc.Mind.Action
            if a <> current then
                let decayed =
                    { Hunger = prevNeeds.Hunger - Sim.hungerDecayPerTick
                      Energy = prevNeeds.Energy - Sim.energyDecayPerTick
                      Social = prevNeeds.Social - Sim.socialDecayPerTick
                      Money = prevNeeds.Money - Sim.moneyDecayPerTick }
                if Sim.needsUrgent decayed then urgentSwitches <- urgentSwitches + 1
                else minStickyAge <- min minStickyAge age
                current <- a
                age <- 0
                switches <- switches + 1
            else
                age <- age + 1
            prevNeeds <- npc.Mind.Needs
        Assert.IsTrue(switches > 0, "expected at least one action switch in 30000 ticks")
        Assert.IsTrue(minStickyAge >= 600, $"non-urgent action must persist >= 600 ticks, got min {minStickyAge}")

    [<TestMethod>]
    member _.NpcRecordsValenceMemoryOnActionEffect () =
        let zero = { Input = { MoveX = 0.0f; MoveY = 0.0f } }
        let mutable w = Sim.initialWorld 42UL
        let mutable sawEmpty = false
        let mutable sawEvent = false
        for _ in 1 .. 6000 do
            w <- Sim.step zero w
            let npc = w.Npcs.[0]
            if npc.Mind.Memory.IsEmpty then sawEmpty <- true
            if npc.Mind.Memory.Length > Sim.memoryCapacity then
                Assert.Fail("memory exceeds ring capacity")
            match List.tryHead npc.Mind.Memory with
            | Some e ->
                let expected =
                    match e.Kind with
                    | Meal -> 0.5f
                    | Rest -> 0.4f
                    | Pay -> 0.2f
                    | Hungry -> -0.4f
                if e.Valence <> expected then
                    Assert.Fail($"valence/kind mismatch: {e.Kind} -> {e.Valence}")
                if e.Valence < -1.0f || e.Valence > 1.0f then
                    Assert.Fail($"valence out of [-1,1]: {e.Valence}")
                if e.Tick >= 1L && e.Tick <= 6000L then sawEvent <- true
            | None -> ()
        Assert.IsTrue(sawEmpty, "memory must start empty")
        Assert.IsTrue(sawEvent, "expected a valence memory event within 6000 ticks")