Recursive fair? shuffle

Significant functions are merge and shuffle. Functions gen and split are also worth a look.

     (*+
       Special comment!
        Start at line 1.
        End at line 72.
   5 +*)

     (* Read arguments, n is list len, « nexp » is number of experiments *)
     let n =
       if Array.length Sys.argv > 1 then int_of_string Sys.argv.(1)
  10   else 10

     let nexp =
       if Array.length Sys.argv > 2 then int_of_string Sys.argv.(2)
       else 100
  15
     (* Generate list [m…n] *)
     let rec gen m n =
       if m <= n then m::gen (m+1) n
       else []
  20
     (* Merge (uniformly) at random *)
     let rec merge r xs sx ys sy = match xs, ys with
     | [],[] -> r
     | x::rx, [] -> merge (x::r) rx (sx-1)  ys sy
  25 | [],y::ry -> merge (y::r) xs sx ry (sy-1)
     | x::rx, y::ry ->
         if Random.int(sx+sy) < sx then
           merge (x::r) rx (sx-1) ys sy
         else
  30       merge (y::r) xs sx ry (sy-1)

     (* Split a list into two lists of same size *)
     let rec do_split even se odd so = function
       | [] -> (even,se), (odd,so)
  35   | [x] -> (x::even,se+1), (odd,so)
       | x::y::rem -> do_split (x::even) (se+1) (y::odd) (so+1) rem

     let split xs = do_split [] 0 [] 0 xs

  40 (* Actual suffle *)
     let rec shuffle xs = match xs with
     | []|[_] -> xs
     | _ ->
         let (ys,sy), (zs,sz) = split xs in
  45     merge [] (shuffle ys) sy (shuffle zs) sz



     (* Perform experiment *)
  50 let zyva n m =
       let xs = gen 1 n in
       let t = Array.make_matrix (n+1) (n+1) 0 in
       for k = 1 to m do
         let ys = shuffle xs in
  55     let idx = ref 1 in
         List.iter
           (fun x -> t.(!idx).(x) <-  t.(!idx).(x) + 1 ; incr idx)
           ys
       done ;
  60   let mm = float_of_int m in
       for i = 1 to n do
         let t = t.(i) in
         for k=1 to n do
           let f = float_of_int t.(k) *. 100.0 /. mm in
  65       printf " %02.2f" f
         done ;
         print_endline ""
       done

  70 let _ = zyva n nexp ; exit 0

     (* Start at line 1, end here. *)

     (*
  75 (***************)
     (* Print lists *)
     (***************)
     *)

  80 open Printf

     let rec do_plist = function
       | [] -> printf "}"
       | x::xs -> printf ", %i" x ; do_plist xs
  85
     let plist = function
       | [] -> printf "{}"
       | x::xs -> printf "{%i" x ; do_plist xs

  90 let plistln xs = plist xs ; print_endline ""

This document was translated from L^AT_EX by H^EV^EA.