module Program open System open LivingVillage.Kernel open LivingVillage.Kernel.Sim let ticksPerSecond = 60L let secondsPerDay = 86400L let ticksPerDay = secondsPerDay * ticksPerSecond let segmentTicks = 900L let summaryInterval = 5000L let zeroInput = { MoveX = 0.0f; MoveY = 0.0f } type Driver = { Rng: RngState Until: int64 Input: Input } let nextSegment (rng: RngState) (until: int64) : Driver = let a, r1 = Rng.nextUInt64 rng let m, r2 = Rng.nextUInt64 r1 let diag = 0.70710678f let dirX, dirY = match int (a &&& 7UL) with | 0 -> 1.0f, 0.0f | 1 -> diag, diag | 2 -> 0.0f, 1.0f | 3 -> -diag, diag | 4 -> -1.0f, 0.0f | 5 -> -diag, -diag | 6 -> 0.0f, -1.0f | _ -> diag, -diag let mag = match int (m % 3UL) with | 0 -> 0.4f | 1 -> 0.7f | _ -> 1.0f { Rng = r2 Until = until + segmentTicks Input = { MoveX = dirX * mag; MoveY = dirY * mag } } let actionName (k: NpcActionKind) : string = match k with | Eat -> "eat" | Sleep -> "sleep" | Wander -> "wander" | Work -> "work" | Chat -> "chat" let npcIndex (id: NpcId) : int = match id with NpcId i -> i let actionDistribution (npcs: Npc[]) : int * int * int * int * int = let counts = npcs |> Array.fold (fun (e, s, w, k, c) npc -> match npc.Mind.Action with | Eat -> (e + 1, s, w, k, c) | Sleep -> (e, s + 1, w, k, c) | Wander -> (e, s, w + 1, k, c) | Work -> (e, s, w, k + 1, c) | Chat -> (e, s, w, k, c + 1)) (0, 0, 0, 0, 0) counts type RunStats = { ChatsPerNpc: int64[] NonFinite: int64 OutOfBounds: int64 World: World } let runSimulation (verbose: bool) (days: int64) (seed: uint64) (npcCount: int) : RunStats = let totalTicks = days * ticksPerDay if verbose then printfn "living-village headless days=%d seed=%d npcs=%d ticks=%d tickrate=%d" days seed npcCount totalTicks ticksPerSecond let mutable world = Sim.initialWorldN seed npcCount let mutable driver = { Rng = Rng.ofSeed seed; Until = segmentTicks; Input = zeroInput } let maxX = float32 (Sim.mapWidthTiles * Sim.tilePixels - Sim.tilePixels) let maxY = float32 (Sim.mapHeightTiles * Sim.tilePixels - Sim.tilePixels) let mutable nonFinite = 0L let mutable outOfBounds = 0L let mutable t = 0L let mutable lastAction = (world.Npcs.[0]).Mind.Action let mutable lastStart = 0L let mutable switchCount = 0L let mutable switchDurSum = 0L let mutable sleepNight = 0L let mutable sleepDay = 0L let mutable nightTicks = 0L let mutable dayTicks = 0L let npcTotal = Array.create npcCount 0L let lastActions = Array.create npcCount (world.Npcs.[0]).Mind.Action let mutable chatsWindowStart = 0L while t < totalTicks do let d, input = if t < driver.Until then driver, driver.Input else let d = nextSegment driver.Rng driver.Until d, d.Input driver <- d world <- Sim.step { Input = input } world t <- t + 1L let nightNow = Sim.isNightTick t if nightNow then nightTicks <- nightTicks + 1L else dayTicks <- dayTicks + 1L for npc in world.Npcs do let idx = npcIndex npc.Id if npc.Mind.Action = Chat && lastActions.[idx] <> Chat then npcTotal.[idx] <- npcTotal.[idx] + 1L lastActions.[idx] <- npc.Mind.Action let head = world.Npcs.[0] if head.Mind.Action = Sleep then if nightNow then sleepNight <- sleepNight + 1L else sleepDay <- sleepDay + 1L if head.Mind.Action <> lastAction then switchCount <- switchCount + 1L switchDurSum <- switchDurSum + (t - lastStart) lastStart <- t lastAction <- head.Mind.Action let p = world.Avatar.Pos if Single.IsNaN p.X || Single.IsNaN p.Y || Single.IsInfinity p.X || Single.IsInfinity p.Y then nonFinite <- nonFinite + 1L if p.X < 0.0f || p.X > maxX || p.Y < 0.0f || p.Y > maxY then outOfBounds <- outOfBounds + 1L if verbose && t % summaryInterval = 0L then let eat, sleep, wander, work, chat = actionDistribution world.Npcs let chatsTotal = Array.sum npcTotal let day = float t / float ticksPerDay printfn "summary tick=%d day=%.4f eat=%d sleep=%d wander=%d work=%d chat=%d chats_window=%d" t day eat sleep wander work chat (chatsTotal - chatsWindowStart) chatsWindowStart <- chatsTotal if verbose then let segments = switchCount + 1L let avgActionTicks = float (switchDurSum + (totalTicks - lastStart)) / float segments let nightPct = if nightTicks > 0L then 100.0 * float sleepNight / float nightTicks else 0.0 let dayPct = if dayTicks > 0L then 100.0 * float sleepDay / float dayTicks else 0.0 let npc0 = world.Npcs.[0] let memCount = List.length npc0.Mind.Memory let lastValence = match List.tryHead npc0.Mind.Memory with | Some e -> e.Valence | None -> 0.0f printfn "npc=%A action_switches=%d avg_action_ticks=%.1f sleep_night_ticks=%d sleep_day_ticks=%d sleep_night_pct=%.2f sleep_day_pct=%.2f mem_count=%d last_valence=%.2f" npc0.Id switchCount avgActionTicks sleepNight sleepDay nightPct dayPct memCount lastValence let chatsTotal = Array.sum npcTotal let minChats = if npcCount > 0 then Array.min npcTotal else 0L let maxChats = if npcCount > 0 then Array.max npcTotal else 0L let avgChats = if npcCount > 0 then float chatsTotal / float npcCount else 0.0 printfn "chats_total=%d chats_min=%d chats_max=%d chats_avg=%.2f" chatsTotal minChats maxChats avgChats printfn "done tick=%d non-finite=%d out-of-bounds=%d" world.Tick nonFinite outOfBounds { ChatsPerNpc = npcTotal NonFinite = nonFinite OutOfBounds = outOfBounds World = world } let dumpRelations (world: World) : unit = let m = Sim.relationMatrix world let n = Array2D.length1 m let ci = System.Globalization.CultureInfo.InvariantCulture printfn "relations tick=%d npcs=%d half_life_ticks=%d threshold=%.2f" world.Tick n Sim.relationHalfLifeTicks Sim.relationThreshold for i in 0 .. n - 1 do let row = Array.init n (fun j -> m.[i, j].ToString("0.000", ci)) printfn "rel[%d] %s" i (String.concat " " row) let counts = Sim.relationCounts m let cells = Array.mapi (fun i c -> $"{i}:{c}") counts printfn "rel_counts %s" (String.concat " " cells) printfn "rel_total=%d rel_max=%d rel_min=%d" (Array.sum counts) (Array.max counts) (Array.min counts) let dumpRumors (world: World) : unit = printfn "%s" (Sim.rumorTraceText world) type M5SmokeResult = { Passed: bool Failure: string MenuOptions: int ObservationCount: int RumorPathLength: int Chronicle: string RumorTrace: string } module M5Smoke = let private atNpc (id: int) (world: World) : World = let npc = world.Npcs.[id] { world with Avatar = { world.Avatar with Pos = npc.Pos } } let private readyForChat (world: World) : World = { world with Npcs = world.Npcs |> Array.map (fun npc -> { npc with Mind = { npc.Mind with Action = Wander Target = actionTarget Wander ActionAge = minActionTicks EffectDone = true } }) } let private atTick (tick: int64) (world: World) : World = { world with Tick = tick Time = float tick * dtSeconds } let private chat (narrator: int) (receiver: int) (world: World) : World = match Sim.chat { Narrator = NpcId narrator; Receiver = NpcId receiver } world with | ChatSucceeded (_, next) -> next | ChatRejected (failure, _) -> failwithf "M5 smoke chat rejected: %A" failure let run () : M5SmokeResult = let initial = Sim.initialWorldN 7UL 4 |> readyForChat |> atNpc 0 let afterStep = Sim.step { Input = zeroInput } initial let needsChanged = afterStep.Avatar.Mind.Needs <> initial.Avatar.Mind.Needs let needs = Sim.needsPanel afterStep let bounds = { Min = { X = initial.Avatar.Pos.X - Sim.chatRangePx; Y = initial.Avatar.Pos.Y - Sim.chatRangePx } Max = { X = initial.Avatar.Pos.X + Sim.chatRangePx; Y = initial.Avatar.Pos.Y + Sim.chatRangePx } } let observations = Sim.observeVisible bounds initial let menu = Sim.openDialogueMenu initial let menuOptions = menu |> Option.map (fun item -> item.Options.Length) |> Option.defaultValue 0 let afterDialogue, dialogueRecorded = match Sim.chooseDialogue (NpcId 0) SmallTalk initial with | DialogueSucceeded (_, next) -> next, true | DialogueRejected (_, next) -> next, false let first = afterDialogue |> atTick ticksPerDay |> readyForChat |> chat 0 1 let second = first |> atTick (2L * ticksPerDay) |> readyForChat |> chat 1 2 let finalWorld = second |> atTick (3L * ticksPerDay) |> readyForChat |> chat 2 -1 let finalRumor = finalWorld.Rumors |> List.sortBy (fun rumor -> rumor.Id) |> List.last let path = Sim.rumorPath finalWorld finalRumor.Id let expectedChain = [ (playerId, NpcId 0) (playerId, NpcId 1) (playerId, NpcId 2) (playerId, playerId) ] let actualChain = path |> List.map (fun rumor -> rumor.Source, rumor.Receiver) let chronicle = Sim.annalText finalWorld let rumorTrace = Sim.rumorTraceText finalWorld let checks = [ menuOptions = 6 needs.Needs = afterStep.Avatar.Mind.Needs needsChanged observations |> List.exists (fun observation -> observation.Id = NpcId 0) dialogueRecorded finalRumor.Source = playerId finalRumor.Receiver = playerId finalRumor.Narrator = NpcId 2 finalRumor.Depth = 3 actualChain = expectedChain chronicle.Contains("dialogue") ] let failure = checks |> List.mapi (fun index passed -> if passed then None else Some(sprintf "check_%d" (index + 1))) |> List.choose id |> String.concat "," { Passed = failure = "" Failure = failure MenuOptions = menuOptions ObservationCount = observations.Length RumorPathLength = path.Length Chronicle = chronicle RumorTrace = rumorTrace } let runM5Smoke () : int = let result = M5Smoke.run () printfn "m5_smoke menu_options=%d observations=%d rumor_path=%d" result.MenuOptions result.ObservationCount result.RumorPathLength printfn "m5_chronicle=%s" (result.Chronicle.Replace('\n', '|')) printfn "m5_rumor_trace=%s" (result.RumorTrace.Replace('\n', '|')) printfn "M5_ACCEPTANCE=%s" (if result.Passed then "PASS" else "FAIL") if result.Passed then 0 else 1 let replayRumors (days: int64) (seed: uint64) (npcCount: int) (world: World) : bool = let expected = Sim.rumorTraceText world let replayed = runSimulation false days seed npcCount |> fun stats -> Sim.rumorTraceText stats.World let same = expected = replayed printfn "rumor_replay=%s tick=%d count=%d" (if same then "PASS" else "FAIL") world.Tick world.Rumors.Length same let gini (xs: int64[]) : float = let n = float xs.Length let s = float (Array.sum xs) if n <= 1.0 || s <= 0.0 then 0.0 else let mutable num = 0.0 for xi in xs do for xj in xs do num <- num + abs (float xi - float xj) num / (2.0 * n * n * (s / n)) type WorldVerdict = { Line: string Ok: bool CheckOld: bool Ratio: float Gini: float } let evalWorld (days: int64) (k: int) : WorldVerdict = let seed = 42UL + uint64 k let stats = runSimulation false days seed Sim.npcCount let m = Sim.relationMatrix stats.World let n = Array2D.length1 m let mutable hasNonFinite = stats.NonFinite > 0L for i in 0 .. n - 1 do for j in 0 .. n - 1 do if Single.IsNaN m.[i, j] || Single.IsInfinity m.[i, j] then hasNonFinite <- true let chats = stats.ChatsPerNpc let chatsTotal = Array.sum chats let chatsAvg = float chatsTotal / float chats.Length let chatsMax = if chats.Length > 0 then Array.max chats else 0L let ratio = if chatsAvg > 0.0 then float chatsMax / chatsAvg else 0.0 let g = gini chats let counts = Sim.relationCounts m let cntMax = if counts.Length > 0 then Array.max counts else 0 let cntMin = if counts.Length > 0 then Array.min counts else 0 let connected = Array.fold (fun acc c -> if c > 0 then acc + 1 else acc) 0 counts let connectedNeed = int (System.Math.Ceiling(0.6 * float chats.Length)) let checkA = ratio > 2.0 let checkB = connected >= connectedNeed let checkC = not hasNonFinite let checkOld = cntMax > 2 * cntMin let ok = checkA && checkB && checkC let line = sprintf "world=%d seed=%d chats_max=%d chats_avg=%.2f ratio=%.3f gini=%.3f relcnt_max=%d relcnt_min=%d relconn=%d/%d nonfinite=%d check_a=%s check_b=%s check_c=%s old_crit=%s %s" k seed chatsMax chatsAvg ratio g cntMax cntMin connected connectedNeed stats.NonFinite (if checkA then "PASS" else "FAIL") (if checkB then "PASS" else "FAIL") (if checkC then "PASS" else "FAIL") (if checkOld then "PASS" else "FAIL") (if ok then "OK" else "BAD") { Line = line; Ok = ok; CheckOld = checkOld; Ratio = ratio; Gini = g } let runBatch (worlds: int) (days: int64) : int = printfn "batch worlds=%d days=%d half_life_ticks=%d rel_threshold=%.2f" worlds days Sim.relationHalfLifeTicks Sim.relationThreshold // 判据语义（M3c 修正）： // (a) chats max/avg > 2.0 —— 行为分布非均匀（观测值，仍为 pass 条件） // (b) 至少有一条 |r|>阈值 关系的 NPC 人数 >= 总人数 60% —— 关系网基本连通； // gini 与 ratio 仅作观测打印，不再作为 pass 条件（旧判据 cntMax>2*cntMin 对 // 明星集中型分布过严，relcnt_max=0 即判死，与"非均匀分布"的验收目标不符） // (c) 无 NaN/Inf printfn "checks: (a) chats max/avg > 2.0 (b) npcs_with_relation >= 0.6*npc_count (c) no NaN (old) relcnt_max > 2*relcnt_min (report only)" // 世界间相互独立（seed=42+k，逐世界确定性），可安全并行；输出仍按 world 序号 // 顺序打印，逐行内容与串行版本逐字节一致。LV_BATCH_WORKERS 可覆盖（默认 modest 4）。 let workers = match Environment.GetEnvironmentVariable "LV_BATCH_WORKERS" with | null | "" -> min 4 Environment.ProcessorCount | v -> match Int32.TryParse v with true, n when n > 0 -> min n Environment.ProcessorCount | _ -> min 4 Environment.ProcessorCount printfn "workers=%d" workers let results = Array.zeroCreate worlds System.Threading.Tasks.Parallel.For (0, worlds, System.Threading.Tasks.ParallelOptions(MaxDegreeOfParallelism = workers), fun k -> results.[k] <- evalWorld days k) |> ignore let mutable passed = 0 let mutable failed = 0 let mutable oldPassed = 0 let ratios = ResizeArray () let ginis = ResizeArray () let sw = System.Diagnostics.Stopwatch.StartNew() for r in results do printfn "%s" r.Line if r.Ok then passed <- passed + 1 else failed <- failed + 1 if r.CheckOld then oldPassed <- oldPassed + 1 ratios.Add r.Ratio ginis.Add r.Gini sw.Stop() let allPass = failed = 0 printfn "batch_summary worlds=%d passed=%d failed=%d old_passed=%d/%d ratio_min=%.3f ratio_max=%.3f gini_min=%.3f gini_max=%.3f elapsed_s=%.1f" worlds passed failed oldPassed worlds (Seq.min ratios) (Seq.max ratios) (Seq.min ginis) (Seq.max ginis) sw.Elapsed.TotalSeconds printfn "M3_ACCEPTANCE=%s" (if allPass then "PASS" else "FAIL") if allPass then 0 else 1 [] let main argv = let rec parse (i: int) (days: int64 option) (seed: uint64 option) (npc: int option) (dump: bool) (rumorTrace: bool) (rumorReplay: bool) (m5Smoke: bool) (batch: (int * int64) option) : Result = if i >= argv.Length then match batch with | Some(k, d) -> Ok(defaultArg days 1L, defaultArg seed 42UL, defaultArg npc 30, dump, rumorTrace, rumorReplay, m5Smoke, Some(k, d)) | None -> match days, seed, npc with | Some d, Some s, Some n -> Ok(d, s, n, dump, rumorTrace, rumorReplay, m5Smoke, None) | _ when m5Smoke -> Ok(defaultArg days 1L, defaultArg seed 42UL, defaultArg npc 30, dump, rumorTrace, rumorReplay, true, None) | _ -> Error "missing --days/--seed" else match argv.[i] with | "--days" when i + 1 < argv.Length -> (match Int64.TryParse argv.[i + 1] with | true, d when d > 0L -> parse (i + 2) (Some d) seed npc dump rumorTrace rumorReplay m5Smoke batch | _ -> Error $"invalid --days '{argv.[i + 1]}'") | "--seed" when i + 1 < argv.Length -> (match UInt64.TryParse argv.[i + 1] with | true, s -> parse (i + 2) days (Some s) npc dump rumorTrace rumorReplay m5Smoke batch | _ -> Error $"invalid --seed '{argv.[i + 1]}'") | "--npc" when i + 1 < argv.Length -> (match Int32.TryParse argv.[i + 1] with | true, n when n > 0 && n <= 1000 -> parse (i + 2) days seed (Some n) dump rumorTrace rumorReplay m5Smoke batch | _ -> Error $"invalid --npc '{argv.[i + 1]}'") | "--dump-relations" -> parse (i + 1) days seed npc true rumorTrace rumorReplay m5Smoke batch | "--dump-rumors" -> parse (i + 1) days seed npc dump true rumorReplay m5Smoke batch | "--replay-rumors" -> parse (i + 1) days seed npc dump rumorTrace true m5Smoke batch | "--m5-smoke" -> parse (i + 1) days seed npc dump rumorTrace rumorReplay true batch | "--batch" when i + 2 < argv.Length -> match Int32.TryParse argv.[i + 1], Int64.TryParse argv.[i + 2] with | (true, k), (true, d) when k > 0 && d > 0L -> parse (i + 3) days seed npc dump rumorTrace rumorReplay m5Smoke (Some(k, d)) | _ -> Error $"invalid --batch '{argv.[i + 1]} {argv.[i + 2]}'" | other -> Error $"unknown argument '{other}'" match parse 0 None None (Some 30) false false false false None with | Ok(days, seed, npc, dump, rumorTrace, rumorReplay, m5Smoke, batch) -> match m5Smoke, batch with | true, Some _ -> eprintfn "headless: --m5-smoke cannot be combined with --batch" 2 | true, None -> runM5Smoke () | false, Some(k, d) when rumorTrace || rumorReplay -> eprintfn "headless: rumor trace/replay cannot be combined with --batch" 2 | false, Some(k, d) -> runBatch k d | false, None -> let stats = runSimulation true days seed npc if dump then dumpRelations stats.World if rumorTrace then dumpRumors stats.World let replayOk = if rumorReplay then replayRumors days seed npc stats.World else true if stats.NonFinite > 0L || stats.OutOfBounds > 0L || not replayOk then 1 else 0 | Error msg -> eprintfn $"headless: {msg}" eprintfn "usage: dotnet run -c Release --project src/LivingVillage.Headless -- --days N --seed S [--npc N] [--dump-relations] [--dump-rumors] [--replay-rumors] | --m5-smoke | --batch K D" 2