olliefr/description.md

## description.md

      
    Raw
  

              description.md
            
          
    Background

I am writing a predator-prey simulator (for no good reason) and I have hit the wall with functional design. The simulator is that of a grid on which the fish and the sharks go about their business, the fish moves, grows and procreates and so do the sharks. The sharks also hunt and eat the fish. The time is discrete (in chronons) so it is a discrete-time multi-agent simulation. I currently have three data types -- World, Fish, and Shark.
The implementation

The simple way to make the World go round is described in the book as following (in my own words).
Each turn, iterate over the list of agents and apply sense/act function which in turn will return a revised world, something like let world' = List.fold (World.fish world) ~init:world ~f:Fish.act. I have attached my code which (almost) implements this strategy for Fish in a somewhat ugly way.
The problem

This approach to allocating resources is biased, because the first fish in the list has more choices than the second by virtue of being the first in the list. What I would like to have instead is some kind of resource allocation system, like an auction, perhaps, in which the fish can bid for space or food, and the sharks can bid for the fish they would like to eat in this turn and then in case of competing bids some strategy would be applied and only one of the competitors would get their way.
Help?

I have no idea, though, how to design a bidding system like this in a functional way. In fact, I am not even sure what to call it -- the concept of bidding is just the first one which comes to mind when thinking of this problem. Could you please point me in the right direction? Any suggestions are welcome.

  
## wator.ml
(* Planet Wa-Tor fish and sharks *)

open Core.Std

let () = Random.self_init ()

module Fish : sig
  type t

  (** Maximum age, in chronons *)
  val max_age : int

  (** Breeding period, in chronons *)
  val breeding_time : int

  (** Create a new fish. The age must be between [0,max_age],
      otherwise an exception is thrown. *)
  val create : int * int -> int -> t

  (** Create a new fish with random age *)
  val create_with_random_age : int * int -> t

  (** Returns a valid fish age in chronons from the range [0..max_age] *)
  val random_age : unit -> int

  (** Location (i,j) on the grid *)
  val position : t -> int * int

  (** Current age of the fish *)
  val age : t -> int

  (** True, if the fish is at maximum age *)
  val is_decrepit : t -> bool

  (** True, if it's time to breed *)
  val can_breed : t -> bool

  (** Increases age by one chronon. Exception if already too old *)
  val grow : t -> t

  (** Move to required location *)
  val move : t -> int * int -> t

  (** Reset breeding counter *)
  val breed : t -> t

  val to_string : t -> string
end = struct
  type t = {x:int; y:int; age:int; breed:int}

  let max_age = 10
  let breeding_time = 3

  let random_age () = Random.int (max_age+1)

  (* Pre-condition: age is between [0,max_age] *)
  let create (x,y) age =
    let () = if age > max_age then failwith "this fish is too old" in
    {x;y;age;breed=breeding_time}

  let create_with_random_age location =
    let age = random_age () in
    create location age

  let position {x;y;_} = (x,y)

  let age {age;_} = age

  let is_decrepit {age;_} = age = max_age

  let can_breed {breed;_} = breed = 0

  let grow fish =
    if is_decrepit fish
    then failwith "this fish is too old to grow"
    else {fish with age=fish.age+1} (*;breed=max(0, fish.breed-1)}*)

  let move fish (x,y) = {fish with x;y}

  let breed fish = {fish with breed=breeding_time}

  let to_string {x;y;age;_} = sprintf "FisH at (%i,%i), age %i." x y age
end


module Shark : sig
  type t

  (** Maximum age, in chronons *)
  val max_age : int

  (** Create a new shark. The age must be between [0,max_age],
      otherwise an exception is thrown. *)
  val create : int * int -> int -> t

  (** Create a new shark with random age *)
  val create_with_random_age : int * int -> t

  (** Returns a valid shark age in chronons from the range [0..max_age] *)
  val random_age : unit -> int

  (** Location (i,j) on the grid *)
  val position : t -> int * int

  (** Current age of the shark *)
  val age : t -> int

  val to_string : t -> string
end = struct
  type t = {x:int; y:int; age:int}

  let max_age = 10

  let random_age () = Random.int (max_age+1)

  (* Pre-condition: age is  [0..max_age] *)
  let create (x,y) age =
    let () = if age > max_age then failwith "this shark is too old" in
    {x;y;age}

  let create_with_random_age location =
    let age = random_age () in
    create location age

  let position {x;y;_} = (x,y)

  let age {age;_} = age

  let to_string {x;y;age} = sprintf "SharK at (%i, %i), age %i." x y age
end


