Round-robin algorithm in OCaml

Question

This is the followup question of What's the grouping plan so that every two people are grouped together just once?

Basically, I implemented the Round robin algorithm.

---

By the algorithm, it can generate pairs list where each possible pair of elements are grouped together exactly once.

For example, we have a, b, c, d, then

On first day, we do

a b
c d

Then we group like [(a,c);(b,d)].

Then we round it clockwise like

a c
d b

Then we group like [(a,d);(c,b)].

Then we round it clockwise like

a d
b c

Then we group like [(a,b);(d,c)].

(Note, a is fixed all the time.)

Finally I can get

[(a,c);(b,d)]
[(a,d);(c,b)]
[(a,b);(d,c)]

---

Here are the ocaml code:

let split = List.fold_left (fun (l1, l2) x -> (l2, x::l1)) ([], []) 

let round l1 l2 =
  match List.rev l1, l2 with
    | _, [] | [], _ -> raise Cant_round
    | hd1::tl1, hd2::tl2 ->
      hd2::(List.rev tl1), List.rev (hd1::List.rev tl2)

let rec robin fixed stopper acc = function
  | _, [] | [], _ -> raise Cant_robin
  | l1, (hd2::tl2 as l2) -> 
    if hd2 = stopper then acc
    else robin fixed stopper ((List.combine (fixed::l1) l2)::acc) (round l1 l2)

let round_robin = function
  | [] | _::[] -> raise Cant_round_robin
  | hd::tl ->
    let l1, l2 =  in
    match split tl with 
      | _, [] -> raise Cant_round_robin
      | l1, (hd2::_ as l2) -> 
    robin hd hd2 ((List.combine (hd::l1) l2)::[]) (round l1 l2)

The code is quite straight forward following the algorithm. Is there a better implmentation?

Answer 1

let round_robin ~nplayers ~round i =
  (* only works for an even number of players *)
  assert (nplayers mod 2 = 0);
  assert (0 <= round && round < nplayers - 1);
  (* i is the position of a match,
     at each round there are nplayers/2 matches *)
  assert (0 <= i && i < nplayers / 2);
  let last = nplayers - 1 in
  let player pos =
    if pos = last then last
    else (pos + round) mod last
  in
  (player i, player (last - i))

let all_matches nplayers =
  Array.init (nplayers - 1) (fun round ->
    Array.init (nplayers / 2) (fun i ->
      round_robin ~nplayers ~round i))

let _ = all_matches 6;;
(**
[|[|(0, 5); (1, 4); (2, 3)|];
  [|(1, 5); (2, 0); (3, 4)|];
  [|(2, 5); (3, 1); (4, 0)|];
  [|(3, 5); (4, 2); (0, 1)|];
  [|(4, 5); (0, 3); (1, 2)|]|]
*)

Answer 2

You don't need to compute the clockwise rotation by operating over actual data. You can represent it as picking indices in a fixed array (of things you rotate): after rotating the array t r times, the element at index i in the rotated array will be at index i+r in the original array, in fact (i+r) mod (Array.length t) to have wrap-around.

With this idea you could compute pairing without moving data around, simply incrementing a counter representing the number of rotations performed so far. In fact, you could probably even come up with a purely numerical solution that does not create any data structure (the array of things-to-rotate), and reasons on the various indices to apply this reasoning.

Answer 3

Although this question has been answered, but the correct answer is in an imperative way.

I finally found the following way to deal with round-robin algorithm simpler in functional way.

let round l1 l2 = let move = List.hd l2 in move::l1, (List.tl l2)@[move]

let combine m l1 l2 =
  let rec comb i acc = function
    |[], _ | _, [] -> acc
    |_ when i >= m -> acc
    |hd1::tl1, hd2::tl2 -> comb (i+1) ((hd1,hd2)::acc) (tl1,tl2)
  in
  comb 0 [] (l1,l2)

let round_robin l =
  let fix = List.hd l in
  let half = (List.length l)/2 in
  List.fold_left (
      fun (acc, (l1, l2)) _ -> (combine half (fix::l1) l2)::acc, round l1 l2
    ) ([], (List.tl l, List.rev l)) l |> fst |> List.tl