path: root/src/LivingVillage.Kernel/Sim.fs

namespace LivingVillage.Kernel

module Sim =

    [<Struct>]
    type Vec2 =
        { X: float32
          Y: float32 }

    type Input =
        { MoveX: float32
          MoveY: float32 }

    type TimeStep =
        { Input: Input }

    [<Struct>]
    type NoHost =
        { 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 ItemKind =
        | Food
        | Fish
        | Spice
        | Scroll

    type NpcActionKind =
        | Eat
        | Sleep
        | Wander
        | Work
        | Chat

    [<Struct>]
    type RumorId =
        | RumorId of int64

    type DialogueIntent =
        | SmallTalk
        | AskHelp
        | OfferTrade
        | Joke
        | Apologize
        | Provoke

    type DialogueResponse =
        | Friendly
        | Helpful
        | Bargaining
        | Amused
        | Forgiving
        | Hostile
        | Reserved
        | Refused
        | Offended

    type DialogueOutcome =
        { Tick: int64
          Actor: NpcId
          Target: NpcId
          Intent: DialogueIntent
          Response: DialogueResponse
          Valence: float32 }

    type MemoryKind =
        | Meal
        | Rest
        | Pay
        | Hungry
        | Chatted of NpcId
        | Rumor of RumorId
        | Bought of NpcId * ItemKind * int * float32
        | Sold of NpcId * ItemKind * int * float32
        | Dialogue of NpcId * DialogueIntent * DialogueResponse

    type RumorEvent =
        { Id: RumorId
          Tick: int64
          /// 该谣言所属模拟日（= Tick / ticksPerDay）。派生镜像字段，不参与存档序列化，
          /// 以便按天确定性淘汰工作集；读档时由 Tick 纯函数重建，故 v1/v2/v3 存档逐字节不变。
          DayIndex: int64
          OriginTick: int64
          Source: NpcId
          Narrator: NpcId
          Receiver: NpcId
          Parent: RumorId option
          Depth: int
          Strength: float32 }

    type MemoryEvent =
        { Tick: int64
          Kind: MemoryKind
          Valence: float32 }

    type InteractionKind =
        | ChatInit of NpcId * NpcId
        | TradeEvent of NpcId * NpcId * ItemKind * int * float32
        | DialogueEvent of DialogueOutcome

    type InteractionEvent =
        { Tick: int64
          Kind: InteractionKind }

    type NeedKind =
        | HungerNeed
        | EnergyNeed
        | SocialNeed
        | MoneyNeed

    type NeedScore =
        { Kind: NeedKind
          Urgency: float32 }

    type NeedsPanel =
        { Needs: Needs
          Ranked: NeedScore list }

    type VisibleBounds =
        { Min: Vec2
          Max: Vec2 }

    type Observation =
        { Id: NpcId
          Pos: Vec2
          Needs: Needs
          Ranked: NeedScore list
          RecentMemory: MemoryEvent list }

    type DialogueMenu =
        { Target: NpcId
          Options: DialogueIntent list }

    type AnnalKind =
        | DialogueAnnal of DialogueOutcome
        | RumorAnnal of RumorEvent
        | TradeAnnal of InteractionEvent

    type AnnalEntry =
        { Tick: int64
          Kind: AnnalKind
          Summary: string }

    [<Struct>]
    type Mind =
        { Needs: Needs
          Personality: Personality
          Action: NpcActionKind
          Target: Vec2
          ActionAge: int64
          EffectDone: bool
          HungerFlagged: bool
          Memory: MemoryEvent list }

    [<Struct>]
    type Avatar =
        { Pos: Vec2
          Mind: Mind }

    [<Struct>]
    type Npc =
        { Id: NpcId
          Pos: Vec2
          Inventory: Map<ItemKind, int>
          Mind: Mind }

    [<Struct>]
    type World =
        { Tick: int64
          Time: float
          Rng: RngState
          Avatar: Avatar
          NoHost: NoHost
          Npcs: Npc[]
          Events: InteractionEvent list
          Rumors: RumorEvent list
          Annals: AnnalEntry list }

    type DialogueFailure =
        | DialogueTargetNotFound
        | DialogueTargetOutOfRange
        | DialogueTargetUnavailable

    type DialogueResult =
        | DialogueSucceeded of DialogueOutcome * World
        | DialogueRejected of DialogueFailure * World

    type ChatRequest =
        { Narrator: NpcId
          Receiver: NpcId }

    type ChatFailure =
        | NarratorNotFound
        | ReceiverNotFound
        | ChatSameParticipant
        | ParticipantNotChatable

    type ChatResult =
        | ChatSucceeded of RumorEvent option * World
        | ChatRejected of ChatFailure * World

    type TradeRequest =
        { Buyer: NpcId
          Seller: NpcId
          Item: ItemKind
          Quantity: int }

    type TradeFailure =
        | BuyerNotFound
        | SellerNotFound
        | SameParticipant
        | InvalidQuantity
        | OutOfStock
        | InsufficientFunds

    type TradeResult =
        | TradeSucceeded of World
        | TradeRejected of TradeFailure * World

    let ticksPerSecond = 60L
    let secondsPerDay = 86400L
    let ticksPerDay = secondsPerDay * ticksPerSecond
    let dtSeconds = 1.0 / float ticksPerSecond
    let dtSecondsF = 1.0f / float32 ticksPerSecond

    /// World dimensions are parameterized so a large procedural map (e.g. 512x384)
    /// can reuse every movement/wander/clamp rule. Defaults stay the legacy 64x48 to
    /// keep all existing deterministic tests and baselines untouched.
    let mutable mapWidthTiles = 64
    let mutable mapHeightTiles = 48

    /// Configure the world size. Note: the caller must not step worlds during a
    /// reconfiguration; bounds are read per step from these values.
    let configureBounds (widthTiles: int) (heightTiles: int) : unit =
        mapWidthTiles <- widthTiles
        mapHeightTiles <- heightTiles
    let tilePixels = 32
    let avatarSpeed = 160.0f

    let npcSpeed = 80.0f
    let arriveEpsilon = 2.0f

    let memoryCapacity = 64
    let minActionTicks = 600L
    let urgentThreshold = 20.0f
    let nightSleepMultiplier = 3.0f
    let npcCount = 30
    let chatRangePx = 96.0f
    let chatRangeSq = chatRangePx * chatRangePx
    let chatTicks = 300L
    let chatSocialRestore = 40.0f
    let chatValence = 0.3f
    let rumorFreshnessTicks = 3L * ticksPerDay
    let rumorHalfLifeTicks = ticksPerDay
    let rumorMinimumStrength = 0.125f

    /// 谣言工作集容量上界（参数化常量；测试可临时调小）。默认值远大于任何既有测试
    /// 路径产生的谣言数，因此 append-only 前 N 条内与未裁剪版本逐字节等价；超界只保留最新 N 条。
    let mutable rumorCapacity = 16384

    /// 按天淘汰的保留天数。>= 新鲜窗口（rumorFreshnessTicks / ticksPerDay = 3 天），
    /// 保证任何仍可能被 latestRumorFor/rumorIsDuplicate 使用的新鲜谣言都不会被裁掉。
    let mutable rumorRetentionDays = 3L

    /// 谣言所属模拟日（纯函数）。用于确定性的按天淘汰，读档时与 Tick 保持一致。
    let rumorDayIndex (tick: int64) : int64 = tick / ticksPerDay

    // 关系网派生（纯函数；仅在 dump/视图打开时调用，不进 step 热路径）
    let relationHalfLifeTicks = ticksPerDay // HALF_LIFE = 1 模拟日（修复单位错误：原 86400L 实为 24 模拟分钟；1 模拟日 = ticksPerDay = 5,184,000 tick）
    let relationThreshold = 0.5f // |rel| > 0.5 视为有关系

    let playerId = NpcId -1
    let dialogueOptions = [ SmallTalk; AskHelp; OfferTrade; Joke; Apologize; Provoke ]
    let maxAnnalEntries = 128

    let clamp (v: float32) (lo: float32) (hi: float32) : float32 = if v < lo then lo elif v > hi then hi else v

    let private appendAnnal (entry: AnnalEntry) (world: World) : World =
        { world with Annals = (entry :: world.Annals) |> List.truncate maxAnnalEntries }

    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
        | Chat -> plazaPoint

    let isNightTick (tick: int64) : bool =
        let hourTicks = ticksPerDay / 24L
        let tod = tick % ticksPerDay
        tod >= 22L * hourTicks || tod < 6L * hourTicks

    let valenceOfKind (kind: MemoryKind) : float32 =
        match kind with
        | Meal -> 0.5f
        | Rest -> 0.4f
        | Pay -> 0.2f
        | Hungry -> -0.4f
        | Chatted _ -> chatValence
        | Rumor _ -> 0.1f
        | Bought _ -> 0.3f
        | Sold _ -> 0.3f
        | Dialogue (_, _, response) ->
            match response with
            | Friendly -> 0.4f
            | Helpful -> 0.5f
            | Bargaining -> 0.2f
            | Amused -> 0.35f
            | Forgiving -> 0.45f
            | Hostile -> -0.5f
            | Reserved -> 0.0f
            | Refused -> -0.1f
            | Offended -> -0.4f

    let recordMemory (tick: int64) (kind: MemoryKind) (mem: MemoryEvent list) : MemoryEvent list =
        let updated = { Tick = tick; Kind = kind; Valence = valenceOfKind kind } :: mem
        let isRelational (event: MemoryEvent) =
            match event.Kind with
            | Chatted _
            | Dialogue _ -> 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
        | Eat -> Some Meal
        | Sleep -> Some Rest
        | Work -> Some Pay
        | Wander -> None
        | Chat -> None

    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 (night: bool) (needs: Needs) (p: Personality) (kind: NpcActionKind) : float32 =
        let raw =
            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)
            | Chat -> 0.0f
        if kind = Sleep && night then raw * nightSleepMultiplier else raw

    let decideAction (night: bool) (needs: Needs) (p: Personality) : NpcActionKind =
        let candidates = [ Eat; Sleep; Wander; Work ]
        candidates |> List.maxBy (scoreAction night needs p)

    let needsUrgent (n: Needs) : bool =
        n.Hunger < urgentThreshold
        || n.Energy < urgentThreshold
        || n.Social < urgentThreshold
        || n.Money < urgentThreshold

    let private rankNeeds (n: Needs) : NeedScore list =
        [ { Kind = HungerNeed; Urgency = clamp (100.0f - n.Hunger) 0.0f 100.0f }
          { Kind = EnergyNeed; Urgency = clamp (100.0f - n.Energy) 0.0f 100.0f }
          { Kind = SocialNeed; Urgency = clamp (100.0f - n.Social) 0.0f 100.0f }
          { Kind = MoneyNeed; Urgency = clamp (100.0f - n.Money) 0.0f 100.0f } ]
        |> List.sortByDescending (fun score -> score.Urgency)

    let needsPanel (world: World) : NeedsPanel =
        let needs = world.Avatar.Mind.Needs
        { Needs = needs
          Ranked = rankNeeds needs }

    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 }
        | Chat -> { n with Social = n.Social + chatSocialRestore }
        |> needsClamp

    let private moveToward (pos: Vec2) (target: Vec2) (maxStep: float32) : struct (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 struct (target, true)
        else
            let inv = maxStep / len
            struct ({ 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 inventory = Map.ofList [ Food, 10 ]
        let startAction = decideAction (isNightTick 0L) needs personality
        let npc =
            { Id = NpcId 0
              Pos = { X = centerX; Y = centerY }
              Inventory = inventory
              Mind =
                { Needs = needs
                  Personality = personality
                  Action = startAction
                  Target = actionTarget startAction
                  ActionAge = 0L
                  EffectDone = false
                  HungerFlagged = false
                  Memory = [] } }
        let avatar =
            { Pos = { X = centerX; Y = centerY }
              Mind =
                  { Needs = needs
                    Personality = personality
                    Action = Wander
                    Target = { X = centerX; Y = centerY }
                    ActionAge = 0L
                    EffectDone = false
                    HungerFlagged = false
                    Memory = [] } }
        { Tick = 0L
          Time = 0.0
          Rng = Rng.ofSeed seed
          Avatar = avatar
          NoHost = { Reserved = 0UL }
          Npcs = [| npc |]
          Events = []
          Rumors = []
          Annals = [] }

    let initialWorldN (seed: uint64) (count: int) : World =
        let base_ = initialWorld seed
        let cols = 6
        let spacing = 64.0f
        let needs = { Hunger = 100.0f; Energy = 100.0f; Social = 100.0f; Money = 50.0f }
        let inventory = Map.ofList [ Food, 10 ]
        let npcs =
            Array.init count (fun i ->
                let col = i % cols
                let row = i / cols
                let pos =
                    { X = plazaPoint.X + (float32 col - 2.5f) * spacing
                      Y = plazaPoint.Y + (float32 row - 2.0f) * spacing }
                let personality = personalityOfSeed (seed + uint64 i * 0x9E3779B97F4A7C15UL)
                let startAction = decideAction (isNightTick 0L) needs personality
                { Id = NpcId i
                  Pos = pos
                  Inventory = inventory
                  Mind =
                    { Needs = needs
                      Personality = personality
                      Action = startAction
                      Target = actionTarget startAction
                      ActionAge = 0L
                      EffectDone = false
                      HungerFlagged = false
                      Memory = [] } })
        { base_ with Npcs = npcs }

    let private inventoryQuantity (item: ItemKind) (inventory: Map<ItemKind, int>) : int =
        inventory |> Map.tryFind item |> Option.defaultValue 0

    let private changeInventory (item: ItemKind) (delta: int) (inventory: Map<ItemKind, int>) : Map<ItemKind, int> =
        let next = inventoryQuantity item inventory + delta
        if next <= 0 then Map.remove item inventory else Map.add item next inventory

    let private findNpcIndex (id: NpcId) (npcs: Npc[]) : int option =
        npcs |> Array.tryFindIndex (fun npc -> npc.Id = id)

    let private recentTransactionPrice (item: ItemKind) (world: World) : float32 option =
        world.Npcs
        |> Array.toList
        |> List.collect (fun npc -> npc.Mind.Memory)
        |> List.choose (fun event ->
            match event.Kind with
            | Bought (_, tradedItem, _, price) when tradedItem = item -> Some(event.Tick, price)
            | Sold (_, tradedItem, _, price) when tradedItem = item -> Some(event.Tick, price)
            | _ -> None)
        |> List.sortByDescending fst
        |> List.truncate 8
        |> List.map snd
        |> function
            | [] -> None
            | prices -> Some(List.average prices)

    let quotePrice (request: TradeRequest) (world: World) : float32 option =
        match findNpcIndex request.Buyer world.Npcs, findNpcIndex request.Seller world.Npcs with
        | Some buyerIndex, Some sellerIndex when buyerIndex <> sellerIndex ->
            let buyer = world.Npcs.[buyerIndex]
            let seller = world.Npcs.[sellerIndex]
            let basePrice =
                match request.Item with
                | Food -> 10.0f
                | Fish -> 12.0f
                | Spice -> 8.0f
                | Scroll -> 15.0f
            let buyerUrgency = clamp ((100.0f - buyer.Mind.Needs.Hunger) / 100.0f) 0.0f 1.0f
            let stockPressure =
                1.0f - clamp (float32 (inventoryQuantity request.Item seller.Inventory) / 20.0f) 0.0f 1.0f
            let sellerNeed = clamp ((100.0f - seller.Mind.Needs.Money) / 100.0f) 0.0f 1.0f
            let personalityFactor =
                0.2f * seller.Mind.Personality.Greed
                + 0.1f * (1.0f - buyer.Mind.Personality.Honesty)
                - 0.05f * buyer.Mind.Personality.Greed
            let marketFactor =
                match recentTransactionPrice request.Item world with
                | Some recent -> clamp (0.85f + 0.15f * recent / basePrice) 0.75f 1.5f
                | None -> 1.0f
            let raw =
                basePrice
                * (0.75f
                   + 0.35f * buyerUrgency
                   + 0.30f * stockPressure
                   + 0.15f * sellerNeed
                   + personalityFactor)
                * marketFactor
            Some(clamp raw 0.01f 1000.0f)
        | _ -> None

    let trade (request: TradeRequest) (world: World) : TradeResult =
        match findNpcIndex request.Buyer world.Npcs with
        | None -> TradeRejected(BuyerNotFound, world)
        | Some buyerIndex ->
            match findNpcIndex request.Seller world.Npcs with
            | None -> TradeRejected(SellerNotFound, world)
            | Some sellerIndex when buyerIndex = sellerIndex -> TradeRejected(SameParticipant, world)
            | Some sellerIndex when request.Quantity <= 0 -> TradeRejected(InvalidQuantity, world)
            | Some sellerIndex ->
                let buyer = world.Npcs.[buyerIndex]
                let seller = world.Npcs.[sellerIndex]
                let stock = inventoryQuantity request.Item seller.Inventory
                if stock < request.Quantity then
                    TradeRejected(OutOfStock, world)
                else
                    match quotePrice request world with
                    | None -> TradeRejected(SameParticipant, world)
                    | Some unitPrice ->
                        let total = unitPrice * float32 request.Quantity
                        if buyer.Mind.Needs.Money < total then
                            TradeRejected(InsufficientFunds, world)
                        else
                            let newNpcs = Array.copy world.Npcs
                            let buyerMemory =
                                recordMemory world.Tick (Bought(request.Seller, request.Item, request.Quantity, unitPrice)) buyer.Mind.Memory
                            let sellerMemory =
                                recordMemory world.Tick (Sold(request.Buyer, request.Item, request.Quantity, unitPrice)) seller.Mind.Memory
                            newNpcs.[buyerIndex] <-
                                { buyer with
                                    Inventory = changeInventory request.Item request.Quantity buyer.Inventory
                                    Mind =
                                        { buyer.Mind with
                                            Needs = { buyer.Mind.Needs with Money = buyer.Mind.Needs.Money - total }
                                            Memory = buyerMemory } }
                            newNpcs.[sellerIndex] <-
                                { seller with
                                    Inventory = changeInventory request.Item (-request.Quantity) seller.Inventory
                                    Mind =
                                        { seller.Mind with
                                            Needs = { seller.Mind.Needs with Money = seller.Mind.Needs.Money + total }
                                            Memory = sellerMemory } }
                            let event =
                                { Tick = world.Tick
                                  Kind = TradeEvent(request.Buyer, request.Seller, request.Item, request.Quantity, unitPrice) }
                            let updated = { world with Npcs = newNpcs; Events = world.Events @ [ event ] }
                            let entry =
                                { Tick = world.Tick
                                  Kind = TradeAnnal event
                                  Summary = sprintf "trade tick=%d buyer=%A seller=%A item=%A quantity=%d price=%.2f"
                                      world.Tick request.Buyer request.Seller request.Item request.Quantity unitPrice }
                            TradeSucceeded(appendAnnal entry updated)

    let chatableForChat (n: Npc) : bool =
        n.Mind.Action <> Sleep && n.Mind.Action <> Chat

    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 rumorDecayWeight (nowTick: int64) (eventTick: int64) : float32 =
        let age = max 0L (nowTick - eventTick)
        float32 (exp (-(log 2.0) * float age / float rumorHalfLifeTicks))

    let rumorStrengthAt (nowTick: int64) (rumor: RumorEvent) : float32 =
        rumor.Strength * rumorDecayWeight nowTick rumor.Tick

    /// 判断工作集是否需要裁剪：超过容量或存在早于保留窗口的条目。
    /// 列表约定为最新在前，故只需从前缀扫描 min(len, capacity+1) 条，无分配。
    let private rumorsNeedTrim (cutoffDay: int64) (rumors: RumorEvent list) : bool =
        let rec loop seen rest =
            if seen > rumorCapacity then true
            else
                match rest with
                | [] -> false
                | rumor :: tail ->
                    if rumor.DayIndex < cutoffDay then true else loop (seen + 1) tail
        loop 1 rumors

    /// 纯函数裁剪：保留最新 rumorCapacity 条，并丢弃早于 (nowDay - rumorRetentionDays)
    /// 的条目。容量内且全部新鲜时原样返回（零拷贝，保证既有路径逐字节不变）。
    let trimRumors (nowTick: int64) (rumors: RumorEvent list) : RumorEvent list =
        let cutoffDay = max 0L (rumorDayIndex nowTick - rumorRetentionDays)
        if rumorsNeedTrim cutoffDay rumors then
            rumors
            |> List.takeWhile (fun rumor -> rumor.DayIndex >= cutoffDay)
            |> List.truncate rumorCapacity
        else
            rumors

    /// 追加一条谣言并顺手裁剪工作集；容量内且新鲜时等价于 `rumor :: rumors`。
    let private consRumor (nowTick: int64) (rumor: RumorEvent) (rumors: RumorEvent list) : RumorEvent list =
        trimRumors nowTick (rumor :: rumors)

    let private latestRumorFor (receiver: NpcId) (world: World) : RumorEvent option =
        // 工作集最新在前且 Tick 非递增，故只需扫描新鲜窗口；窗口外条目本就会被过滤掉。
        world.Rumors
        |> List.takeWhile (fun rumor -> world.Tick - rumor.Tick <= rumorFreshnessTicks)
        |> List.filter (fun rumor ->
            rumor.Receiver = receiver
            && rumor.Tick <= world.Tick
            && rumorStrengthAt world.Tick rumor >= rumorMinimumStrength)
        |> List.sortByDescending (fun rumor ->
            let (RumorId id) = rumor.Id
            rumor.Tick, id)
        |> List.tryHead

    /// 工作集最新在前，头节点恒为最大 Id（每次追加 `max+1`），故 O(1) 取下一个 Id。
    /// 裁剪只丢尾部旧条目，不会丢头，因此该不变量在裁剪后仍成立。
    let private nextRumorId (world: World) : RumorId =
        match world.Rumors with
        | [] -> RumorId 0L
        | head :: _ ->
            let (RumorId id) = head.Id
            RumorId(id + 1L)

    let private dialogueAvailable (npc: Npc) : bool =
        npc.Mind.Action <> Sleep && npc.Mind.Action <> Chat

    let openDialogueMenu (world: World) : DialogueMenu option =
        let nearby =
            world.Npcs
            |> Array.choose (fun npc ->
                let dx = npc.Pos.X - world.Avatar.Pos.X
                let dy = npc.Pos.Y - world.Avatar.Pos.Y
                let distanceSq = dx * dx + dy * dy
                if distanceSq <= chatRangeSq && dialogueAvailable npc then
                    Some(distanceSq, npc.Id)
                else None)
            |> Array.sortBy fst
        nearby
        |> Array.tryHead
        |> Option.map (fun (_, target) ->
            { Target = target
              Options = dialogueOptions })

    let private responseFor (intent: DialogueIntent) (personality: Personality) : DialogueResponse =
        match intent with
        | SmallTalk -> if personality.Extraversion >= 0.5f then Friendly else Reserved
        | AskHelp -> if personality.Honesty >= 0.4f then Helpful else Refused
        | OfferTrade -> Bargaining
        | Joke -> if personality.Extraversion >= 0.5f then Amused else Reserved
        | Apologize -> if personality.Aggression < 0.7f then Forgiving else Offended
        | Provoke -> if personality.Aggression >= 0.5f then Hostile else Offended

    let private dialogueSummary (outcome: DialogueOutcome) : string =
        sprintf "dialogue tick=%d actor=%A target=%A intent=%A response=%A valence=%.2f"
            outcome.Tick outcome.Actor outcome.Target outcome.Intent outcome.Response outcome.Valence

    let private rumorSummary (rumor: RumorEvent) : string =
        sprintf "rumor tick=%d source=%A narrator=%A receiver=%A depth=%d"
            rumor.Tick rumor.Source rumor.Narrator rumor.Receiver rumor.Depth

    let chooseDialogue (target: NpcId) (intent: DialogueIntent) (world: World) : DialogueResult =
        match findNpcIndex target world.Npcs with
        | None -> DialogueRejected(DialogueTargetNotFound, world)
        | Some targetIndex ->
            let targetNpc = world.Npcs.[targetIndex]
            let dx = targetNpc.Pos.X - world.Avatar.Pos.X
            let dy = targetNpc.Pos.Y - world.Avatar.Pos.Y
            if dx * dx + dy * dy > chatRangeSq then
                DialogueRejected(DialogueTargetOutOfRange, world)
            elif not (dialogueAvailable targetNpc) then
                DialogueRejected(DialogueTargetUnavailable, world)
            else
                let response = responseFor intent targetNpc.Mind.Personality
                let outcome =
                    { Tick = world.Tick
                      Actor = playerId
                      Target = target
                      Intent = intent
                      Response = response
                      Valence = valenceOfKind (Dialogue(target, intent, response)) }
                let rumor =
                    { Id = nextRumorId world
                      Tick = world.Tick
                      DayIndex = rumorDayIndex world.Tick
                      OriginTick = world.Tick
                      Source = playerId
                      Narrator = playerId
                      Receiver = target
                      Parent = None
                      Depth = 0
                      Strength = 1.0f }
                let newNpcs = Array.copy world.Npcs
                let targetMemory =
                    recordMemory world.Tick (Dialogue(playerId, intent, response)) targetNpc.Mind.Memory
                    |> recordMemory world.Tick (Rumor rumor.Id)
                newNpcs.[targetIndex] <- { targetNpc with Mind = { targetNpc.Mind with Memory = targetMemory } }
                let avatarMemory = recordMemory world.Tick (Dialogue(target, intent, response)) world.Avatar.Mind.Memory
                let event = { Tick = world.Tick; Kind = DialogueEvent outcome }
                let updated =
                    { world with
                        Avatar = { world.Avatar with Mind = { world.Avatar.Mind with Memory = avatarMemory } }
                        Npcs = newNpcs
                        Events = world.Events @ [ event ]
                        Rumors = consRumor world.Tick rumor world.Rumors }
                let withRumorAnnal =
                    appendAnnal
                        { Tick = world.Tick
                          Kind = RumorAnnal rumor
                          Summary = rumorSummary rumor }
                        updated
                let withDialogueAnnal =
                    appendAnnal
                        { Tick = world.Tick
                          Kind = DialogueAnnal outcome
                          Summary = dialogueSummary outcome }
                        withRumorAnnal
                DialogueSucceeded(outcome, withDialogueAnnal)

    let annalText (world: World) : string =
        let rows =
            world.Annals
            |> List.rev
            |> List.map (fun entry -> sprintf "tick=%d %s" entry.Tick entry.Summary)
        String.concat "\n" (sprintf "chronicle count=%d" world.Annals.Length :: rows)

    let observeVisible (bounds: VisibleBounds) (world: World) : Observation list =
        let inside (pos: Vec2) =
            pos.X >= bounds.Min.X
            && pos.X <= bounds.Max.X
            && pos.Y >= bounds.Min.Y
            && pos.Y <= bounds.Max.Y
        world.Npcs
        |> Array.toList
        |> List.filter (fun npc -> inside npc.Pos)
        |> List.map (fun npc ->
            { Id = npc.Id
              Pos = npc.Pos
              Needs = npc.Mind.Needs
              Ranked = rankNeeds npc.Mind.Needs
              RecentMemory = List.truncate 8 npc.Mind.Memory })

    let private rumorIsDuplicate (request: ChatRequest) (parent: RumorEvent option) (world: World) : bool =
        let parentId = parent |> Option.map (fun rumor -> rumor.Id)
        world.Rumors
        |> List.takeWhile (fun rumor -> world.Tick - rumor.Tick <= rumorFreshnessTicks)
        |> List.exists (fun rumor ->
            rumor.Narrator = request.Narrator
            && rumor.Receiver = request.Receiver
            && rumor.Parent = parentId
            && rumor.Tick <= world.Tick
            && rumorStrengthAt world.Tick rumor >= rumorMinimumStrength)

    type private ChatParticipant =
        | AvatarParticipant
        | NpcParticipant of int

    let private findChatParticipant (id: NpcId) (world: World) : ChatParticipant option =
        if id = playerId then
            Some AvatarParticipant
        else
            findNpcIndex id world.Npcs |> Option.map NpcParticipant

    let private participantPosition (participant: ChatParticipant) (world: World) : Vec2 =
        match participant with
        | AvatarParticipant -> world.Avatar.Pos
        | NpcParticipant index -> world.Npcs.[index].Pos

    let private participantChatable (participant: ChatParticipant) (world: World) : bool =
        match participant with
        | AvatarParticipant -> true
        | NpcParticipant index -> chatableForChat world.Npcs.[index]

    let private markChat (participant: ChatParticipant) (other: NpcId) (otherPos: Vec2) (world: World) : World =
        match participant with
        | AvatarParticipant ->
            let memory = recordMemory world.Tick (Chatted other) world.Avatar.Mind.Memory
            { world with Avatar = { world.Avatar with Mind = { world.Avatar.Mind with Memory = memory } } }
        | NpcParticipant index ->
            let newNpcs = Array.copy world.Npcs
            let npc = newNpcs.[index]
            let memory = recordMemory world.Tick (Chatted other) npc.Mind.Memory
            newNpcs.[index] <-
                { npc with
                    Mind =
                        { npc.Mind with
                            Action = Chat
                            Target = otherPos
                            ActionAge = 0L
                            EffectDone = false
                            Memory = memory } }
            { world with Npcs = newNpcs }

    let chat (request: ChatRequest) (world: World) : ChatResult =
        match findChatParticipant request.Narrator world, findChatParticipant request.Receiver world with
        | None, _ -> ChatRejected(NarratorNotFound, world)
        | _, None -> ChatRejected(ReceiverNotFound, world)
        | Some _, Some _ when request.Narrator = request.Receiver -> ChatRejected(ChatSameParticipant, world)
        | Some narrator, Some receiver ->
            if not (participantChatable narrator world) || not (participantChatable receiver world) then
                ChatRejected(ParticipantNotChatable, world)
            else
                let parent = latestRumorFor request.Narrator world
                let narratorPos = participantPosition narrator world
                let receiverPos = participantPosition receiver world
                let chatted =
                    world
                    |> markChat narrator request.Receiver receiverPos
                    |> markChat receiver request.Narrator narratorPos
                if rumorIsDuplicate request parent world then
                    ChatSucceeded(None, chatted)
                else
                    let rumor =
                        match parent with
                        | None ->
                            { Id = nextRumorId world
                              Tick = world.Tick
                              DayIndex = rumorDayIndex world.Tick
                              OriginTick = world.Tick
                              Source = request.Narrator
                              Narrator = request.Narrator
                              Receiver = request.Receiver
                              Parent = None
                              Depth = 0
                              Strength = 1.0f }
                        | Some parent ->
                            { Id = nextRumorId world
                              Tick = world.Tick
                              DayIndex = rumorDayIndex world.Tick
                              OriginTick = parent.OriginTick
                              Source = parent.Source
                              Narrator = request.Narrator
                              Receiver = request.Receiver
                              Parent = Some parent.Id
                              Depth = parent.Depth + 1
                              Strength = rumorStrengthAt world.Tick parent }
                    let withReceiverRumor =
                        match receiver with
                        | AvatarParticipant ->
                            let memory = recordMemory world.Tick (Rumor rumor.Id) chatted.Avatar.Mind.Memory
                            { chatted with Avatar = { chatted.Avatar with Mind = { chatted.Avatar.Mind with Memory = memory } } }
                        | NpcParticipant index ->
                            let newNpcs = Array.copy chatted.Npcs
                            let npc = newNpcs.[index]
                            newNpcs.[index] <-
                                { npc with
                                    Mind = { npc.Mind with Memory = recordMemory world.Tick (Rumor rumor.Id) npc.Mind.Memory } }
                            { chatted with Npcs = newNpcs }
                    let updated = { withReceiverRumor with Rumors = consRumor world.Tick rumor world.Rumors }
                    ChatSucceeded(
                        Some rumor,
                        appendAnnal
                            { Tick = world.Tick
                              Kind = RumorAnnal rumor
                              Summary = rumorSummary rumor }
                            updated)

    let rumorPath (world: World) (target: RumorId) : RumorEvent list =
        let rec collect (visited: Set<RumorId>) (current: RumorId) (acc: RumorEvent list) =
            if Set.contains current visited then []
            else
                match world.Rumors |> List.tryFind (fun rumor -> rumor.Id = current) with
                | None -> []
                | Some rumor ->
                    let nextVisited = Set.add current visited
                    match rumor.Parent with
                    | None -> rumor :: acc
                    | Some parent -> collect nextVisited parent (rumor :: acc)
        collect Set.empty target []

    let rumorTraceText (world: World) : string =
        let rumorIdValue (RumorId id) = id
        let npcIdValue (NpcId id) = id
        let invariant = System.Globalization.CultureInfo.InvariantCulture
        let ordered = world.Rumors |> List.sortBy (fun rumor -> rumorIdValue rumor.Id)
        let rows =
            ordered
            |> List.map (fun rumor ->
                let parent = rumor.Parent |> Option.map rumorIdValue |> Option.map string |> Option.defaultValue "-"
                let path =
                    rumorPath world rumor.Id
                    |> List.map (fun item -> item.Id |> rumorIdValue |> string)
                    |> String.concat ","
                let pathText = if path = "" then "-" else path
                sprintf "rumor id=%d tick=%d origin_tick=%d source=%d narrator=%d receiver=%d parent=%s depth=%d strength=%s path=%s"
                    (rumorIdValue rumor.Id)
                    rumor.Tick
                    rumor.OriginTick
                    (npcIdValue rumor.Source)
                    (npcIdValue rumor.Narrator)
                    (npcIdValue rumor.Receiver)
                    parent
                    rumor.Depth
                    (rumor.Strength.ToString("0.000000", invariant))
                    pathText)
        let header = sprintf "rumor_trace tick=%d count=%d" world.Tick world.Rumors.Length
        String.concat "\n" (header :: rows)

    let private stepNpc (tick: int64) (npcs: Npc[]) (pending: ResizeArray<InteractionEvent>) (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 night = isNightTick tick
        let age = npc.Mind.ActionAge + 1L
        let urgent = needsUrgent decayed
        let maxStep = npcSpeed * dtSecondsF
        let mind0 =
            { npc.Mind with
                Needs = decayed
                ActionAge = age
                HungerFlagged =
                    if decayed.Hunger < urgentThreshold then npc.Mind.HungerFlagged else false }
        let mind1 =
            if decayed.Hunger < urgentThreshold && not npc.Mind.HungerFlagged then
                { mind0 with Memory = recordMemory tick Hungry mind0.Memory; HungerFlagged = true }
            else mind0
        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 pos npcs with
                | Some partner ->
                    pending.Add { Tick = tick; Kind = ChatInit(npc.Id, partner) }
                    { npc with Pos = pos; Mind = mind }
                | None ->
                    if action = mind.Action then
                        if resetOnSame then
                            { npc with Pos = pos; Mind = { mind with ActionAge = 0L; EffectDone = false } }
                        else { npc with Pos = pos; Mind = mind }
                    else
                        { npc with
                            Pos = pos
                            Mind = { mind with Action = action; Target = actionTarget action; ActionAge = 0L; EffectDone = false } }
            elif action = mind.Action then
                if resetOnSame then
                    { npc with Pos = pos; Mind = { mind with ActionAge = 0L; EffectDone = false } }
                else { npc with Pos = pos; Mind = mind }
            else
                { npc with
                    Pos = pos
                    Mind = { mind with Action = action; Target = actionTarget action; ActionAge = 0L; EffectDone = false } }
        if mind1.Action = Chat then
            let struct (nextPos, _) = moveToward npc.Pos mind1.Target maxStep
            if age >= chatTicks then
                let needs2 = applyActionEffect Chat mind1.Needs
                switchTo true { mind1 with Needs = needs2 } needs2 nextPos
            else
                { npc with Pos = nextPos; Mind = mind1 }
        else
            let target = actionTarget npc.Mind.Action
            let struct (nextPos, arrived) = moveToward npc.Pos target maxStep
            if arrived then
                let needs2, mem2 =
                    if mind1.EffectDone then mind1.Needs, mind1.Memory
                    else
                        let mem =
                            match actionMemoryKind mind1.Action with
                            | Some k -> recordMemory tick k mind1.Memory
                            | None -> mind1.Memory
                        applyActionEffect mind1.Action mind1.Needs, mem
                let mind2 = { mind1 with Needs = needs2; Memory = mem2; EffectDone = true }
                if age >= minActionTicks || urgent then
                    switchTo true mind2 needs2 nextPos
                else
                    { npc with Pos = nextPos; Mind = mind2 }
            elif urgent && age < minActionTicks then
                switchTo false mind1 decayed nextPos
            else
                { npc with Pos = nextPos; Mind = mind1 }

    let step (ts: TimeStep) (world: World) : World =
        let tick = world.Tick + 1L
        let maxX = float32 (mapWidthTiles * tilePixels - tilePixels)
        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
        let pending = ResizeArray<InteractionEvent> ()
        let oldNpcs = world.Npcs
        let newNpcs = Array.copy oldNpcs
        for i in 0 .. newNpcs.Length - 1 do
            newNpcs.[i] <- stepNpc tick oldNpcs pending newNpcs.[i]
        let queue = if pending.Count = 0 then world.Events else world.Events @ List.ofSeq pending
        let avatarNeeds =
            needsClamp
                { Hunger = world.Avatar.Mind.Needs.Hunger - hungerDecayPerTick
                  Energy = world.Avatar.Mind.Needs.Energy - energyDecayPerTick
                  Social = world.Avatar.Mind.Needs.Social - socialDecayPerTick
                  Money = world.Avatar.Mind.Needs.Money - moneyDecayPerTick }
        let avatarMemory, avatarFlagged =
            if avatarNeeds.Hunger < urgentThreshold && not world.Avatar.Mind.HungerFlagged then
                (recordMemory tick Hungry world.Avatar.Mind.Memory), true
            else
                world.Avatar.Mind.Memory, avatarNeeds.Hunger < urgentThreshold
        let avatarMind =
            { world.Avatar.Mind with
                Needs = avatarNeeds
                ActionAge = world.Avatar.Mind.ActionAge + 1L
                HungerFlagged = avatarFlagged
                Memory = avatarMemory }
        let baseWorld =
            { world with
                Tick = tick
                Time = float tick * dtSeconds
                Rng = rngNext
                Avatar =
                    { Pos =
                        { X = clamp (world.Avatar.Pos.X + dx) 0.0f maxX
                          Y = clamp (world.Avatar.Pos.Y + dy) 0.0f maxY }
                      Mind = avatarMind }
                Npcs = newNpcs }
        let mutable nextWorld = baseWorld
        for ev in queue do
            match ev.Kind with
            | ChatInit (a, b) ->
                match chat { Narrator = a; Receiver = b } nextWorld with
                | ChatSucceeded (_, updated) -> nextWorld <- updated
                | ChatRejected (_, _) -> ()
            | TradeEvent _ -> ()
            | DialogueEvent _ -> ()
        { nextWorld with Events = [] }

    // ---- 关系网派生：rel(i,j) = sum(Chatted valence * exp(-ln2*(now-tick)/HALF_LIFE))（真半衰：age=HALF_LIFE 处权重恰 0.5）----

    let relationDecayWeight (nowTick: int64) (eventTick: int64) : float32 =
        let age = float (nowTick - eventTick)
        float32 (exp (-(log 2.0) * age / float relationHalfLifeTicks))

    // 30x30 对称矩阵（对角线 0）：双向累加双方 Chatted 记忆的衰减 valence
    let relationMatrix (world: World) : float32[,] =
        let n = world.Npcs.Length
        let m = Array2D.zeroCreate n n
        for npc in world.Npcs do
            let i =
                match npc.Id with
                | NpcId i -> i
            for e in npc.Mind.Memory do
                match e.Kind with
                | Chatted partner when e.Tick <= world.Tick ->
                    let j =
                        match partner with
                        | NpcId j -> j
                    if i <> j && i < n && j < n then
                        let w = e.Valence * relationDecayWeight world.Tick e.Tick
                        m.[i, j] <- m.[i, j] + w
                        m.[j, i] <- m.[j, i] + w
                | _ -> ()
        m

    let relationCounts (m: float32[,]) : int[] =
        let n = Array2D.length1 m
        Array.init n (fun i ->
            let mutable c = 0
            for j in 0 .. n - 1 do
                if i <> j && abs m.[i, j] > relationThreshold then c <- c + 1
            c)