Not a member of Pastebin yet?
Sign Up,
it unlocks many cool features!
- module type POSSIBLES = sig
- (* A monad to simulate all possible outcomes of a non-deterministic
- * operation with discrete outcomes such as dice rolling. *)
- type 'a t
- (** [return x] is the possible outcomes for an operation where [x] is the
- * only possible outcome. *)
- val return: 'a -> 'a t
- (** [bind os f] is the combined outcomes for all of the operations [f o]
- * where [o] spans over the outcomes [os]. *)
- val bind: 'a t -> ('a -> 'b t) -> 'b t
- val ( >>= ): 'a t -> ('a -> 'b t) -> 'b t
- (** [join os1 os2] is the combined outcomes from [os1] and [os2]. *)
- val join: 'a t -> 'a t -> 'a t
- val map: 'a t -> ('a -> 'b) -> 'b t
- val ( >|= ): 'a t -> ('a -> 'b) -> 'b t
- val lift: ('a -> 'b) -> 'a t -> 'b t
- val lift2: ('a -> 'b -> 'c) -> 'a t -> 'b t -> 'c t
- (* The possibilities for a die of given sidedness*)
- val die: int -> int t
- (* interaction with the rest of the world *)
- val to_list: 'a t -> 'a list
- val of_list: 'a list -> 'a t
- val fold: ('b -> 'a -> 'b) -> 'b -> 'a t -> 'b
- end
- module Possibles : POSSIBLES = struct
- type 'a t = 'a list
- let return x = [ x ]
- let bind x f = List.flatten (List.map f x)
- let ( >>= ) = bind
- let join = ( @ )
- let map x f = List.map f x
- let ( >|= ) = map
- let lift f x =
- x >>= fun xo ->
- return (f xo)
- let lift2 f x y =
- x >>= fun xo ->
- y >>= fun yo ->
- return (f xo yo)
- let die sidedness =
- let rec loop res i =
- if i <= 0 then
- res
- else
- loop (i :: res) (pred i)
- in
- loop [] sidedness
- let to_list t = t
- let of_list t = t
- let fold = List.fold_left
- end
- (*Managing advantage *)
- type advantage =
- | Advantage
- | Disadvantage
- let d ?advantage sidedness =
- let open Possibles in
- match advantage with
- | None -> die sidedness
- | Some Advantage -> lift2 max (die sidedness) (die sidedness)
- | Some Disadvantage -> lift2 min (die sidedness) (die sidedness)
- (* Specialised 20-sided die *)
- let d20 = d 20
- let d20_advantage = d ~advantage:Advantage 20
- let d20_disadvantage = d ~advantage:Disadvantage 20
- (* Possible outcomes of an attack roll *)
- type hit_result =
- | Crit_fail
- | Fail
- | Success
- | Crit_success
- (* Determining the outcome of an attack roll *)
- let hit_result ac roll bonus =
- if roll = 1 then
- Crit_fail
- else if roll = 20 then
- Crit_success
- else if roll + bonus < ac then
- Fail
- else if roll + bonus >= ac then
- Success
- else
- assert false
- (* All possible outcomes of an attack roll *)
- let hit ?advantage ~bonus ~ac () =
- Possibles.map
- (d ?advantage 20)
- (fun roll -> hit_result ac roll bonus)
- (* Analysing the possible outcomes of an attack roll *)
- let rates results =
- let total = float_of_int (List.length results) in
- let rate results kind =
- let kl = List.length (List.filter ((=) kind) results) in
- (float_of_int kl) /. total
- in
- (rate results Crit_fail,
- rate results Fail,
- rate results Success,
- rate results Crit_success
- )
- (* Rolling for damage *)
- let damage ddice bonus =
- List.fold_left
- (* For each die, add all the possible outcomes *)
- (fun res ddie -> (Possibles.lift2 (+)) res (d ddie))
- (* Start with the bonus *)
- (Possibles.return bonus)
- (* Iterate over all dice *)
- ddice
- (* roll for attack and determine damage based on outcome *)
- let attack ?advantage ~ac ~hit_bonus ~damage_dice ~damage_bonus () =
- let open Possibles in
- hit ?advantage ~ac ~bonus:hit_bonus () >>= function
- | Crit_fail | Fail -> return 0
- | Success -> damage damage_dice damage_bonus
- | Crit_success -> damage (damage_dice @ damage_dice) damage_bonus
- (* Compact representation *)
- let length_encode l =
- match l with
- | [] -> []
- | h::t ->
- let (v, c, l) =
- List.fold_left
- (fun (value, count, l) new_value ->
- if value = new_value then
- (value, count + 1, l)
- else
- (new_value, 1, (value, count) :: l)
- )
- (h, 1, [])
- t
- in
- (v, c) :: l
- let rates_of_len_encode l =
- let total = float_of_int (List.fold_left (+) 0 (List.map snd l)) in
- List.map (fun (v,c) -> (v, (float_of_int c) /. total)) l
- let average l =
- let q = List.length l in
- let t = List.fold_left (+) 0 l in
- (float_of_int t) /. (float_of_int q)
- let median_sorted l =
- let ll = List.rev l in
- let d = List.map2 (fun x y -> (x,y)) l ll in
- let rec loop = function
- | (x, y) :: t when x < y -> loop t
- | (x, y) :: _ when x = y -> x
- | (x, y) :: _ when x > y -> (x+y) / 2
- | _ -> assert false
- in
- loop d
- let process_attack_result res =
- let res = Possibles.to_list res in
- let sorted_res = List.sort compare res in
- let len_encoded_res = length_encode sorted_res in
- let rates = rates_of_len_encode len_encoded_res in
- (average res, median_sorted sorted_res, rates)
Add Comment
Please, Sign In to add comment