path: root/src/LivingVillage.Headless/Program.fs

module Program

open System
open System.IO
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 runSimulationCore (verbose: bool) (days: int64) (seed: uint64) (npcCount: int) (onSimDay: int64 -> unit) : 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
        if t % ticksPerDay = 0L then onSimDay (t / ticksPerDay)
        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 runSimulation (verbose: bool) (days: int64) (seed: uint64) (npcCount: int) : RunStats =
    runSimulationCore verbose days seed npcCount ignore

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 }

type M6aSmokeSnapshot =
    { Before: World
      Restored: World
      Continued: World
      RestoredContinued: World }

module M6aSmoke =

    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 dialogue (world: World) : World =
        match Sim.chooseDialogue (NpcId 0) SmallTalk (atNpc 0 world) with
        | DialogueSucceeded (_, next) -> next
        | DialogueRejected (failure, _) -> failwithf "M6a smoke dialogue rejected: %A" failure

    let private chat (narrator: int) (receiver: int) (world: World) : World =
        match Sim.chat { Narrator = NpcId narrator; Receiver = NpcId receiver } (readyForChat world) with
        | ChatSucceeded (Some _, next) -> next
        | ChatSucceeded (None, _) -> failwith "M6a smoke chat did not create a rumor"
        | ChatRejected (failure, _) -> failwithf "M6a smoke chat rejected: %A" failure

    let private trade (world: World) : World =
        match Sim.trade { Buyer = NpcId 0; Seller = NpcId 1; Item = Food; Quantity = 1 } world with
        | TradeSucceeded next -> next
        | TradeRejected (failure, _) -> failwithf "M6a smoke trade rejected: %A" failure

    let private inputs =
        [ { MoveX = 0.5f; MoveY = -0.25f }
          { MoveX = 0.0f; MoveY = 0.0f }
          { MoveX = -1.0f; MoveY = 0.75f }
          { MoveX = 0.25f; MoveY = 0.0f } ]

    let private advance (inputs: Input list) (world: World) : World =
        inputs |> List.fold (fun current input -> Sim.step { Input = input } current) world

    let run () : Result<M6aSmokeSnapshot, string> =
        let path = Path.Combine(Path.GetTempPath(), sprintf "living-village-m6a-%s.save" (Guid.NewGuid().ToString("N")))
        try
            let before =
                Sim.initialWorldN 7UL 4
                |> dialogue
                |> chat 0 1
                |> trade
                |> atTick (22L * (ticksPerDay / 24L))

            WorldSave.saveToFile path before
            match WorldSave.loadFromFile path with
            | Error failure -> Error failure
            | Ok restored ->
                Ok
                    { Before = before
                      Restored = restored
                      Continued = advance inputs before
                      RestoredContinued = advance inputs restored }
        finally
            if File.Exists path then File.Delete path

