summaryrefslogtreecommitdiff
path: root/src
diff options
context:
space:
mode:
Diffstat (limited to 'src')
-rw-r--r--src/LivingVillage.Headless/Program.fs18
-rw-r--r--src/LivingVillage.Kernel.Tests/DeterminismTests.fs47
-rw-r--r--src/LivingVillage.Kernel/Sim.fs147
3 files changed, 205 insertions, 7 deletions
diff --git a/src/LivingVillage.Headless/Program.fs b/src/LivingVillage.Headless/Program.fs
index ea8b1b0..8c2b6d6 100644
--- a/src/LivingVillage.Headless/Program.fs
+++ b/src/LivingVillage.Headless/Program.fs
@@ -40,6 +40,13 @@ let nextSegment (rng: RngState) (until: int64) : Driver =
Until = until + segmentTicks
Input = { MoveX = dirX * mag; MoveY = dirY * mag } }
+let actionName (k: NpcActionKind) : string =
+ match k with
+ | Eat -> "eat"
+ | Sleep -> "sleep"
+ | Wander -> "wander"
+ | Work -> "work"
+
let runSimulation (days: int64) (seed: uint64) : int =
let totalTicks = days * ticksPerDay
printfn "living-village headless days=%d seed=%d ticks=%d tickrate=%d" days seed totalTicks ticksPerSecond
@@ -63,10 +70,17 @@ let runSimulation (days: int64) (seed: uint64) : int =
if Single.IsNaN p.X || Single.IsNaN p.Y || Single.IsInfinity p.X || Single.IsInfinity p.Y then
nonFinite <- nonFinite + 1L
if p.X < 0.0f || p.X > maxX || p.Y < 0.0f || p.Y > maxY then outOfBounds <- outOfBounds + 1L
- if t % 1000L = 0L then
+ if t % 2000L = 0L then
+ let day = float t / float ticksPerDay
let mem = GC.GetTotalMemory(true)
+ for npc in world.Npcs do
+ let n = npc.Mind.Needs
+ let p' = npc.Pos
+ printfn "npc=%A tick=%d day=%.4f pos=(%.1f,%.1f) hunger=%.2f energy=%.2f social=%.2f money=%.2f action=%s"
+ npc.Id t day p'.X p'.Y n.Hunger n.Energy n.Social n.Money (actionName npc.Mind.Action)
+ if t % 1000L = 0L && t % 2000L <> 0L then
let day = float t / float ticksPerDay
- printfn "tick=%d time=%.4fs day=%.4f pos=(%.1f,%.1f) mem=%d rng=%016x" t world.Time day p.X p.Y mem world.Rng.State
+ printfn "tick=%d time=%.4fs day=%.4f pos=(%.1f,%.1f) rng=%016x" t world.Time day p.X p.Y world.Rng.State
printfn "done tick=%d non-finite=%d out-of-bounds=%d" world.Tick nonFinite outOfBounds
if nonFinite > 0L || outOfBounds > 0L then 1 else 0
diff --git a/src/LivingVillage.Kernel.Tests/DeterminismTests.fs b/src/LivingVillage.Kernel.Tests/DeterminismTests.fs
index 2e2663b..aba794e 100644
--- a/src/LivingVillage.Kernel.Tests/DeterminismTests.fs
+++ b/src/LivingVillage.Kernel.Tests/DeterminismTests.fs
@@ -133,3 +133,50 @@ type DeterminismTests () =
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")
diff --git a/src/LivingVillage.Kernel/Sim.fs b/src/LivingVillage.Kernel/Sim.fs
index 0e3683b..fac9c58 100644
--- a/src/LivingVillage.Kernel/Sim.fs
+++ b/src/LivingVillage.Kernel/Sim.fs
@@ -23,12 +23,51 @@ module Sim =
{ Reserved: uint64 }
[<Struct>]
+ type NpcId =
+ | NpcId of int
+
+ [<Struct>]
+ type Needs =
+ { Hunger: float32
+ Energy: float32
+ Social: float32
+ Money: float32 }
+
+ [<Struct>]
+ type Personality =
+ { Drive: float32
+ Aggression: float32
+ Extraversion: float32
+ Honesty: float32
+ Greed: float32 }
+
+ type NpcActionKind =
+ | Eat
+ | Sleep
+ | Wander
+ | Work
+
+ [<Struct>]
+ type Mind =
+ { Needs: Needs
+ Personality: Personality
+ Action: NpcActionKind
+ Target: Vec2 }
+
+ [<Struct>]
+ type Npc =
+ { Id: NpcId
+ Pos: Vec2
+ Mind: Mind }
+
+ [<Struct>]
type World =
{ Tick: int64
Time: float
Rng: RngState
Avatar: Avatar
- NoHost: NoHost }
+ NoHost: NoHost
+ Npcs: Npc list }
let ticksPerSecond = 60L
let secondsPerDay = 86400L
@@ -41,16 +80,111 @@ module Sim =
let tilePixels = 32
let avatarSpeed = 160.0f
+ let npcSpeed = 80.0f
+ let arriveEpsilon = 2.0f
+
+ let clamp v lo hi = if v < lo then lo elif v > hi then hi else v
+
+ let hungerDecayPerTick = 0.0012f
+ let energyDecayPerTick = 0.0010f
+ let socialDecayPerTick = 0.0008f
+ let moneyDecayPerTick = 0.0006f
+
+ let private tileCenter (tx: int) (ty: int) : Vec2 =
+ { X = float32 (tx * tilePixels + tilePixels / 2)
+ Y = float32 (ty * tilePixels + tilePixels / 2) }
+
+ let kitchenPoint = tileCenter 10 10
+ let homePoint = tileCenter 52 10
+ let plazaPoint = tileCenter 32 24
+ let worksitePoint = tileCenter 52 38
+
+ let actionTarget (kind: NpcActionKind) : Vec2 =
+ match kind with
+ | Eat -> kitchenPoint
+ | Sleep -> homePoint
+ | Wander -> plazaPoint
+ | Work -> worksitePoint
+
+ let personalityOfSeed (seed: uint64) : Personality =
+ let a, r1 = Rng.nextFloat32 (Rng.ofSeed seed)
+ let b, r2 = Rng.nextFloat32 r1
+ let c, r3 = Rng.nextFloat32 r2
+ let d, r4 = Rng.nextFloat32 r3
+ let e, _ = Rng.nextFloat32 r4
+ { Drive = a
+ Aggression = b
+ Extraversion = c
+ Honesty = d
+ Greed = e }
+
+ let needsClamp (n: Needs) : Needs =
+ { Hunger = clamp n.Hunger 0.0f 100.0f
+ Energy = clamp n.Energy 0.0f 100.0f
+ Social = clamp n.Social 0.0f 100.0f
+ Money = clamp n.Money 0.0f 100.0f }
+
+ let scoreAction (needs: Needs) (p: Personality) (kind: NpcActionKind) : float32 =
+ match kind with
+ | Eat -> (100.0f - needs.Hunger) * (0.25f + 2.0f * p.Drive)
+ | Sleep -> (100.0f - needs.Energy) * (0.25f + 2.0f * (1.0f - p.Drive))
+ | Wander -> (100.0f - needs.Social) * (0.25f + 2.0f * p.Extraversion)
+ | Work -> (100.0f - needs.Money) * (0.25f + 2.0f * p.Greed)
+
+ let decideAction (needs: Needs) (p: Personality) : NpcActionKind =
+ let candidates = [ Eat; Sleep; Wander; Work ]
+ candidates |> List.maxBy (scoreAction needs p)
+
+ let applyActionEffect (kind: NpcActionKind) (n: Needs) : Needs =
+ match kind with
+ | Eat -> { n with Hunger = n.Hunger + 40.0f; Money = n.Money - 5.0f }
+ | Sleep -> { n with Energy = n.Energy + 60.0f }
+ | Wander -> { n with Social = n.Social + 15.0f; Hunger = n.Hunger - 2.0f }
+ | Work -> { n with Money = n.Money + 20.0f; Energy = n.Energy - 10.0f }
+ |> needsClamp
+
+ let private moveToward (pos: Vec2) (target: Vec2) (maxStep: float32) : Vec2 * bool =
+ let dx = target.X - pos.X
+ let dy = target.Y - pos.Y
+ let len = sqrt (dx * dx + dy * dy)
+ if len <= maxStep + arriveEpsilon then target, true
+ else
+ let inv = maxStep / len
+ { X = pos.X + dx * inv; Y = pos.Y + dy * inv }, false
+
let initialWorld (seed: uint64) : World =
let centerX = float32 (mapWidthTiles * tilePixels / 2 - tilePixels / 2)
let centerY = float32 (mapHeightTiles * tilePixels / 2 - tilePixels / 2)
+ let personality = personalityOfSeed seed
+ let needs = { Hunger = 100.0f; Energy = 100.0f; Social = 100.0f; Money = 50.0f }
+ let startAction = decideAction needs personality
+ let npc =
+ { Id = NpcId 0
+ Pos = { X = centerX; Y = centerY }
+ Mind = { Needs = needs; Personality = personality; Action = startAction; Target = actionTarget startAction } }
{ Tick = 0L
Time = 0.0
Rng = Rng.ofSeed seed
Avatar = { Pos = { X = centerX; Y = centerY } }
- NoHost = { Reserved = 0UL } }
+ NoHost = { Reserved = 0UL }
+ Npcs = [ npc ] }
- let clamp v lo hi = if v < lo then lo elif v > hi then hi else v
+ let private stepNpc (npc: Npc) : Npc =
+ let decayed =
+ needsClamp
+ { Hunger = npc.Mind.Needs.Hunger - hungerDecayPerTick
+ Energy = npc.Mind.Needs.Energy - energyDecayPerTick
+ Social = npc.Mind.Needs.Social - socialDecayPerTick
+ Money = npc.Mind.Needs.Money - moneyDecayPerTick }
+ let mind0 = { npc.Mind with Needs = decayed }
+ let target = actionTarget mind0.Action
+ let nextPos, arrived = moveToward npc.Pos target (npcSpeed * dtSecondsF)
+ if arrived then
+ let needs = applyActionEffect mind0.Action mind0.Needs
+ let action = decideAction needs mind0.Personality
+ { npc with Pos = target; Mind = { Needs = needs; Personality = mind0.Personality; Action = action; Target = actionTarget action } }
+ else
+ { npc with Pos = nextPos; Mind = mind0 }
let step (ts: TimeStep) (world: World) : World =
let tick = world.Tick + 1L
@@ -58,11 +192,14 @@ module Sim =
let maxY = float32 (mapHeightTiles * tilePixels - tilePixels)
let dx = ts.Input.MoveX * avatarSpeed * dtSecondsF
let dy = ts.Input.MoveY * avatarSpeed * dtSecondsF
+ let rngOut, rngNext = Rng.nextUInt64 world.Rng
+ ignore rngOut
{ Tick = tick
Time = float tick * dtSeconds
- Rng = world.Rng
+ Rng = rngNext
Avatar =
{ Pos =
{ X = clamp (world.Avatar.Pos.X + dx) 0.0f maxX
Y = clamp (world.Avatar.Pos.Y + dy) 0.0f maxY } }
- NoHost = world.NoHost }
+ NoHost = world.NoHost
+ Npcs = world.Npcs |> List.map stepNpc }
generated by cgit v1.2.3 (git 2.39.1) at 2026-10-04 23:12:32 +0000