namespace LivingVillage.Kernel module Sim = [] type Vec2 = { X: float32 Y: float32 } type Input = { MoveX: float32 MoveY: float32 } type TimeStep = { Input: Input } [] type NoHost = { Reserved: uint64 } [] type NpcId = | NpcId of int [] type Needs = { Hunger: float32 Energy: float32 Social: float32 Money: float32 } [] 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 [] 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 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 } [] type Mind = { Needs: Needs Personality: Personality Action: NpcActionKind Target: Vec2 ActionAge: int64 EffectDone: bool HungerFlagged: bool Memory: MemoryEvent list } [] type Avatar = { Pos: Vec2 Mind: Mind } [] type Npc = { Id: NpcId Pos: Vec2 Inventory: Map Mind: Mind } [] 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 // 关系网派生(纯函数;仅在 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) : int = inventory |> Map.tryFind item |> Option.defaultValue 0 let private changeInventory (item: ItemKind) (delta: int) (inventory: Map) : Map = 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 let private latestRumorFor (receiver: NpcId) (world: World) : RumorEvent option = world.Rumors |> List.filter (fun rumor -> rumor.Receiver = receiver && rumor.Tick <= world.Tick && world.Tick - rumor.Tick <= rumorFreshnessTicks && rumorStrengthAt world.Tick rumor >= rumorMinimumStrength) |> List.sortByDescending (fun rumor -> let (RumorId id) = rumor.Id rumor.Tick, id) |> List.tryHead let private nextRumorId (world: World) : RumorId = let maxId = world.Rumors |> List.fold (fun current rumor -> let (RumorId id) = rumor.Id max current id) -1L RumorId(maxId + 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 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 = 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.exists (fun rumor -> rumor.Narrator = request.Narrator && rumor.Receiver = request.Receiver && rumor.Parent = parentId && rumor.Tick <= world.Tick && world.Tick - rumor.Tick <= rumorFreshnessTicks && 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 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 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 = 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) (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) (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 () 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)