module World : sig
  type t

  (** Create a new world of width x and height y.
      The world must be big enough to hold all the fish and sharks,
      that is x*y >= nfish + nsharks otherwise an exception is thrown. *)
  val create : x:int -> y:int -> nfish:int -> nsharks:int -> t

  (** The width of the world *)
  val width : t -> int

  (** The height of the world *)
  val height : t -> int

  (** Integer cartesian grid. Top left corner is (0,0) *)
  val grid : t -> (int * int) list

  (** True, if the world is devoid of all life *)
  val is_empty : t -> bool

  val free_at : t -> int * int -> bool

  (** True, if there is a fish at a given coordinate *)
  val fish_at : t -> int * int -> bool

  (** True, if there is a shark at a given location *)
  val shark_at : t -> int * int -> bool

  (** For given coordinate (i,j) returns a list of locations around it
      which are not occupied. The maximum length is four (right, up,
      left, down). *)
  val vacant_locations : t -> int * int -> (int * int) list

  (** This simulates a single chronon of time passing. In that time,
      the fish swim and breed and the sharks hunt and breed. *)
  val go : t -> t
end = struct
  type t = {x:int; y:int; fish:(Fish.t list); sharks:(Shark.t list)}

  let width w = w.x

  let height w = w.y

  (* Private use only! *)
  let create_grid x y =
    List.cartesian_product (List.range 0 x) (List.range 0 y)

  (* Pre-condition: x*y >= nfish+nsharks *)
  let create ~x ~y ~nfish ~nsharks =
    let () =
      if x*y < nfish+nsharks then failwith "the whole world is not enough" in
    let locations = List.permute (create_grid x y) in
    let (fish_locations, locations) = List.split_n locations nfish in
    let (shark_locations, _) = List.split_n locations nsharks in
    let fish = List.map
      ~f:(fun xy -> Fish.create_with_random_age xy ) fish_locations in
    let sharks = List.map
      ~f:(fun xy -> Shark.create_with_random_age xy) shark_locations in
    {x; y; fish; sharks}

  let grid w = create_grid w.x w.y

  let is_empty w = (List.is_empty w.fish) && (List.is_empty w.sharks)

  let fish_at w location =
    List.exists w.fish ~f:(fun x -> (Fish.position x) = location)

  let shark_at w location =
    List.exists w.sharks ~f:(fun x -> (Shark.position x) = location)

  let free_at w location = not (fish_at w location) && not (shark_at w location)

  (* FIXME is there any way to do this in func def: {x;y;_} as w *)
  let vacant_locations w (i,j) =
    let x,y = w.x,w.y in
      (* Wrap coordinates, they are zero-based. *)
    let wrap (i,j) =
      let i' = match i with
	| i when i<0 -> (x-1)
	| i when i=x -> 0
	| i -> i in
      let j' = match j with
        | j when j<0 -> (y-1)
	| j when j=y -> 0
	| j -> j in
      (i',j')
    in
    List.filter [wrap (i+1,j); wrap (i,j+1); wrap (i-1,j); wrap (i-1,j-1)]
      ~f:(fun x -> free_at w x)


  (* Choose a location from a given list at random *)
  let choose_location = function
    | [] -> failwith "nowhere to move"
    | locations -> List.nth_exn locations (Random.int (List.length locations))

  (* The auxilary function for folding the list of fish *)
  (* FIXME there must be a more elegant way *)
  (* The algorithm:
       + if a fish is geriatric, remove from the world
       + if a fish is blocked, grow in place
       + otherwise, move and grow the fish
       + if can breed, place the offspring in old location
  *)
  let aux w e =
    match List.split_while w.fish ~f:(fun x -> x<>e) with
      | (_, []) -> failwith "the fish fold utility function is wrong"
      | (processed, current::queued) ->
	if Fish.is_decrepit current
	then {w with fish=(processed @ queued)}
	else
	  let locations = vacant_locations w (Fish.position current) in
	  if List.is_empty locations
	  then {w with fish=(processed @ (Fish.grow current)::queued)}
	  else
	    let location = choose_location locations in
	    let moved = Fish.move current location in
	    let mature = Fish.grow moved in
	    if not (Fish.can_breed moved)
	    then {w with fish=(processed @ mature::queued)}
	    else
	      let bred = Fish.breed mature in
	      let offspring = Fish.create (Fish.position current) 0 in
	      {w with fish=(processed @ bred::offspring::queued)}

  let fish_swim_and_breed w = List.fold w.fish ~init:w ~f:aux

  (* The auxilary function for folding the list of sharks *)
  (* TODO complete this, similar to aux *)
  let aux2 w e = w

  let sharks_hunt_and_breed w = List.fold w.sharks ~init:w ~f:aux2

  (* The World goes round... *)
  let go w = w
	   |> fish_swim_and_breed
	   |> sharks_hunt_and_breed
