diff options
Diffstat (limited to 'src/LivingVillage.Headless')
| -rw-r--r-- | src/LivingVillage.Headless/Program.fs | 120 |
1 files changed, 118 insertions, 2 deletions
diff --git a/src/LivingVillage.Headless/Program.fs b/src/LivingVillage.Headless/Program.fs index f5f9c5b..2a2482b 100644 --- a/src/LivingVillage.Headless/Program.fs +++ b/src/LivingVillage.Headless/Program.fs @@ -1,6 +1,7 @@ module Program open System +open System.IO open LivingVillage.Kernel open LivingVillage.Kernel.Sim @@ -258,6 +259,119 @@ module M5Smoke = 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 @@ -430,12 +544,14 @@ let runExisting (argv: string[]) = 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 | --performance-baseline" + 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" 2 [<EntryPoint>] let main argv = - if argv.Length = 1 && argv.[0] = "--performance-baseline" then + if argv.Length = 1 && argv.[0] = "--m6a-smoke" then + runM6aSmoke () + elif argv.Length = 1 && argv.[0] = "--performance-baseline" then LivingVillage.Headless.PerformanceProbe.runDefault () else runExisting argv |