在OCaml创造一个世纪

Question

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

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

我们列出了可能的运营商[Some '+'; Some '*';None]。

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

（注意a None b = a * 10 + b）

例如，如果运算符列表为[Some '+'; Some '*'; None; Some '+'; Some '+'; Some '+'; Some '+'; Some '+']，则值为1 + 2 * 34 + 5 + 6 + 7 + 8 + 9 = 104。

请找到所有可能的运营商列表，因此the 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 立即解决方案）不会给运营商带来任何问题 关联性或优先性。它只返回一个布尔表示是否 它可以带有数字;修改它以返回 获得解决方案的操作序列很简单但很有趣 运动，我没有动力去那么远。

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

Answer 2

这是我的解决方案，根据通常的优先规则进行评估。它在我的MacBook Pro上以1/10秒的速度找到了find [1;2;3;4;5;6;7;8;9] 100的303个解决方案。

以下是两个有趣的内容：

# 123 - 45 - 67 + 89;;
- : int = 100
# 1 * 2 * 3 - 4 * 5 + 6 * 7 + 8 * 9;;
- : int = 100

这是一个强力解决方案。唯一有点聪明的是，我将数字连接视为另一个（高优先级）操作。

eval函数是标准的基于堆栈的中缀表达式评估，您将在很多地方找到它。这是一篇关于它的SO文章：How to evaluate an infix expression in just one scan using stacks?本质上是通过将运算符和操作数推送到堆栈来推迟评估。当您发现下一个操作符的优先级较低时，您可以返回并评估您推送的内容。

type op = Plus | Minus | Times | Divide | Concat

let prec = function
    | Plus | Minus -> 0
    | Times | Divide -> 1
    | Concat -> 2

let succ = function
    | Plus -> Minus
    | Minus -> Times
    | Times -> Divide
    | Divide -> Concat
    | Concat -> Plus

let apply op stack =
    match op, stack with
    | _, [] | _, [_] -> [] (* Invalid input *)
    | Plus, a :: b :: tl -> (b + a) :: tl
    | Minus, a :: b :: tl -> (b - a) :: tl
    | Times, a :: b :: tl -> (b * a) :: tl
    | Divide, a :: b :: tl -> (b / a) :: tl
    | Concat, a :: b :: tl -> (b * 10 + a) :: tl

let rec eval opstack numstack ops nums =
    match opstack, numstack, ops, nums with
    | [], sn :: _, [], _ -> sn
    | sop :: soptl, _, [], _ ->
        eval soptl (apply sop numstack) ops nums
    | [], _, op :: optl, n :: ntl ->
        eval [op] (n :: numstack) optl ntl
    | sop :: soptl, _, op :: _, _ when prec sop >= prec op ->
        eval soptl (apply sop numstack) ops nums
    | _, _, op :: optl, n :: ntl ->
        eval (op :: opstack) (n :: numstack) optl ntl
    | _ -> 0 (* Invalid input *)

let rec incr = function
    | [] -> []
    | Concat :: rest -> Plus :: incr rest
    | x :: rest -> succ x :: rest

let find nums tot =
    match nums with
    | [] -> []
    | numhd :: numtl ->
        let rec try1 ops accum =
            let accum' =
                if eval [] [numhd] ops numtl = tot then
                    ops :: accum
                else
                    accum
            in
            if List.for_all ((=) Concat) ops then
                accum'
            else try1 (incr ops) accum'
        in
        try1 (List.map (fun _ -> Plus) numtl) []

Answer 3

我提出了一个稍微模糊的实现（对于这个问题的变种），它比蛮力更好一点。它可以在适当的位置工作，而不是生成中间数据结构，跟踪已经评估过的运算符的组合值。

诀窍是跟踪待处理的运算符和值，以便您可以轻松地评估“无”运算符。也就是说，如果算法刚刚进展1 + 23，则待处理运算符为+，待处理值为23，这样您就可以轻松生成1 + 23 + 4或必要时1 + 234。

type op = Add | Sub | Nothing

let print_ops ops =
  let len = Array.length ops in
  print_char '1';
  for i = 1 to len - 1 do
    Printf.printf "%s%d" (match ops.(i) with
     | Add -> " + "
     | Sub -> " - "
     | Nothing -> "") (i + 1)
  done;
  print_newline ()

let solve k target =
  let ops = Array.create k Nothing in
  let rec recur i sum pending_op pending_value =
    let sum' = match pending_op with
      | Add -> sum + pending_value
      | Sub -> if sum = 0 then pending_value else sum - pending_value
      | Nothing -> pending_value in
    if i = k then
      if sum' = target then print_ops ops else ()
    else
      let digit = i + 1 in
      ops.(i) <- Add;
      recur (i + 1) sum' Add digit;
      ops.(i) <- Sub;
      recur (i + 1) sum' Sub digit;
      ops.(i) <- Nothing;
      recur (i + 1) sum pending_op (pending_value * 10 + digit) in
  recur 0 0 Nothing 0

请注意，这将产生重复 - 我没有费心去解决这个问题。此外，如果您正在进行此练习以获得函数式编程的优势，那么拒绝此处采用的命令式方法并搜索不使用赋值的类似解决方案可能是有益的。