path: root/src/LivingVillage.Kernel.Tests/DeterminismTests.fs

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 = w0.Npcs |> Array.exactlyOne
        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 = w.Npcs |> Array.exactlyOne
        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
                    | Chatted _ -> Sim.chatValence
                    | Bought _ -> 0.3f
                    | Sold _ -> 0.3f
                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")

    [<TestMethod>]
    member _.Npc30SameSeedTracesAreTickByTickEqualAndEventsDrain () =
        let zero = { Input = { MoveX = 0.0f; MoveY = 0.0f } }
        let mutable a = Sim.initialWorldN 42UL 30
        let mutable b = Sim.initialWorldN 42UL 30
        for t in 1L .. 30000L do
            a <- Sim.step zero a
            b <- Sim.step zero b
            if a <> b then Assert.Fail($"30-npc worlds diverged at tick {t}")
            if not a.Events.IsEmpty then Assert.Fail($"Events queue not drained at tick {t}")
        Assert.IsTrue(30000L = a.Tick)

    [<TestMethod>]
    member _.Npc30ChatsRecordSymmetricPositiveMemories () =
        let zero = { Input = { MoveX = 0.0f; MoveY = 0.0f } }
        let mutable w = Sim.initialWorldN 42UL 30
        let mutable prev0 = w.Npcs.[0].Mind.Action
        let mutable symmetryChecked = false
        let mutable chatObserved = 0
        let total = 600000L
        for _ in 1L .. total do
            w <- Sim.step zero w
            for npc in w.Npcs do
                if npc.Mind.Action = Chat then chatObserved <- chatObserved + 1
            let npc0 = w.Npcs.[0]
            if not symmetryChecked && npc0.Mind.Action = Chat && prev0 <> Chat then
                match List.tryHead npc0.Mind.Memory with
                | Some entry ->
                    match entry.Kind with
                    | Chatted partner ->
                        if partner = npc0.Id then Assert.Fail("chat partner must differ from self")
                        let partnerNpc = w.Npcs |> Array.find (fun n -> n.Id = partner)
                        let partnerAlsoChatted =
                            partnerNpc.Mind.Memory
                            |> List.exists (fun e -> match e.Kind with Chatted p -> p = npc0.Id | _ -> false)
                        if not partnerAlsoChatted then
                            Assert.Fail("chat memory must be recorded symmetrically for both partners")
                        symmetryChecked <- true
                    | _ -> Assert.Fail($"chat start must record a Chatted memory, got {entry.Kind}")
                | None -> Assert.Fail("chat start must record a Chatted memory")
            prev0 <- npc0.Mind.Action
        Assert.IsTrue(symmetryChecked, "expected npc0 to start at least one chat within the run")
        Assert.IsTrue(chatObserved > 0, "expected some NPC to be chatting during the run")
        let mutable chattedMemories = 0
        for npc in w.Npcs do
            Assert.IsTrue(npc.Mind.Memory.Length <= Sim.memoryCapacity, "memory exceeds ring capacity")
            for e in npc.Mind.Memory do
                match e.Kind with
                | Chatted partner ->
                    chattedMemories <- chattedMemories + 1
                    if partner = npc.Id then Assert.Fail("chat partner must differ from self")
                    if e.Valence <> Sim.chatValence then
                        Assert.Fail($"chat valence must be {Sim.chatValence}, got {e.Valence}")
                | _ -> ()
        Assert.IsTrue(chattedMemories > 0, "expected Chatted memories after the run")