在OCaml創造一個世紀

Question

這是一個相當典型的make a century問題。我們有一個自然數列表。

我們有一個可能的運營商列表[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

這是我的解決方案，根據通常的優先規則進行評估。它在我的MacBook Pro上1/10秒內找到303個解決方案find [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 

這是蠻力解決方案。唯一稍微聰明的是我將數字連接看作是另一個（高優先級）操作。

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 2

我想出了一個稍微模糊的實現（對於這個問題的變體），這比蠻力更好一些。它的工作原理不是生成中間數據結構，而是跟蹤已經評估的操作員的組合值。

訣竅是跟蹤待定運算符和值，以便您可以輕鬆評估「無」運算符。也就是說，如果算法剛剛進行了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 

請注意，這會生成重複項 - 我沒有打算解決這個問題。另外，如果你正在做這個練習以獲得功能性編程的強大功能，那麼拒絕這裏採取的命令式方法並尋找一個不使用任務的類似解決方案可能是有益的。

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