diff options
Diffstat (limited to 'src')
| -rw-r--r-- | src/LivingVillage.Kernel.Tests/RelationTests.fs | 54 | ||||
| -rw-r--r-- | src/LivingVillage.Kernel/Sim.fs | 56 |
2 files changed, 95 insertions, 15 deletions
diff --git a/src/LivingVillage.Kernel.Tests/RelationTests.fs b/src/LivingVillage.Kernel.Tests/RelationTests.fs index 0f9de83..dc67e6d 100644 --- a/src/LivingVillage.Kernel.Tests/RelationTests.fs +++ b/src/LivingVillage.Kernel.Tests/RelationTests.fs @@ -138,3 +138,57 @@ type RelationTests () = if m.[i, j] <> m.[j, i] then Assert.Fail($"matrix must be symmetric at ({i},{j})") if System.Single.IsNaN m.[i, j] then Assert.Fail($"NaN at ({i},{j})") if System.Single.IsInfinity m.[i, j] then Assert.Fail($"infinite at ({i},{j})") + + [<TestMethod>] + member _.ChatMemorySurvivesRoutineMemoryChurn () = + let initial = [ RelationHarness.chatted 1L 1 ] + let full = + [ 1 .. Sim.memoryCapacity - 1 ] + |> List.fold (fun mem i -> Sim.recordMemory (int64 (i + 1)) Meal mem) initial + let retained = Sim.recordMemory (int64 (Sim.memoryCapacity + 1)) Meal full + if retained.Length > Sim.memoryCapacity then Assert.Fail("memory exceeds capacity") + if not (retained |> List.exists (fun e -> match e.Kind with Chatted _ -> true | _ -> false)) then + Assert.Fail("chat memory must survive routine-memory churn") + + [<TestMethod>] + member _.NpcAvoidsImmediateRepeatChatPartner () = + let needs = { Hunger = 100.0f; Energy = 100.0f; Social = 0.0f; Money = 100.0f } + let personality = + { Drive = 0.0f + Aggression = 0.0f + Extraversion = 1.0f + Honesty = 0.0f + Greed = 0.0f } + let plaza = Sim.actionTarget Wander + let npc id pos action age effectDone memory = + { Id = NpcId id + Pos = pos + Mind = + { Needs = needs + Personality = personality + Action = action + Target = Sim.actionTarget action + ActionAge = age + EffectDone = effectDone + HungerFlagged = false + Memory = memory } } + let self = npc 0 plaza Wander Sim.minActionTicks true [ RelationHarness.chatted 0L 1 ] + let nearest = npc 1 { X = plaza.X + 10.0f; Y = plaza.Y } Work 0L false [] + let alternate = npc 2 { X = plaza.X + 20.0f; Y = plaza.Y } Work 0L false [] + let world = + { Tick = 1L + Time = 0.0 + Rng = Rng.ofSeed 55UL + Avatar = { Pos = plaza } + NoHost = { Reserved = 0UL } + Npcs = [| self; nearest; alternate |] + Events = [] } + let next = Sim.step RelationHarness.zeroInput world + match List.tryHead next.Npcs.[0].Mind.Memory with + | Some entry -> + match entry.Kind with + | Chatted(NpcId partner) -> + if partner <> 2 then + Assert.Fail("a recent partner must not monopolize the next chat") + | kind -> Assert.Fail($"expected a chat memory, got {kind}") + | None -> Assert.Fail("expected a chat memory") diff --git a/src/LivingVillage.Kernel/Sim.fs b/src/LivingVillage.Kernel/Sim.fs index 33f2b57..ba3fd37 100644 --- a/src/LivingVillage.Kernel/Sim.fs +++ b/src/LivingVillage.Kernel/Sim.fs @@ -161,8 +161,24 @@ module Sim = | Chatted _ -> chatValence let recordMemory (tick: int64) (kind: MemoryKind) (mem: MemoryEvent list) : MemoryEvent list = - { Tick = tick; Kind = kind; Valence = valenceOfKind kind } :: mem - |> List.truncate memoryCapacity + let updated = { Tick = tick; Kind = kind; Valence = valenceOfKind kind } :: mem + let isRelational (event: MemoryEvent) = + match event.Kind with + | Chatted _ -> true + | _ -> false + let relationalCount = updated |> List.sumBy (fun event -> if isRelational event then 1 else 0) + let relationalCapacity = min memoryCapacity relationalCount + let routineCapacity = memoryCapacity - relationalCapacity + let rec retain relationalLeft routineLeft remaining kept = + match remaining with + | [] -> List.rev kept + | event :: tail when isRelational event && relationalLeft > 0 -> + retain (relationalLeft - 1) routineLeft tail (event :: kept) + | event :: tail when not (isRelational event) && routineLeft > 0 -> + retain relationalLeft (routineLeft - 1) tail (event :: kept) + | _ :: tail -> retain relationalLeft routineLeft tail kept + // Relation weights are derived from this snapshot, so interaction memories must outlive routine churn. + retain relationalCapacity routineCapacity updated [] let actionMemoryKind (kind: NpcActionKind) : MemoryKind option = match kind with @@ -284,18 +300,28 @@ module Sim = let chatableForChat (n: Npc) : bool = n.Mind.Action <> Sleep && n.Mind.Action <> Chat - let findChatPartner (self: NpcId) (pos: Vec2) (npcs: Npc[]) : NpcId option = - let mutable best = None - let mutable bestD2 = chatRangeSq - for o in npcs do - if o.Id <> self && chatableForChat o then - let dx = o.Pos.X - pos.X - let dy = o.Pos.Y - pos.Y - let d2 = dx * dx + dy * dy - if d2 < bestD2 then - bestD2 <- d2 - best <- Some o.Id - best + let findChatPartner (self: Npc) (pos: Vec2) (npcs: Npc[]) : NpcId option = + let lastChatPartner = + self.Mind.Memory + |> List.tryPick (fun event -> + match event.Kind with + | Chatted partner -> Some partner + | _ -> None) + let pick (allow: Npc -> bool) = + let mutable best = None + let mutable bestD2 = chatRangeSq + for o in npcs do + if o.Id <> self.Id && chatableForChat o && allow o then + let dx = o.Pos.X - pos.X + let dy = o.Pos.Y - pos.Y + let d2 = dx * dx + dy * dy + if d2 < bestD2 then + bestD2 <- d2 + best <- Some o.Id + best + match pick (fun o -> Some o.Id <> lastChatPartner) with + | Some partner -> Some partner + | None -> pick (fun _ -> true) let private stepNpc (tick: int64) (npcs: Npc[]) (pending: ResizeArray<InteractionEvent>) (npc: Npc) : Npc = let decayed = @@ -321,7 +347,7 @@ module Sim = let switchTo (resetOnSame: bool) (mind: Mind) (needsNow: Needs) (pos: Vec2) : Npc = let action = decideAction night needsNow mind.Personality if action = Wander then - match findChatPartner npc.Id pos npcs with + match findChatPartner npc pos npcs with | Some partner -> pending.Add { Tick = tick; Kind = ChatInit(npc.Id, partner) } { npc with Pos = pos; Mind = mind } |