namespace LivingVillage.Kernel module Sim = [] type Vec2 = { X: float32 Y: float32 } [] type Avatar = { Pos: Vec2 } 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 NpcActionKind = | Eat | Sleep | Wander | Work | Chat type MemoryKind = | Meal | Rest | Pay | Hungry | Chatted of NpcId type MemoryEvent = { Tick: int64 Kind: MemoryKind Valence: float32 } type InteractionKind = | ChatInit of NpcId * NpcId type InteractionEvent = { Tick: int64 Kind: InteractionKind } [] type Mind = { Needs: Needs Personality: Personality Action: NpcActionKind Target: Vec2 ActionAge: int64 EffectDone: bool HungerFlagged: bool Memory: MemoryEvent list } [] type Npc = { Id: NpcId Pos: Vec2 Mind: Mind } [] type World = { Tick: int64 Time: float Rng: RngState Avatar: Avatar NoHost: NoHost Npcs: Npc[] Events: InteractionEvent list } let ticksPerSecond = 60L let secondsPerDay = 86400L let ticksPerDay = secondsPerDay * ticksPerSecond let dtSeconds = 1.0 / float ticksPerSecond let dtSecondsF = 1.0f / float32 ticksPerSecond let mapWidthTiles = 64 let mapHeightTiles = 48 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 // 关系网派生(纯函数;仅在 dump/视图打开时调用,不进 step 热路径) let relationHalfLifeTicks = ticksPerDay // HALF_LIFE = 1 模拟日(修复单位错误:原 86400L 实为 24 模拟分钟;1 模拟日 = ticksPerDay = 5,184,000 tick) let relationThreshold = 0.5f // |rel| > 0.5 视为有关系 let clamp (v: float32) (lo: float32) (hi: float32) : float32 = 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 | 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 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 _ -> 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 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 startAction = decideAction (isNightTick 0L) needs personality let npc = { Id = NpcId 0 Pos = { X = centerX; Y = centerY } Mind = { Needs = needs Personality = personality Action = startAction Target = actionTarget startAction ActionAge = 0L EffectDone = false HungerFlagged = false Memory = [] } } { Tick = 0L Time = 0.0 Rng = Rng.ofSeed seed Avatar = { Pos = { X = centerX; Y = centerY } } NoHost = { Reserved = 0UL } Npcs = [| npc |] Events = [] } 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 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 Mind = { Needs = needs Personality = personality Action = startAction Target = actionTarget startAction ActionAge = 0L EffectDone = false HungerFlagged = false Memory = [] } }) { base_ with Npcs = npcs } 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 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 private applyChatInit (tick: int64) (a: NpcId) (b: NpcId) (npcs: Npc[]) : Npc[] = if a = b then npcs else let mutable ia = -1 let mutable ib = -1 for i in 0 .. npcs.Length - 1 do let id = npcs.[i].Id if id = a then ia <- i elif id = b then ib <- i if ia < 0 || ib < 0 then npcs else let na = npcs.[ia] let nb = npcs.[ib] if chatableForChat na && chatableForChat nb && ia <> ib then npcs.[ia] <- { na with Mind = { na.Mind with Action = Chat Target = nb.Pos ActionAge = 0L EffectDone = false Memory = recordMemory tick (Chatted b) na.Mind.Memory } } npcs.[ib] <- { nb with Mind = { nb.Mind with Action = Chat Target = na.Pos ActionAge = 0L EffectDone = false Memory = recordMemory tick (Chatted a) nb.Mind.Memory } } npcs else npcs 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 if queue.Length > 0 then for ev in queue do match ev.Kind with | ChatInit (a, b) -> applyChatInit ev.Tick a b newNpcs |> ignore { 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 } } NoHost = world.NoHost Npcs = newNpcs 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)