用OCaml制作一个世纪

Question

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

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

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

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

（注意a无b=a*10b）

例如，如果运算符列表是[Some'；Some'*'；None；Some'；Some'；Some'；Some'；Some']，则值是12*34 5 6 7 8 9=104。

请查找所有可能的操作员列表，因此值=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. 计算机l opl是利用数字列表和算子列表来计算的。基本上是典型的数学测评。有没有更好的实现？
2. 我读过《函数算法设计的珍珠》第6章。它使用了一些技术来提高性能。我发现它真的很晦涩难懂。任何读过的人都能帮上忙？

编辑

我改进了我的代码。基本上，我将首先扫描操作员列表，将所有编号粘贴到操作员为None的位置。

然后在计算中，如果我遇到一个“-”，我将简单地对第二个数字求反。

Answer 1

我提出了一个稍微模糊的实现（针对这个问题的一个变体），它比暴力要好一点。它就地工作，而不是生成中间数据结构，跟踪已经评估的运算符的组合值。

诀窍是跟踪挂起的运算符和值，以便可以轻松地计算“none”运算符。也就是说，如果算法刚刚进行了123，则挂起的运算符将是，挂起的值将是23，允许您根据需要轻松生成1234或1234。

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

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

Answer 2

这是我的解决方案，它根据通常的优先级规则进行评估。它在我的MacBook Pro上找到303个解决方案，在不到1/10秒的时间内找到[1； 2； 3； 4； 5； 6； 7； 8； 9] 100。

这里有两个有趣的例子：

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

这是一个强力解决方案。唯一稍微聪明一点的是，我将数字的串联处理为简单的另一个（高优先级）操作。

函数是标准的基于堆栈的内插表达式计算，您会发现它描述了许多地方。下面是一篇关于它的SO文章：如何使用堆栈在一次扫描中计算内插表达式？本质上是通过将运算符和操作数推到堆栈上来推迟规避。当您发现下一个运算符具有较低的优先级时，您可以返回并评估您推送的内容。

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

一个经典的动态编程解决方案（它立即找到=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