http://d.hatena.ne.jp/ymotongpoo/20101209/1291879286

paren.ml

module A = struct

  let map f l = List.rev (List.rev_map f l)
  let enclose x = "(" ^ x ^ ")"
  let cross lhs rhs =
  let rec cross_aux accu = function
    | [] -> accu
    | x::xs -> cross_aux (List.fold_left (fun a y -> (x^y)::a) accu rhs) xs
  in
  cross_aux [] lhs
  ;;

  let rec solution = function
    | 0 -> []
    | n when n < 0 -> prerr_int n; invalid_arg "solution"
    | n -> List.rev_append (atomic n) (separate n)
  and atomic = function
    | 1 -> ["()"]
    | n -> map enclose (solution (n-1))
  and separate n =
    let rec separate_aux accu = function
      | 0 -> accu
      | k -> separate_aux (List.rev_append (cross (atomic k) (solution (n-k))) accu) (pred k)
    in
    separate_aux [] (n-1)
  ;;

  let test num = 
    begin
      let _ = List.map (fun x -> Printf.printf "%s," x) (solution num)in
      Printf.printf "%d\n%!" (List.length (solution num));
    end
  ;;

end;;

(** 
 * memoizing just a result of each number, i.e. do not memo
 * result of atomic and separate.
 *)

module B : sig

  val map : ('a -> 'b) -> 'a list -> 'b list
  val enclose : string -> string
  val cross : string list -> string list -> string list
  val solver : (int, string list) Hashtbl.t -> int -> string list
  val fast_solver : (int, string list) Hashtbl.t -> 
                    (int, string list) Hashtbl.t ->
                    (int, string list) Hashtbl.t -> int -> string list
  val test : int -> int -> unit
  val fast_test : int -> int -> unit

end = struct

  let map f l = List.rev (List.rev_map f l)
  let enclose x = "(" ^ x ^ ")"
  let cross lhs rhs =
  let rec cross_aux accu = function
    | [] -> accu
    | x::xs -> cross_aux (List.fold_left (fun a y -> (x^y)::a) accu rhs) xs
  in
  cross_aux [] lhs
  ;;

  (**
    val solution : int -> string list
    val atomic : int -> string list
    val separate : int -> string list
  *)
  let solver table n = 
    let rec solution n =
      match n with
      | 0 -> []
      | n when n < 0 -> prerr_int n; invalid_arg "solution"
      | n ->
          if Hashtbl.mem table n
          then Hashtbl.find table n
          else
            begin
              let v = List.rev_append (atomic n) (separate n) in
              Hashtbl.add table n v;
              v
            end
    and atomic n =
      match n with
      | 1 -> ["()"]
      | n -> map enclose (solution (n-1))
    and separate n =
      let rec separate_aux accu = function
        | 0 -> accu
        | k -> separate_aux (List.rev_append (cross (atomic k) (solution (n-k))) accu) (pred k)
      in
      separate_aux [] (n-1)
    in
    solution n
  ;;
  

  let fast_solver tbl atbl stbl n =
    let rec solution n =
      match n with
      | 0 -> []
      | n when n < 0 -> prerr_int n; invalid_arg "solution"
      | n ->
          if Hashtbl.mem tbl n
          then Hashtbl.find tbl n
          else
            begin
              let v = List.rev_append (atomic n) (separate n) in
              Hashtbl.add tbl n v;
              v
            end
    and atomic n =
      match n with
      | 1 -> ["()"]
      | n -> 
          if Hashtbl.mem atbl n
          then Hashtbl.find atbl n
          else
            begin
              let v = map enclose (solution (n-1)) in
              Hashtbl.add atbl n v;
              v
            end
    and separate n =
      let rec separate_aux accu = function
        | 0 -> accu
        | k -> separate_aux (List.rev_append (cross (atomic k) (solution (n-k))) accu) (pred k)
      in
      if Hashtbl.mem stbl n
      then Hashtbl.find stbl n
      else
        begin
          let v = separate_aux [] (n-1) in
          Hashtbl.add stbl n v;
          v
        end
    in
    solution n
  ;;


  let test buf num = 
    begin
      let table = Hashtbl.create buf in
      print_endline "*** test start ***";
      (** let _ = List.map (fun x -> Printf.printf "%s," x) (solution table num) in *)
      Printf.printf "%d\n%!" (List.length (solver table num));
    end
  ;;

  let fast_test buf num =
    begin
      let tbl = Hashtbl.create buf 
      and atbl = Hashtbl.create buf
      and stbl = Hashtbl.create buf in
      print_endline "*** fast test start ***";
      Printf.printf "%d\n%!" (List.length (fast_solver tbl atbl stbl num));
    end
  ;;

end;;

(** let _ = B.test 100 14 *)
let _ = B.fast_test 100 14