diff options
Diffstat (limited to 'src/LivingVillage.Kernel/Sim.fs')
| -rw-r--r-- | src/LivingVillage.Kernel/Sim.fs | 135 |
1 files changed, 135 insertions, 0 deletions
diff --git a/src/LivingVillage.Kernel/Sim.fs b/src/LivingVillage.Kernel/Sim.fs index ba3fd37..a2944e5 100644 --- a/src/LivingVillage.Kernel/Sim.fs +++ b/src/LivingVillage.Kernel/Sim.fs @@ -41,6 +41,9 @@ module Sim = Honesty: float32 Greed: float32 } + type ItemKind = + | Food + type NpcActionKind = | Eat | Sleep @@ -54,6 +57,8 @@ module Sim = | Pay | Hungry | Chatted of NpcId + | Bought of NpcId * ItemKind * int * float32 + | Sold of NpcId * ItemKind * int * float32 type MemoryEvent = { Tick: int64 @@ -62,6 +67,7 @@ module Sim = type InteractionKind = | ChatInit of NpcId * NpcId + | TradeEvent of NpcId * NpcId * ItemKind * int * float32 type InteractionEvent = { Tick: int64 @@ -82,6 +88,7 @@ module Sim = type Npc = { Id: NpcId Pos: Vec2 + Inventory: Map<ItemKind, int> Mind: Mind } [<Struct>] @@ -94,6 +101,24 @@ module Sim = Npcs: Npc[] Events: InteractionEvent list } + type TradeRequest = + { Buyer: NpcId + Seller: NpcId + Item: ItemKind + Quantity: int } + + type TradeFailure = + | BuyerNotFound + | SellerNotFound + | SameParticipant + | InvalidQuantity + | OutOfStock + | InsufficientFunds + + type TradeResult = + | TradeSucceeded of World + | TradeRejected of TradeFailure * World + let ticksPerSecond = 60L let secondsPerDay = 86400L let ticksPerDay = secondsPerDay * ticksPerSecond @@ -159,6 +184,8 @@ module Sim = | Pay -> 0.2f | Hungry -> -0.4f | Chatted _ -> chatValence + | Bought _ -> 0.3f + | Sold _ -> 0.3f let recordMemory (tick: int64) (kind: MemoryKind) (mem: MemoryEvent list) : MemoryEvent list = let updated = { Tick = tick; Kind = kind; Valence = valenceOfKind kind } :: mem @@ -249,10 +276,12 @@ module Sim = let centerY = float32 (mapHeightTiles * tilePixels / 2 - tilePixels / 2) let personality = personalityOfSeed seed let needs = { Hunger = 100.0f; Energy = 100.0f; Social = 100.0f; Money = 50.0f } + let inventory = Map.ofList [ Food, 10 ] let startAction = decideAction (isNightTick 0L) needs personality let npc = { Id = NpcId 0 Pos = { X = centerX; Y = centerY } + Inventory = inventory Mind = { Needs = needs Personality = personality @@ -275,6 +304,7 @@ module Sim = let cols = 6 let spacing = 64.0f let needs = { Hunger = 100.0f; Energy = 100.0f; Social = 100.0f; Money = 50.0f } + let inventory = Map.ofList [ Food, 10 ] let npcs = Array.init count (fun i -> let col = i % cols @@ -286,6 +316,7 @@ module Sim = let startAction = decideAction (isNightTick 0L) needs personality { Id = NpcId i Pos = pos + Inventory = inventory Mind = { Needs = needs Personality = personality @@ -297,6 +328,109 @@ module Sim = Memory = [] } }) { base_ with Npcs = npcs } + let private inventoryQuantity (item: ItemKind) (inventory: Map<ItemKind, int>) : int = + inventory |> Map.tryFind item |> Option.defaultValue 0 + + let private changeInventory (item: ItemKind) (delta: int) (inventory: Map<ItemKind, int>) : Map<ItemKind, int> = + let next = inventoryQuantity item inventory + delta + if next <= 0 then Map.remove item inventory else Map.add item next inventory + + let private findNpcIndex (id: NpcId) (npcs: Npc[]) : int option = + npcs |> Array.tryFindIndex (fun npc -> npc.Id = id) + + let private recentTransactionPrice (item: ItemKind) (world: World) : float32 option = + world.Npcs + |> Array.toList + |> List.collect (fun npc -> npc.Mind.Memory) + |> List.choose (fun event -> + match event.Kind with + | Bought (_, tradedItem, _, price) when tradedItem = item -> Some(event.Tick, price) + | Sold (_, tradedItem, _, price) when tradedItem = item -> Some(event.Tick, price) + | _ -> None) + |> List.sortByDescending fst + |> List.truncate 8 + |> List.map snd + |> function + | [] -> None + | prices -> Some(List.average prices) + + let quotePrice (request: TradeRequest) (world: World) : float32 option = + match findNpcIndex request.Buyer world.Npcs, findNpcIndex request.Seller world.Npcs with + | Some buyerIndex, Some sellerIndex when buyerIndex <> sellerIndex -> + let buyer = world.Npcs.[buyerIndex] + let seller = world.Npcs.[sellerIndex] + let basePrice = + match request.Item with + | Food -> 10.0f + let buyerUrgency = clamp ((100.0f - buyer.Mind.Needs.Hunger) / 100.0f) 0.0f 1.0f + let stockPressure = + 1.0f - clamp (float32 (inventoryQuantity request.Item seller.Inventory) / 20.0f) 0.0f 1.0f + let sellerNeed = clamp ((100.0f - seller.Mind.Needs.Money) / 100.0f) 0.0f 1.0f + let personalityFactor = + 0.2f * seller.Mind.Personality.Greed + + 0.1f * (1.0f - buyer.Mind.Personality.Honesty) + - 0.05f * buyer.Mind.Personality.Greed + let marketFactor = + match recentTransactionPrice request.Item world with + | Some recent -> clamp (0.85f + 0.15f * recent / basePrice) 0.75f 1.5f + | None -> 1.0f + let raw = + basePrice + * (0.75f + + 0.35f * buyerUrgency + + 0.30f * stockPressure + + 0.15f * sellerNeed + + personalityFactor) + * marketFactor + Some(clamp raw 0.01f 1000.0f) + | _ -> None + + let trade (request: TradeRequest) (world: World) : TradeResult = + match findNpcIndex request.Buyer world.Npcs with + | None -> TradeRejected(BuyerNotFound, world) + | Some buyerIndex -> + match findNpcIndex request.Seller world.Npcs with + | None -> TradeRejected(SellerNotFound, world) + | Some sellerIndex when buyerIndex = sellerIndex -> TradeRejected(SameParticipant, world) + | Some sellerIndex when request.Quantity <= 0 -> TradeRejected(InvalidQuantity, world) + | Some sellerIndex -> + let buyer = world.Npcs.[buyerIndex] + let seller = world.Npcs.[sellerIndex] + let stock = inventoryQuantity request.Item seller.Inventory + if stock < request.Quantity then + TradeRejected(OutOfStock, world) + else + match quotePrice request world with + | None -> TradeRejected(SameParticipant, world) + | Some unitPrice -> + let total = unitPrice * float32 request.Quantity + if buyer.Mind.Needs.Money < total then + TradeRejected(InsufficientFunds, world) + else + let newNpcs = Array.copy world.Npcs + let buyerMemory = + recordMemory world.Tick (Bought(request.Seller, request.Item, request.Quantity, unitPrice)) buyer.Mind.Memory + let sellerMemory = + recordMemory world.Tick (Sold(request.Buyer, request.Item, request.Quantity, unitPrice)) seller.Mind.Memory + newNpcs.[buyerIndex] <- + { buyer with + Inventory = changeInventory request.Item request.Quantity buyer.Inventory + Mind = + { buyer.Mind with + Needs = { buyer.Mind.Needs with Money = buyer.Mind.Needs.Money - total } + Memory = buyerMemory } } + newNpcs.[sellerIndex] <- + { seller with + Inventory = changeInventory request.Item (-request.Quantity) seller.Inventory + Mind = + { seller.Mind with + Needs = { seller.Mind.Needs with Money = seller.Mind.Needs.Money + total } + Memory = sellerMemory } } + let event = + { Tick = world.Tick + Kind = TradeEvent(request.Buyer, request.Seller, request.Item, request.Quantity, unitPrice) } + TradeSucceeded { world with Npcs = newNpcs; Events = world.Events @ [ event ] } + let chatableForChat (n: Npc) : bool = n.Mind.Action <> Sleep && n.Mind.Action <> Chat @@ -449,6 +583,7 @@ module Sim = for ev in queue do match ev.Kind with | ChatInit (a, b) -> applyChatInit ev.Tick a b newNpcs |> ignore + | TradeEvent _ -> () { Tick = tick Time = float tick * dtSeconds Rng = rngNext |