1 files changed, 41 insertions, 15 deletions
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 }