ocaml - 为什么这个 OCaml 代码这么慢？

Question

我是 OCaml 新手。我在 OCaml 中编写了一个简单的程序来生成公平和平方数(一个数字是回文和另一个回文的平方，更多详情:https://code.google.com/codejam/contest/2270488/dashboard#s=p2 )如下:

更新 1:优化算法(在我的笔记本电脑上大约需要 20 秒):

open Printf;;

let rec _is_palindrome s i j =
  i >= j || 
  (s.[i] = s.[j] && 
      _is_palindrome s (i + 1) (j - 1))
;;

let is_palindrome s =
  let sl = String.length s in
    sl > 0 && (_is_palindrome s 0 (sl - 1))
;;

let rec del_zeros s =
  let sl = String.length s in
    if (sl < 1) then
      s
    else
      (if s.[0] = '0' then
         del_zeros (String.sub s 1 (sl - 1))
       else
         s
      )
;;

let c2i c =
  Char.code c - Char.code '0'
;;

let i2c i =
  Char.chr (i + Char.code '0')
;;

(* only for finding fair and square numbers *)
let square s =
  let slen = String.length s in
    if slen < 1 then
      ""
    else
      let reslen = 2 * slen in
      let t = ref 0 in
        t := 0;
        (* fast check *)
        (let i = reslen/2 in
           for j = (slen - 1) downto 0 do
             if (i - 1 - j) >= 0 && (i - 1 - j) < slen then
               t := !t + (c2i s.[j]) * (c2i s.[i - 1 - j]);
           done;
           if !t > 9 then
             (* jump out *)
             raise (Invalid_argument "carry");
        ); 
        (let res = String.make reslen '0' in
           (* do the square cal now *)
           for i = (reslen - 1) downto 1 do
             t := 0;
             for j = (slen - 1) downto 0 do
               if (i - 1 - j) >= 0 && (i - 1 - j) < slen then
                 t := !t + (c2i s.[j]) * (c2i s.[i - 1 - j]);
             done;
             if !t > 9 then
               (* jump out *)
               raise (Invalid_argument "carry");
             res.[i] <- i2c !t;
           done;
           del_zeros res
        );
;;

let rec check_fs fsns p =
  try let sq = square p in
    if (is_palindrome sq) then
      sq :: fsns
    else
      fsns
  with Invalid_argument "carry" ->
    fsns
;;

(* build the fair and square number list *)
(* dfs *)
let rec create_fair_square_nums fsns p sum max_num_digs =
  let l = String.length p in
    if l > max_num_digs || sum > 9 then
          fsns
    else
      let fsns = create_fair_square_nums fsns ("0" ^ p ^ "0") sum max_num_digs in
      let fsns = create_fair_square_nums fsns ("1" ^ p ^ "1") (sum + 1) max_num_digs in
      let fsns = create_fair_square_nums fsns ("2" ^ p ^ "2") (sum + 4)  max_num_digs in
      let fsns = create_fair_square_nums fsns ("3" ^ p ^ "3") (sum + 9) max_num_digs in
      let fsns = check_fs fsns p in
        fsns
;;

let rec print_fsns fsns =
  List.iter (fun s -> printf "%s " s) fsns;
  printf "\n"
;;

let num_str_cmp s1 s2 =
  let len1 = String.length s1 in
  let len2 = String.length s2 in
    match (len1 - len2) with
      | 0 ->
          String.compare s1 s2
      | cmp -> cmp
;;

(* works *)

let max_dig = 51;;

let fsns = 
  let fsns = create_fair_square_nums [] "" 0 max_dig in
  let fsns = create_fair_square_nums fsns "0" 0 max_dig in
  let fsns = create_fair_square_nums fsns "1" 1 max_dig in
  let fsns = create_fair_square_nums fsns "2" 4 max_dig in
    create_fair_square_nums fsns "3" 9 max_dig
;;

let fsns = List.sort num_str_cmp fsns;;

print_fsns fsns;;

我的原始代码(天真的解决方案，太慢了):

open Printf;;

let rec _is_palindrome s i j =
  if i < j then
    if s.[i] = s.[j] then
      _is_palindrome s (i + 1) (j - 1)
    else
      false
  else
    true
;;

let is_palindrome s =
  if (String.length s < 1) then
    false
  else
    _is_palindrome s 0 ((String.length s) - 1)
;;

let rec del_zeros s =
  let sl = String.length s in
    if (sl < 1) then
      s
    else
      (if s.[0] = '0' then
         del_zeros (String.sub s 1 (sl - 1))
       else
         s
      )
;;

let c2i c =
  Char.code c - Char.code '0'
;;

let i2c i =
  Char.chr (i + Char.code '0')
;;

(* only positive number *)
let square s =
  (* including the carry dig *)
  let slen = String.length s in
  let res = (
    if slen > 0 then
      let reslen = 2 * slen in
      let res = String.make reslen '0' in
      let t = ref 0 in
        for i = (reslen - 1) downto 1 do
          t := c2i (res.[i]);
          for j = (slen - 1) downto 0 do
            if (i - 1 - j) >= 0 && (i - 1 - j) < slen then
              (t := !t + (c2i s.[j]) * (c2i s.[i - 1 - j]);
          (* printf "%d, %d: %d\n" j (i - 1 - j) !t; *) )
          done;
          (* printf "%d: %d\n" i !t; *)
          if !t > 9 then
            (res.[i - 1] <- 
             Char.chr (Char.code res.[i - 1] + (!t / 10));
             t := !t mod 10
            );
          res.[i] <- i2c !t;
        done;
        res;
        else
          ""
  ) in
    (* printf "square %s -> %s\n" s res; *)
    del_zeros res
;;

let extend_palindrome new_ps n = 
  ("0" ^ n ^ "0") :: 
  ("1" ^ n ^ "1") :: 
  ("2" ^ n ^ "2") :: 
  ("3" ^ n ^ "3") :: 
  new_ps
;;

let rec extend_palindromes new_ps ps = 
  match ps with
    | [] -> new_ps
    | h :: t -> 
        let new_ps = extend_palindrome new_ps h in
          extend_palindromes new_ps t
;;

let rec check_fs fsns ps =
  match ps with
    | [] -> fsns
    | h :: t -> 
        let sq = square h in
          if (is_palindrome sq) then
            check_fs (sq :: fsns) t
          else 
            check_fs fsns t
;;

(* build the fair and square number list *)
let rec create_fair_square_nums fsns ps max_num_digs =
  match ps with
    | h :: t ->
        if String.length h > max_num_digs then
          fsns
        else
          let ps = extend_palindromes [] ps in
          let fsns = check_fs fsns ps in
            create_fair_square_nums fsns ps max_num_digs
    | [] ->
        raise (Invalid_argument "fsn should not be []")
;;

let rec print_fsns fsns =
  List.iter (fun s -> printf "%s " s) fsns;
  printf "\n"
;;

let num_str_cmp s1 s2 =
  let len1 = String.length s1 in
  let len2 = String.length s2 in
    match (len1 - len2) with
      | 0 ->
          String.compare s1 s2
      | cmp -> cmp
;;

(* works *)

let max_dig = 50;;

let fsns = 
  let fsns0 = create_fair_square_nums [] [""] max_dig in
  let fsns1 = create_fair_square_nums [] ["0"; "1"; "2"; "3"] max_dig in
    (* print_fsns fsns0;
    print_fsns fsns1; *)
    ["0"; "1"; "4"; "9"] @ fsns0 @ fsns1
;;

(* print_fsns fsns;; *)

let fsns = List.sort num_str_cmp fsns;;

print_fsns fsns;;

此代码生成 10^100 以内的公平和平方数。

此代码在性能方面应该存在一些(或许多)问题。在我杀死它之前它运行了 30 多分钟。当 max_dig = 14 时，它很快完成(< 1 分钟)。

欢迎任何改进此代码的建议或批评。

Answer 1

这可能是许多其他问题中的一个(并且可能被忽略在您的用例中，您应该进行概要分析以找出答案)，但是这段代码代码段已经存在算法问题:

let rec del_zeros s =
  let sl = String.length s in
    if (sl < 1) then
      s
    else
      (if s.[0] = '0' then
         del_zeros (String.sub s 1 (sl - 1))
       else
         s
      )
;;

String.sub 在长度参数上是线性的(在内存中，因此时间)，所以整个函数是二次函数:del_zeros
(String.make 50_000 '0') 可能会很慢。

要有效地编写此代码，您应该收集保留的字符在列表累加器中，边走边累加总长度，以及最后创建一个大小合适的字符串并写入这些字符

作为近似值，使用 Buffer 的自然代码已经是相当高效(这就是我建议通常写的应用程序，但如果那是一部分的话，可能不在算法竞赛中关键路径):

let del_zeros s =
  let buf = Buffer.create (String.length s) in
  for i = 0 to (String.length s) - 1 do
    if s.[i] <> '0' then Buffer.add_char buf s.[i]
  done;
  Buffer.contents buf