let runM6aSmoke () : int =
    try
        match M6aSmoke.run () with
        | Error failure ->
            printfn "m6a_failure=%s" failure
            printfn "M6A_ACCEPTANCE=FAIL"
            1
        | Ok snapshot ->
            let roundTripSame = WorldSave.save snapshot.Before = WorldSave.save snapshot.Restored
            let continuationSame = WorldSave.save snapshot.Continued = WorldSave.save snapshot.RestoredContinued
            let stateExercised =
                snapshot.Before.Events.Length > 0
                && snapshot.Before.Rumors.Length > 0
                && snapshot.Before.Annals.Length > 0
            let failures =
                [ if not roundTripSame then Some "round_trip" else None
                  if not continuationSame then Some "continuation" else None
                  if not stateExercised then Some "state_coverage" else None ]
                |> List.choose id
            let beforeDigest = LivingVillage.Headless.PerformanceProbe.worldDigest snapshot.Before
            let restoredDigest = LivingVillage.Headless.PerformanceProbe.worldDigest snapshot.Restored
            let continuedDigest = LivingVillage.Headless.PerformanceProbe.worldDigest snapshot.Continued
            let restoredContinuedDigest = LivingVillage.Headless.PerformanceProbe.worldDigest snapshot.RestoredContinued
            printfn "m6a_smoke before_tick=%d restored_tick=%d continued_tick=%d restored_continued_tick=%d events=%d rumors=%d annals=%d"
                snapshot.Before.Tick snapshot.Restored.Tick snapshot.Continued.Tick snapshot.RestoredContinued.Tick
                snapshot.Before.Events.Length snapshot.Before.Rumors.Length snapshot.Before.Annals.Length
            printfn "m6a_digest before=%s restored=%s continued=%s restored_continued=%s"
                beforeDigest restoredDigest continuedDigest restoredContinuedDigest
            if failures.Length > 0 then printfn "m6a_failure=%s" (String.concat "," failures)
            printfn "M6A_ACCEPTANCE=%s" (if failures.IsEmpty then "PASS" else "FAIL")
            if failures.IsEmpty then 0 else 1
    with ex ->
        printfn "m6a_failure=%s" ex.Message
        printfn "M6A_ACCEPTANCE=FAIL"
        1

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) (onSimDay: int64 -> unit) : WorldVerdict =
    let seed = 42UL + uint64 k
    let stats = runSimulationCore false days seed Sim.npcCount onSimDay
    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
    Console.Out.Flush()
    let wall = System.Diagnostics.Stopwatch.StartNew()
    // 逐世界流式：每个世界一完成立刻打印该行（行尾追加 elapsed_s），再打印一行
    // [done k/N] 进度，并 flush，使长批次不再整轮零进度。结果仍按 world 序号落数组。
    let progressGate = obj ()
    let progressEvery = if days <= 5L then 1L else (days + 4L) / 5L
    let results =
        LivingVillage.Headless.BatchOutput.runStreaming worlds workers
            (fun k ->
                let sw = System.Diagnostics.Stopwatch.StartNew()
                let verdict =
                    evalWorld days k (fun day ->
                        if day % progressEvery = 0L then
                            lock progressGate (fun () ->
                                printfn "%s" (LivingVillage.Headless.BatchOutput.progressLine k day days sw.Elapsed.TotalSeconds)
                                Console.Out.Flush()))
                sw.Stop()
                (verdict, sw.Elapsed.TotalSeconds))
            (fun k (verdict, seconds) doneCount ->
                printfn "%s" (LivingVillage.Headless.BatchOutput.worldLine verdict.Line seconds)
                printfn "%s" (LivingVillage.Headless.BatchOutput.doneLine doneCount worlds seconds k)
                Console.Out.Flush())
    wall.Stop()
    let mutable passed = 0
    let mutable failed = 0
    let mutable oldPassed = 0
    let ratios = ResizeArray<float> ()
    let ginis = ResizeArray<float> ()
    for verdict, _ in results do
        if verdict.Ok then passed <- passed + 1 else failed <- failed + 1
        if verdict.CheckOld then oldPassed <- oldPassed + 1
        ratios.Add verdict.Ratio
        ginis.Add verdict.Gini
    let allPass = failed = 0
    printfn "%s"
        (LivingVillage.Headless.BatchOutput.summaryLine
            worlds passed failed oldPassed (Seq.min ratios) (Seq.max ratios) (Seq.min ginis) (Seq.max ginis) workers wall.Elapsed.TotalSeconds)
    printfn "M3_ACCEPTANCE=%s" (if allPass then "PASS" else "FAIL")
    Console.Out.Flush()
    if allPass then 0 else 1

