# 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 LATEX by HEVEA.