end

module GUI : sig
  val render : World.t -> unit
end = struct
  let render w = printf "The world [%i-%i] hath been rendred.\n"
    (World.width w) (World.height w)
end

(* The main loop - draw and update the world *)
let rec loop world =
  GUI.render world;
  if World.is_empty world
  then ()
  else loop (World.go world)

let main () =
  loop (World.create ~x:80 ~y:20 ~nfish:200 ~nsharks:20)

let () = main ()
	(* Planet Wa-Tor fish and sharks *)

	open Core.Std

	let () = Random.self_init ()

	module Fish : sig
	type t

	(** Maximum age, in chronons *)
	val max_age : int

	(** Breeding period, in chronons *)
	val breeding_time : int

	(** Create a new fish. The age must be between [0,max_age],
	otherwise an exception is thrown. *)
	val create : int * int -> int -> t

	(** Create a new fish with random age *)
	val create_with_random_age : int * int -> t

	(** Returns a valid fish age in chronons from the range [0..max_age] *)
	val random_age : unit -> int

	(** Location (i,j) on the grid *)
	val position : t -> int * int

	(** Current age of the fish *)
	val age : t -> int

	(** True, if the fish is at maximum age *)
	val is_decrepit : t -> bool

	(** True, if it's time to breed *)
	val can_breed : t -> bool

	(** Increases age by one chronon. Exception if already too old *)
	val grow : t -> t

	(** Move to required location *)
	val move : t -> int * int -> t

	(** Reset breeding counter *)
	val breed : t -> t

	val to_string : t -> string
	end = struct
	type t = {x:int; y:int; age:int; breed:int}

	let max_age = 10
	let breeding_time = 3

	let random_age () = Random.int (max_age+1)

	(* Pre-condition: age is between [0,max_age] *)
	let create (x,y) age =
	let () = if age > max_age then failwith "this fish is too old" in
	{x;y;age;breed=breeding_time}

	let create_with_random_age location =
	let age = random_age () in
	create location age

	let position {x;y;_} = (x,y)

	let age {age;_} = age

	let is_decrepit {age;_} = age = max_age

	let can_breed {breed;_} = breed = 0

	let grow fish =
	if is_decrepit fish
	then failwith "this fish is too old to grow"
	else {fish with age=fish.age+1} (;breed=max(0, fish.breed-1)})

	let move fish (x,y) = {fish with x;y}

	let breed fish = {fish with breed=breeding_time}

	let to_string {x;y;age;_} = sprintf "FisH at (%i,%i), age %i." x y age
	end



	module Shark : sig
	type t

	(** Maximum age, in chronons *)
	val max_age : int

	(** Create a new shark. The age must be between [0,max_age],
	otherwise an exception is thrown. *)
	val create : int * int -> int -> t

	(** Create a new shark with random age *)
	val create_with_random_age : int * int -> t

	(** Returns a valid shark age in chronons from the range [0..max_age] *)
	val random_age : unit -> int

	(** Location (i,j) on the grid *)
	val position : t -> int * int

	(** Current age of the shark *)
	val age : t -> int

	val to_string : t -> string
	end = struct
	type t = {x:int; y:int; age:int}

	let max_age = 10

	let random_age () = Random.int (max_age+1)

	(* Pre-condition: age is [0..max_age] *)
	let create (x,y) age =
	let () = if age > max_age then failwith "this shark is too old" in
	{x;y;age}

	let create_with_random_age location =
	let age = random_age () in
	create location age

	let position {x;y;_} = (x,y)

	let age {age;_} = age

	let to_string {x;y;age} = sprintf "SharK at (%i, %i), age %i." x y age
	end



	module World : sig
	type t

	(** Create a new world of width x and height y.
	The world must be big enough to hold all the fish and sharks,
	that is xy >= nfish + nsharks otherwise an exception is thrown. )
	val create : x:int -> y:int -> nfish:int -> nsharks:int -> t

	(** The width of the world *)
	val width : t -> int

	(** The height of the world *)
	val height : t -> int

	(** Integer cartesian grid. Top left corner is (0,0) *)
	val grid : t -> (int * int) list

	(** True, if the world is devoid of all life *)
	val is_empty : t -> bool

	val free_at : t -> int * int -> bool

	(** True, if there is a fish at a given coordinate *)
	val fish_at : t -> int * int -> bool

	(** True, if there is a shark at a given location *)
	val shark_at : t -> int * int -> bool

	(** For given coordinate (i,j) returns a list of locations around it
	which are not occupied. The maximum length is four (right, up,
	left, down). *)
	val vacant_locations : t -> int * int -> (int * int) list

	(** This simulates a single chronon of time passing. In that time,
	the fish swim and breed and the sharks hunt and breed. *)
	val go : t -> t
	end = struct
	type t = {x:int; y:int; fish:(Fish.t list); sharks:(Shark.t list)}

	let width w = w.x

	let height w = w.y

	(* Private use only! *)
	let create_grid x y =
	List.cartesian_product (List.range 0 x) (List.range 0 y)

	(* Pre-condition: xy >= nfish+nsharks )
	let create ~x ~y ~nfish ~nsharks =
	let () =
	if x*y < nfish+nsharks then failwith "the whole world is not enough" in
	let locations = List.permute (create_grid x y) in
	let (fish_locations, locations) = List.split_n locations nfish in
	let (shark_locations, _) = List.split_n locations nsharks in
	let fish = List.map
	~f:(fun xy -> Fish.create_with_random_age xy ) fish_locations in
	let sharks = List.map
	~f:(fun xy -> Shark.create_with_random_age xy) shark_locations in
	{x; y; fish; sharks}

	let grid w = create_grid w.x w.y

	let is_empty w = (List.is_empty w.fish) && (List.is_empty w.sharks)

	let fish_at w location =
	List.exists w.fish ~f:(fun x -> (Fish.position x) = location)

	let shark_at w location =
	List.exists w.sharks ~f:(fun x -> (Shark.position x) = location)

	let free_at w location = not (fish_at w location) && not (shark_at w location)

	(* FIXME is there any way to do this in func def: {x;y;_} as w *)
	let vacant_locations w (i,j) =
	let x,y = w.x,w.y in
	(* Wrap coordinates, they are zero-based. *)
	let wrap (i,j) =
	let i' = match i with
	\| i when i<0 -> (x-1)
	\| i when i=x -> 0
	\| i -> i in
	let j' = match j with
	\| j when j<0 -> (y-1)
	\| j when j=y -> 0
	\| j -> j in
	(i',j')
	in
	List.filter [wrap (i+1,j); wrap (i,j+1); wrap (i-1,j); wrap (i-1,j-1)]
	~f:(fun x -> free_at w x)


	(* Choose a location from a given list at random *)
	let choose_location = function
	\| [] -> failwith "nowhere to move"
	\| locations -> List.nth_exn locations (Random.int (List.length locations))

	(* The auxilary function for folding the list of fish *)
	(* FIXME there must be a more elegant way *)
	(* The algorithm:
	+ if a fish is geriatric, remove from the world
	+ if a fish is blocked, grow in place
	+ otherwise, move and grow the fish
	+ if can breed, place the offspring in old location
	*)
	let aux w e =
	match List.split_while w.fish ~f:(fun x -> x<>e) with
	\| (_, []) -> failwith "the fish fold utility function is wrong"
	\| (processed, current::queued) ->
	if Fish.is_decrepit current
	then {w with fish=(processed @ queued)}
	else
	let locations = vacant_locations w (Fish.position current) in
	if List.is_empty locations
	then {w with fish=(processed @ (Fish.grow current)::queued)}
	else
	let location = choose_location locations in
	let moved = Fish.move current location in
	let mature = Fish.grow moved in
	if not (Fish.can_breed moved)
	then {w with fish=(processed @ mature::queued)}
	else
	let bred = Fish.breed mature in
	let offspring = Fish.create (Fish.position current) 0 in
	{w with fish=(processed @ bred::offspring::queued)}

	let fish_swim_and_breed w = List.fold w.fish ~init:w ~f:aux

	(* The auxilary function for folding the list of sharks *)
	(* TODO complete this, similar to aux *)
	let aux2 w e = w

	let sharks_hunt_and_breed w = List.fold w.sharks ~init:w ~f:aux2

	(* The World goes round... *)
	let go w = w
	\|> fish_swim_and_breed
	\|> sharks_hunt_and_breed
	end

	module GUI : sig
	val render : World.t -> unit
	end = struct
	let render w = printf "The world [%i-%i] hath been rendred.\n"
	(World.width w) (World.height w)
	end

	(* The main loop - draw and update the world *)
	let rec loop world =
	GUI.render world;
	if World.is_empty world
	then ()
	else loop (World.go world)

	let main () =
	loop (World.create ~x:80 ~y:20 ~nfish:200 ~nsharks:20)

	let () = main ()