ocaml - なぜこの OCaml コードはとても遅いのですか?

Question

私は OCaml 初心者です。OCaml で単純なプログラムを作成して、公正な数と平方数 (回文と別の回文の 2 乗である数値、詳細はこちら: 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 分)。

このコードを改善するための提案や批判は、どちらも大歓迎です。