summaryrefslogtreecommitdiff
path: root/src/LivingVillage.Headless/Program.fs
blob: 6f86f45ff0c01fe310017d9898fda104816be13e (plain)
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
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 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"

let runSimulation (days: int64) (seed: uint64) : int =
    let totalTicks = days * ticksPerDay
    printfn "living-village headless days=%d seed=%d ticks=%d tickrate=%d" days seed totalTicks ticksPerSecond
    let mutable world = Sim.initialWorld seed
    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 = (List.head world.Npcs).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
    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
        let head = List.head world.Npcs
        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 % 2000L = 0L then
            let day = float t / float ticksPerDay
            let memTotal = GC.GetTotalMemory(true)
            for npc in world.Npcs do
                let n = npc.Mind.Needs
                let p' = npc.Pos
                let memCount = List.length npc.Mind.Memory
                let lastValence =
                    match List.tryHead npc.Mind.Memory with
                    | Some e -> e.Valence
                    | None -> 0.0f
                printfn "npc=%A tick=%d day=%.4f pos=(%.1f,%.1f) hunger=%.2f energy=%.2f social=%.2f money=%.2f action=%s mem_count=%d last_valence=%.2f"
                    npc.Id t day p'.X p'.Y n.Hunger n.Energy n.Social n.Money (actionName npc.Mind.Action) memCount lastValence
        if t % 1000L = 0L && t % 2000L <> 0L then
            let day = float t / float ticksPerDay
            printfn "tick=%d time=%.4fs day=%.4f pos=(%.1f,%.1f) rng=%016x" t world.Time day p.X p.Y world.Rng.State
    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 = List.head world.Npcs
    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
    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) : Result<int64 * uint64, string> =
        if i >= argv.Length then
            match days, seed with
            | Some d, Some s -> Ok(d, s)
            | _ -> 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
                 | _ -> 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)
                 | _ -> Error $"invalid --seed '{argv.[i + 1]}'")
            | other -> Error $"unknown argument '{other}'"

    match parse 0 None None with
    | Ok(days, seed) -> runSimulation days seed
    | Error msg ->
        eprintfn $"headless: {msg}"
        eprintfn "usage: dotnet run -c Release --project src/LivingVillage.Headless -- --days N --seed S"
        2