/// `--cost-probe`：单世界按天数阶梯逐段真实测量（墙钟、ticks/s、分配与 GC），
/// 只读、不改任何模拟语义。天数阶梯可用 `--cost-probe D1,D2,...` 覆盖。
let runCostProbe (ladder: int64 list) : int =
    printfn "cost_probe ladder=%s npcs=%d" (ladder |> List.map string |> String.concat ",") Sim.npcCount
    Console.Out.Flush()
    for days in ladder do
        let ticks = days * ticksPerDay
        System.GC.Collect()
        let allocBefore = System.GC.GetTotalAllocatedBytes(false)
        let gen0Before = System.GC.CollectionCount 0
        let gen1Before = System.GC.CollectionCount 1
        let gen2Before = System.GC.CollectionCount 2
        let sw = System.Diagnostics.Stopwatch.StartNew()
        let stats = runSimulation false days 42UL Sim.npcCount
        sw.Stop()
        let allocated = System.GC.GetTotalAllocatedBytes(false) - allocBefore
        let line =
            LivingVillage.Headless.BatchOutput.costLine
                days ticks sw.Elapsed.TotalSeconds allocated
                (int64 (System.GC.CollectionCount 0 - gen0Before))
                (int64 (System.GC.CollectionCount 1 - gen1Before))
                (int64 (System.GC.CollectionCount 2 - gen2Before))
        printfn "%s" line
        printfn "cost_probe_check days=%d nonfinite=%d out_of_bounds=%d final_tick=%d" days stats.NonFinite stats.OutOfBounds stats.World.Tick
        Console.Out.Flush()
    0

/// `--rumor-bench [days] [npcs] [chats_per_day]`：Kernel 层 Rumor 长跑基准
/// （默认 30 NPC × 60 模拟日 × 每日 2000 次聊天）。只读、不改模拟语义。
let runRumorBench (argv: string[]) : int =
    let tryInt64 (index: int) =
        if argv.Length > index then
            match Int64.TryParse argv.[index] with
            | true, value -> Some value
            | _ -> None
        else None
    let days = tryInt64 1 |> Option.defaultValue RumorBench.defaultConfig.Days
    let npcs = tryInt64 2 |> Option.defaultValue (int64 RumorBench.defaultConfig.NpcCount) |> int
    let chatsPerDay = tryInt64 3 |> Option.defaultValue (int64 RumorBench.defaultConfig.ChatsPerDay) |> int
    let config =
        { RumorBench.defaultConfig with
            Days = days
            NpcCount = npcs
            ChatsPerDay = chatsPerDay }
    let result = RumorBench.run config
    printfn "%s" (RumorBench.format result)
    Console.Out.Flush()
    0

