Ocaml speed : recursive function optimization

You are using a lot of List.append, which is not very efficient. This suggests that your data structure is not appropriate (for efficiency). You could for instance use Queue, which is well suited for “pop” and “append” games like this one. I adapted your code with Queue, and it runs 40x faster! (see the pliq function below). However note that Queue is a mutable data structure.

let rec pli2 jeu1 jeu2 tas1 tas2 nb_plis =
  match jeu1, jeu2 with
    [],_ | _,[] -> nb_plis
    |  c1::l1,c2::l2 ->
        begin
          if (c1 > c2) then pli2 (l1@(c1::c2::tas1)@tas2) l2 [] [] (nb_plis + 1)
          else if (c2 > c1) then pli2  l1 (l2@(c2::c1::tas2)@tas1) [] [] (nb_plis + 1)
          else match l1,l2 with
                 [],_ | _,[] -> nb_plis + 1
                 |  c11::l11,c22::l22 -> pli2 l11 l22 (tas1@[c1;c11]) (tas2@[c2;c22]) (nb_plis + 1)
        end

let rnd_jeu n =
  Array.init n (fun _ -> Random.int 55) |> Array.to_list

let pliq jeu1 jeu2 tas1 tas2 =
  let rec loop nb_plis =
    match Queue.take_opt jeu1, Queue.take_opt jeu2 with
    | None, _
      | _, None -> nb_plis
    | Some c1, Some c2 ->
       if c1 > c2 then begin
           Queue.add c1 jeu1;
           Queue.add c2 jeu1;
           Queue.transfer tas1 jeu1;
           Queue.transfer tas2 jeu1
         end else if c1 < c2 then  begin
           Queue.add c2 jeu2;
           Queue.add c1 jeu2;
           Queue.transfer tas2 jeu2;
           Queue.transfer tas1 jeu2
         end else begin
           Queue.add c1 tas1;
           Queue.add c2 tas2;
           Option.iter (fun c -> Queue.add c tas1) (Queue.take_opt jeu1);
           Option.iter (fun c -> Queue.add c tas2) (Queue.take_opt jeu2)
         end;
       loop (nb_plis + 1) in
  loop 0

let queue_of_list l =
  let q = Queue.create () in
  List.iter (fun c -> Queue.add c q) l;
  q

let time_it f =
  let t = Sys.time () in
  f ();
  print_endline (" Time = " ^ (string_of_float (Sys.time () -. t)))

let () =

  let n = 1000 in
  let jeu1 = rnd_jeu n in
  let jeu2 = rnd_jeu n in
  time_it (fun () ->
      pli2 jeu1 jeu2 [] [] 0
      |> print_int);

  let jeu1 = queue_of_list jeu1 in
  let jeu2 = queue_of_list jeu2 in
  time_it (fun () ->
      pliq jeu1 jeu2 (Queue.create ()) (Queue.create ())
      |> print_int)

On my (old) laptop I get

$ dune exec ./bataille.exe
460139 Time = 2.420278           
460139 Time = 0.061268

The first time 2.420278s is for your List implementation, and the second one 0.061268s for the Queue one.
I didn’t test it thoroughly, but the fact that they give the same number of rounds 460139 is a good sign!

4 Likes