rapha · March 17, 2010 10:25
diff --git a/simulation.ml b/simulation.ml
 open List

 let num_devs = 20
 let failure_rate = 0.20
 let build_time = (15. (* mins *) /. 60.) (* hours *)
 let commit_wait_timeslots = 4. /. build_time (* on average *) 
 let working_hours = 8.
 let num_timeslots = working_hours /. build_time |> int_of_float

 type build_status = Idle | Building | Pass | Retry | Fail

 let random_choice = function
  | [] -> None
  | xs -> Some (xs |> length |> Random.int |> at xs)

 let possibly probability value default =
  if (Random.float 1.0) <= probability then value else default

 let statuses =
  () |> Unix.time |> int_of_float |> Random.init;
  Enum.unfold
    (make num_devs Idle)
    (fun prev_timeslot ->
      let passed_index = prev_timeslot
        |> mapi (fun i s -> (i,s)) 
        |> filter (snd |- (=) Building) 
        |> map fst
        |> random_choice in
      let current_timeslot = prev_timeslot
        |> mapi (fun i s -> if (Some i) = passed_index then Pass else s)
        |> map (function Building -> possibly failure_rate Fail Retry | s -> s) in
      let next_timeslot = current_timeslot 
        |> map (function
          | Retry -> Building
          | Fail | Pass | Idle -> possibly (1. /. commit_wait_timeslots) Building Idle
          | status -> status
        )
      in
      Some (current_timeslot, next_timeslot)
    )
  |> Enum.take num_timeslots |> of_enum

 let to_html =
  let name = function
    | Idle -> "idle"
    | Building -> "building"
    | Pass -> "pass"
    | Retry -> "retry"
    | Fail -> "fail"
  in
  mapi (fun col ->
    mapi (fun row status ->
      let title = Printf.sprintf "build %s for dev %d" (name status) row in
      Printf.sprintf "<span class='status %s row_%d col_%d' title='%s'>&nbsp;</span>" (name status) row col title 
    ) |- reduce (^)
  ) |- reduce (^)

 let styles =
  let box_size = 20 in
  ((0 -- num_devs) |> Enum.map (fun row -> Printf.sprintf 
    ".row_%d { position:absolute; height:%dpx; top:%dpx }\n" row box_size (row * box_size)
  ) |> Enum.reduce (^))
  ^
  ((0 -- num_timeslots) |> Enum.map (fun col -> Printf.sprintf
    ".col_%d { position:absolute; width:%dpx; left:%dpx }\n" col box_size (col * box_size)
  ) |> Enum.reduce (^))

 let _ =
  Printf.printf "
    <html>
    <head>
      <style type='text/css'>
        .status { border: 1px solid gray; padding:0; margin:0; }
        .idle { background-color:white }
        .building { background-color:blue }
        .pass { background-color:green }
        .retry { background-color:orange }
        .fail { background-color:red }
        %s
      </style>
    </head>
    <body>%s</body>
    </html>
    " 
    styles
    (statuses |> to_html)
 ;;
	open List

	let num_devs = 20
	let failure_rate = 0.20
	let build_time = (15. (* mins ) /. 60.) ( hours *)
	let commit_wait_timeslots = 4. /. build_time (* on average *)
	let working_hours = 8.
	let num_timeslots = working_hours /. build_time \|> int_of_float

	type build_status = Idle \| Building \| Pass \| Retry \| Fail

	let random_choice = function
	\| [] -> None
	\| xs -> Some (xs \|> length \|> Random.int \|> at xs)

	let possibly probability value default =
	if (Random.float 1.0) <= probability then value else default

	let statuses =
	() \|> Unix.time \|> int_of_float \|> Random.init;
	Enum.unfold
	(make num_devs Idle)
	(fun prev_timeslot ->
	let passed_index = prev_timeslot
	\|> mapi (fun i s -> (i,s))
	\|> filter (snd \|- (=) Building)
	\|> map fst
	\|> random_choice in
	let current_timeslot = prev_timeslot
	\|> mapi (fun i s -> if (Some i) = passed_index then Pass else s)
	\|> map (function Building -> possibly failure_rate Fail Retry \| s -> s) in
	let next_timeslot = current_timeslot
	\|> map (function
	\| Retry -> Building
	\| Fail \| Pass \| Idle -> possibly (1. /. commit_wait_timeslots) Building Idle
	\| status -> status
	)
	in
	Some (current_timeslot, next_timeslot)
	)
	\|> Enum.take num_timeslots \|> of_enum

	let to_html =
	let name = function
	\| Idle -> "idle"
	\| Building -> "building"
	\| Pass -> "pass"
	\| Retry -> "retry"
	\| Fail -> "fail"
	in
	mapi (fun col ->
	mapi (fun row status ->
	let title = Printf.sprintf "build %s for dev %d" (name status) row in
	Printf.sprintf "<span class='status %s row_%d col_%d' title='%s'> </span>" (name status) row col title
	) \|- reduce (^)
	) \|- reduce (^)

	let styles =
	let box_size = 20 in
	((0 -- num_devs) \|> Enum.map (fun row -> Printf.sprintf
	".row_%d { position:absolute; height:%dpx; top:%dpx }\n" row box_size (row * box_size)
	) \|> Enum.reduce (^))
	^
	((0 -- num_timeslots) \|> Enum.map (fun col -> Printf.sprintf
	".col_%d { position:absolute; width:%dpx; left:%dpx }\n" col box_size (col * box_size)
	) \|> Enum.reduce (^))

	let _ =
	Printf.printf "
	<html>
	<head>
	<style type='text/css'>
	.status { border: 1px solid gray; padding:0; margin:0; }
	.idle { background-color:white }
	.building { background-color:blue }
	.pass { background-color:green }
	.retry { background-color:orange }
	.fail { background-color:red }
	%s
	</style>
	</head>
	<body>%s</body>
	</html>
	"
	styles
	(statuses \|> to_html)
	;;