/// `--profile-long-run [days] [sampleEveryDays] [npcs] [seed]`：长局内存 profile（只读，不改模拟行为）。
/// 逐模拟日推进，每 `sampleEveryDays` 天采样并流式打印+flush：
///   * RSS：GC.GetTotalMemory(true)（GC live set）与 Process.WorkingSet64（OS RSS）；
///   * 三类历史集合 Events / Rumors / Annals 的条目数与估算字节；
///   * NPC Mind.Memory 总条目数与估算字节；
///   * 首个与最后一个采样点附带世界 digest，证明确定性不被 profile 影响。
/// 估算字节为保守常数模型（InteractionEvent≈48B、RumorEvent≈112B、AnnalEntry≈96B+Summary*2、
/// MemoryEvent≈72B），仅作数量级参考；ground truth 是 GC live set 与 WorkingSet。
let runProfileLongRun (argv: string[]) : int =
    let argInt64 index (dflt: int64) =
        if argv.Length > index then
            match Int64.TryParse argv.[index] with
            | true, v when v > 0L -> v
            | _ -> dflt
        else dflt
    let days = argInt64 1 40L
    let sampleEvery = argInt64 2 4L
    let npcs = int (argInt64 3 (int64 Sim.npcCount))
    let seed = if argv.Length > 4 then (match UInt64.TryParse argv.[4] with | true, v -> v | _ -> 42UL) else 42UL
    let mb (bytes: int64) = float bytes / (1024.0 * 1024.0)
    let proc = System.Diagnostics.Process.GetCurrentProcess()
    printfn "long_run_start days=%d sample_every_days=%d npcs=%d seed=%d ticks_per_day=%d" days sampleEvery npcs seed ticksPerDay
    Console.Out.Flush()
    let mutable world = Sim.initialWorldN seed npcs
    let mutable driver = { Rng = Rng.ofSeed seed; Until = segmentTicks; Input = zeroInput }
    let sw = System.Diagnostics.Stopwatch.StartNew()
    let sample (day: int64) (withDigest: bool) =
        let gcLive = System.GC.GetTotalMemory true
        proc.Refresh()
        let ws = proc.WorkingSet64
        let events = world.Events.Length
        let rumors = world.Rumors.Length
        let annals = world.Annals.Length
        let memEntries = world.Npcs |> Array.sumBy (fun n -> n.Mind.Memory.Length)
        let annalsBytes = world.Annals |> List.sumBy (fun a -> 96 + a.Summary.Length * 2)
        let digest = if withDigest then LivingVillage.Headless.PerformanceProbe.worldDigest world else "-"
        printfn
            "long_run_sample day=%d tick=%d gc_live_mb=%.2f working_set_mb=%.2f events=%d rumors=%d annals=%d memory_entries=%d est_events_kb=%.1f est_rumors_kb=%.1f est_annals_kb=%.1f est_memory_kb=%.1f elapsed_s=%.1f digest=%s"
            day world.Tick (mb gcLive) (mb ws) events rumors annals memEntries
            (float (events * 48) / 1024.0) (float (rumors * 112) / 1024.0) (float annalsBytes / 1024.0)
            (float (memEntries * 72) / 1024.0) sw.Elapsed.TotalSeconds digest
        Console.Out.Flush()
    sample 0L true
    let mutable dayNo = 0L
    while dayNo < days do
        dayNo <- dayNo + 1L
        let dayEnd = dayNo * ticksPerDay
        while world.Tick < dayEnd do
            let d, input =
                if world.Tick < 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
        if dayNo % sampleEvery = 0L || dayNo = days then sample dayNo false
    let finalDigest = LivingVillage.Headless.PerformanceProbe.worldDigest world
    printfn "long_run_done days=%d tick=%d final_digest=%s elapsed_s=%.1f" dayNo world.Tick finalDigest sw.Elapsed.TotalSeconds
    Console.Out.Flush()
    if world.Tick = days * ticksPerDay then 0 else 1

