1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
|
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
let runSimulation (days: int64) (seed: uint64) (npcCount: int) : int =
let totalTicks = days * ticksPerDay
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 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
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
if nonFinite > 0L || outOfBounds > 0L then 1 else 0
[<EntryPoint>]
let main argv =
let rec parse (i: int) (days: int64 option) (seed: uint64 option) (npc: int option) : Result<int64 * uint64 * int, string> =
if i >= argv.Length then
match days, seed, npc with
| Some d, Some s, Some n -> Ok(d, s, n)
| _ -> 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
| _ -> 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
| _ -> 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)
| _ -> Error $"invalid --npc '{argv.[i + 1]}'")
| other -> Error $"unknown argument '{other}'"
match parse 0 None None (Some 30) with
| Ok(days, seed, npc) -> runSimulation days seed npc
| Error msg ->
eprintfn $"headless: {msg}"
eprintfn "usage: dotnet run -c Release --project src/LivingVillage.Headless -- --days N --seed S [--npc N]"
2
|
