algorithm - 在 OCaml 中创造一个世纪

Question

这是一个非常典型的make a century问题。

我们有一个自然数列表[1;2;3;4;5;6;7;8;9]。

我们有一个可能的运算符列表[Some '+';一些 '*';无]。

现在我们根据上述可能性创建一个运算符列表，并将每个运算符插入数字列表中每个连续数字之间并计算值。

(注意 a 无 b = a * 10 + b)

例如，如果运算符列表是[Some '+';一些 '*';没有任何;一些“+”；一些“+”；一些“+”；一些“+”；一些 '+']，则值为 1 + 2 * 34 + 5 + 6 + 7 + 8 + 9 = 104。

请找到所有可能的运算符列表，因此value = 10。

---

我能想到的唯一方法就是暴力破解。

我生成所有可能的运算符列表。

计算所有可能的值。

然后进行过滤，以便我得到所有产生 100 的运算符列表。

exception Cannot_compute

let rec candidates n ops =
  if n = 0 then [[]]
  else 
    List.fold_left (fun acc op -> List.rev_append acc (List.map (fun x -> op::x) (candidates (n-1) ops))) [] ops


let glue l opl =
  let rec aggr acc_l acc_opl = function
    | hd::[], [] -> (List.rev (hd::acc_l), List.rev acc_opl)
    | hd1::hd2::tl, None::optl -> aggr acc_l acc_opl (((hd1*10+hd2)::tl), optl)
    | hd::tl, (Some c)::optl -> aggr (hd::acc_l) ((Some c)::acc_opl) (tl, optl)
    | _ -> raise Cannot_glue
  in 
  aggr [] [] (l, opl)

let compute l opl =
  let new_l, new_opl = glue l opl in
  let rec comp = function
    | hd::[], [] -> hd 
    | hd::tl, (Some '+')::optl -> hd + (comp (tl, optl))
    | hd1::hd2::tl, (Some '-')::optl -> hd1 + (comp ((-hd2)::tl, optl))
    | hd1::hd2::tl, (Some '*')::optl -> comp (((hd1*hd2)::tl), optl)
    | hd1::hd2::tl, (Some '/')::optl -> comp (((hd1/hd2)::tl), optl)
    | _, _ -> raise Cannot_compute
  in 
  comp (new_l, new_opl)

let make_century l ops =
  List.filter (fun x -> fst x = 100) (
    List.fold_left (fun acc x -> ((compute l x), x)::acc) [] (candidates ((List.length l)-1) ops))

let rec print_solution l opl =
  match l, opl with
    | hd::[], [] -> Printf.printf "%d\n" hd 
    | hd::tl, (Some op)::optl -> Printf.printf "%d %c " hd op; print_solution tl optl
    | hd1::hd2::tl, None::optl -> print_solution ((hd1*10+hd2)::tl) optl
    | _, _ -> ()

---

我相信我的代码很丑陋。所以我有以下问题

1. computer l opl是用数字列表和运算符列表进行计算。基本上这是一个典型的数学评估。有更好的实现吗？
2. 我已阅读 Pearls of Functional Algorithm Design 中的第 6 章.它使用了一些技术来提高性能。我发现它真的非常晦涩难懂。 读过它的人可以提供帮助吗？

编辑

我改进了我的代码。基本上，我将首先扫描运算符列表，以将所有数字粘贴到它们的运算符为 None 的位置。

然后在计算中，如果我遇到 '-'，我将简单地取反第二个数字。

Answer 1

一个经典的动态规划解决方案(找到= 104立即解决)，不会给运算符(operator)带来任何问题关联性或优先级。它只返回一个 bool 值，说明是否可以附带号码；修改它以返回获得解决方案的操作序列是一个简单但有趣的运动，我没有动力去那么远。

let operators = [ (+); ( * ); ]

module ISet = Set.Make(struct type t = int let compare = compare end)

let iter2 res1 res2 f =
  res1 |> ISet.iter @@ fun n1 ->
  res2 |> ISet.iter @@ fun n2 ->
  f n1 n2

let can_make input target =
  let has_zero = Array.fold_left (fun acc n -> acc || (n=0)) false input in
  let results = Array.make_matrix (Array.length input) (Array.length input) ISet.empty in
  for imax = 0 to Array.length input - 1 do
    for imin = imax downto 0 do
      let add n =
        (* OPTIMIZATION: if the operators are known to be monotonous, we need not store
           numbers above the target;

           (Handling multiplication by 0 requires to be a bit more
           careful, and I'm not in the mood to think hard about this
           (I think one need to store the existence of a solution,
           even if it is above the target), so I'll just disable the
           optimization in that case)
        *)
        if n <= target && not has_zero then
          results.(imin).(imax) <- ISet.add n results.(imin).(imax) in
      let concat_numbers =
        (* concatenates all number from i to j:
           i=0, j=2 -> (input.(0)*10 + input.(1))*10 + input.(2)
        *)
        let rec concat acc k =
          let acc = acc + input.(k) in
          if k = imax then acc
          else concat (10 * acc) (k + 1)
        in concat 0 imin
      in add concat_numbers;
      for k = imin to imax - 1 do
        let res1 = results.(imin).(k) in
        let res2 = results.(k+1).(imax) in
        operators |> List.iter (fun op ->
          iter2 res1 res2 (fun n1 n2 -> add (op n1 n2););
        );
      done;
    done;
  done;
  let result = results.(0).(Array.length input - 1) in
  ISet.mem target result