diff options
Diffstat (limited to 'src/LivingVillage.Headless')
| -rw-r--r-- | src/LivingVillage.Headless/Program.fs | 146 |
1 files changed, 126 insertions, 20 deletions
diff --git a/src/LivingVillage.Headless/Program.fs b/src/LivingVillage.Headless/Program.fs index 6ba0f5f..e34ecc0 100644 --- a/src/LivingVillage.Headless/Program.fs +++ b/src/LivingVillage.Headless/Program.fs @@ -167,6 +167,105 @@ let dumpRelations (world: World) : unit = 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 @@ -278,46 +377,53 @@ let main argv = (dump: bool) (rumorTrace: bool) (rumorReplay: bool) + (m5Smoke: bool) (batch: (int * int64) option) - : Result<int64 * uint64 * int * bool * bool * bool * (int * int64) option, string> = + : 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, Some(k, d)) + | 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, None) + | 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 batch + | 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 batch + | 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 batch + | 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 batch - | "--dump-rumors" -> parse (i + 1) days seed npc dump true rumorReplay batch - | "--replay-rumors" -> parse (i + 1) days seed npc dump rumorTrace 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 (Some(k, d)) - | _ -> Error $"invalid --batch '{argv.[i + 1]} {argv.[i + 2]}'") + | "--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 None with - | Ok(days, seed, npc, dump, rumorTrace, rumorReplay, batch) -> - match batch with - | Some(k, d) when rumorTrace || rumorReplay -> + 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 - | Some(k, d) -> runBatch k d - | None -> + | 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 @@ -325,5 +431,5 @@ let main argv = 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] | --batch K D" + 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 |