/// `--profile-multiworld [worlds] [days] [npcs] [sampleEveryDays] [seedBase]`：
/// N 个 Sim 世界并存、按采样轮并行推进 D 天（只读 profile，不改 Kernel/Sim 语义）。
/// 每 `sampleEveryDays` 天打印一行流式采样（worlds/count、events、rumors、annals、
/// memory_entries、gc_live_mb、working_set_rss_mb、elapsed_s）并 flush；行的聚合口径为
/// 全部并存世界之和，ground truth 是 GC live set 与 OS WorkingSet。
let runProfileMultiworld (argv: string[]) : int =
    let argInt64 index (dflt: int64) =
        if argv.Length > index then
            match Int64.TryParse argv.[index] with
            | true, v when v > 0L -> v
            | _ -> dflt
        else dflt
    let worlds = int (argInt64 1 10L)
    let days = argInt64 2 20L
    let npcs = int (argInt64 3 (int64 Sim.npcCount))
    let sampleEvery = argInt64 4 2L
    let seedBase = if argv.Length > 5 then (match UInt64.TryParse argv.[5] with | true, v -> v | _ -> 42UL) else 42UL
    let proc = System.Diagnostics.Process.GetCurrentProcess()
    printfn "multiworld_start worlds=%d days=%d npcs=%d sample_every_days=%d seed_base=%d ticks_per_day=%d"
        worlds days npcs sampleEvery seedBase ticksPerDay
    Console.Out.Flush()
    let ws = Array.init worlds (fun i -> Sim.initialWorldN (seedBase + uint64 i) npcs)
    let drivers = Array.init worlds (fun i -> { Rng = Rng.ofSeed (seedBase + uint64 i); Until = segmentTicks; Input = zeroInput })
    let sw = System.Diagnostics.Stopwatch.StartNew()
    let advanceOne (i: int) (targetDay: int64) =
        let mutable world = ws.[i]
        let mutable driver = drivers.[i]
        let dayEnd = targetDay * ticksPerDay
        while world.Tick < dayEnd do
            let d, input =
                if world.Tick < 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
        ws.[i] <- world
        drivers.[i] <- driver
    let sample (day: int64) =
        let gcLive = System.GC.GetTotalMemory true
        proc.Refresh()
        let rss = proc.WorkingSet64
        let events = ws |> Array.sumBy (fun w -> int64 w.Events.Length)
        let rumors = ws |> Array.sumBy (fun w -> int64 w.Rumors.Length)
        let annals = ws |> Array.sumBy (fun w -> int64 w.Annals.Length)
        let memEntries = ws |> Array.sumBy (fun w -> int64 (w.Npcs |> Array.sumBy (fun n -> n.Mind.Memory.Length)))
        printfn "%s" (LivingVillage.Headless.BatchOutput.multiworldLine worlds day days events rumors annals memEntries gcLive rss sw.Elapsed.TotalSeconds)
        Console.Out.Flush()
    sample 0L
    let mutable dayNo = 0L
    while dayNo < days do
        let target = min days (dayNo + sampleEvery)
        System.Threading.Tasks.Parallel.For(0, worlds, fun i -> advanceOne i target) |> ignore
        dayNo <- target
        sample dayNo
    let digests = ws |> Array.mapi (fun i w -> sprintf "%d:%s" i (LivingVillage.Headless.PerformanceProbe.worldDigest w)) |> String.concat ","
    printfn "multiworld_done worlds=%d day=%d elapsed_s=%.1f world_digests=%s" worlds dayNo sw.Elapsed.TotalSeconds digests
    Console.Out.Flush()
    if ws |> Array.forall (fun w -> w.Tick = days * ticksPerDay) then 0 else 1

let runExisting (argv: string[]) =
    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<int64 * uint64 * int * bool * bool * bool * bool * (int * int64) option, string> =
        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 | --m6a-smoke | --batch K D | --performance-baseline | --cost-probe [D1,D2,...] | --rumor-bench [days npcs chats_per_day] | --profile-long-run [days sampleEveryDays npcs seed] | --profile-multiworld [worlds days npcs sampleEveryDays seedBase]"
        2

let private parseCostLadder (argv: string[]) : int64 list =
    if argv.Length >= 2 then
        let parsed =
            argv.[1].Split(',')
            |> Array.toList
            |> List.map (fun token ->
                match Int64.TryParse(token.Trim()) with
                | true, days when days > 0L -> Some days
                | _ -> None)
        if parsed <> [] && List.forall Option.isSome parsed then
            parsed |> List.map Option.get
        else
            LivingVillage.Headless.BatchOutput.defaultCostLadder
    else
        LivingVillage.Headless.BatchOutput.defaultCostLadder

[<EntryPoint>]
let main argv =
    if argv.Length = 1 && argv.[0] = "--m6a-smoke" then
        runM6aSmoke ()
    elif argv.Length = 1 && argv.[0] = "--performance-baseline" then
        LivingVillage.Headless.PerformanceProbe.runDefault ()
    elif argv.Length >= 1 && argv.[0] = "--cost-probe" then
        runCostProbe (parseCostLadder argv)
    elif argv.Length >= 1 && argv.[0] = "--rumor-bench" then
        runRumorBench argv
    elif argv.Length >= 1 && argv.[0] = "--profile-long-run" then
        runProfileLongRun argv
    elif argv.Length >= 1 && argv.[0] = "--profile-multiworld" then
        runProfileMultiworld argv
    else
        runExisting argv