Giải quyết ba lô prob trong F #: hiệu suất

Question

Tôi tìm thấy một bài viết:
Solving the 0-1 knapsack problem using continuation-passing style with memoization in F#

về bài toán xếp ba lô thực hiện trong F #. Khi tôi đang học ngôn ngữ này, tôi thấy điều này thực sự thú vị và cố gắng điều tra điều này một chút. Dưới đây là đoạn code tôi crafted:

open System 
open System.IO 
open System.Collections.Generic 

let parseToTuple (line : string) = 
    let parsedLine = line.Split(' ') |> Array.filter(not << String.IsNullOrWhiteSpace)   |> Array.map Int32.Parse 
    (parsedLine.[0], parsedLine.[1]) 

let memoize f = 
    let cache = Dictionary<_, _>() 
    fun x -> 
     if cache.ContainsKey(x) 
      then cache.[x] 
     else 
      let res = f x 
      cache.[x] <- res 
      res 

type Item = 
    { 
     Value : int 
     Size : int 
    } 

type ContinuationBuilder() = 
    member b.Bind(x, f) = fun k -> x (fun x -> f x k) 
    member b.Return x = fun k -> k x 
    member b.ReturnFrom x = x 

let cont = ContinuationBuilder() 

let set1 = 
    [ 
     (4, 11) 
     (8, 4) 
     (10, 5) 
     (15, 8) 
     (4, 3) 
    ] 

let set2 = 
    [ 
     (50, 341045); (1906, 4912); (41516, 99732); (23527, 56554); (559, 1818); (45136, 108372); (2625, 6750); (492, 1484) 
     (1086, 3072); (5516, 13532); (4875, 12050); (7570, 18440); (4436, 10972); (620, 1940); (50897, 122094); (2129, 5558) 
     (4265, 10630); (706, 2112); (2721, 6942); (16494, 39888); (29688, 71276); (3383, 8466); (2181, 5662); (96601, 231302) 
     (1795, 4690); (7512, 18324); (1242, 3384); (2889, 7278); (2133, 5566); (103, 706); (4446, 10992); (11326, 27552) 
     (3024, 7548); (217, 934); (13269, 32038); (281, 1062); (77174, 184848); (952, 2604); (15572, 37644); (566, 1832) 
     (4103, 10306); (313, 1126); (14393, 34886); (1313, 3526); (348, 1196); (419, 1338); (246, 992); (445, 1390) 
     (23552, 56804); (23552, 56804); (67, 634) 
    ] 

[<EntryPoint>] 
let main args = 
    // prepare list of items from a file args.[0] 
    let header, items = set1 
         |> function 
          | h::t -> h, t 
          | _ -> raise (Exception("Wrong data format")) 

    let N, K = header 
    printfn "N = %d, K = %d" N K 
    let items = List.map (fun x -> {Value = fst x ; Size = snd x}) items |> Array.ofList 

    let rec combinations = 
     let innerSolver key = 
      cont 
       { 
        match key with 
        | (i, k) when i = 0 || k = 0  -> return 0 
        | (i, k) when items.[i-1].Size > k -> return! combinations (i-1, k) 
        | (i, k)       -> let item = items.[i-1] 
                  let! v1 = combinations (i-1, k) 
                  let! beforeItem = combinations (i-1, k-item.Size) 
                  let v2 = beforeItem + item.Value 
                  return max v1 v2 
       } 
     memoize innerSolver 

    let res = combinations (N, K) id 
    printfn "%d" res 
    0 

Tuy nhiên, vấn đề với việc thực hiện này là nó veeeery chậm (trong thực tế tôi không thể giải quyết vấn đề với 50 mặt hàng và năng lực của ~ 300000, mà được giải quyết bằng cách ngây thơ của tôi thực hiện trong C# trong ít hơn 1s).

Bạn có thể cho tôi biết nếu tôi phạm sai lầm ở đâu đó không? Hoặc có thể việc thực hiện là chính xác và đây chỉ đơn giản là cách không hiệu quả để giải quyết vấn đề này.

Answer 1

Từ chạy mã này trong FSI:

open System 
open System.Diagnostics 
open System.Collections.Generic 

let time f = 
    System.GC.Collect() 
    let sw = Stopwatch.StartNew() 
    let r = f() 
    sw.Stop() 
    printfn "Took: %f" sw.Elapsed.TotalMilliseconds 
    r 

let mutable cacheHits = 0 
let mutable cacheMisses = 0 

let memoize f = 
    let cache = Dictionary<_, _>() 
    fun x -> 
     match cache.TryGetValue(x) with 
     | (true, v) -> 
      cacheHits <- cacheHits + 1 
      //printfn "Hit for %A - Result is %A" x v 
      v 
     | _ -> 
      cacheMisses <- cacheMisses + 1 
      //printfn "Miss for %A" x 
      let res = f x 
      cache.[x] <- res 
      res 

type Item = { Value : int; Size : int } 

type ContinuationBuilder() = 
    member b.Bind(x, f) = fun k -> x (fun x -> f x k) 
    member b.Return x = fun k -> k x 
    member b.ReturnFrom x = x 

let cont = ContinuationBuilder() 

let genItems n = 
    [| for i = 1 to n do 
      let size = i % 5 
      let value = (size * i) 
      yield { Value = value; Size = size } 
    |] 

let N, K = (80, 400) 
printfn "N = %d, K = %d" N K 

let items = genItems N 

//let rec combinations_cont = 
// memoize (
//  fun key -> 
//  cont { 
//    match key with 
//    | (0, _) | (_, 0)     -> return 0 
//    | (i, k) when items.[i-1].Size > k -> return! combinations_cont (i - 1, k) 
//    | (i, k)       -> let item = items.[i-1] 
//              let! v1 = combinations_cont (i-1, k) 
//              let! beforeItem = combinations_cont (i-1, k - item.Size) 
//              let v2 = beforeItem + item.Value 
//              return max v1 v2 
//  } 
// ) 
// 
// 
//cacheHits <- 0 
//cacheMisses <- 0 

//let res = time(fun() -> combinations_cont (N, K) id) 
//printfn "Answer: %d" res 
//printfn "Memo hits: %d" cacheHits 
//printfn "Memo misses: %d" cacheMisses 
//printfn "" 

let rec combinations_plain = 
    memoize (
     fun key -> 
       match key with 
       | (i, k) when i = 0 || k = 0  -> 0 
       | (i, k) when items.[i-1].Size > k -> combinations_plain (i-1, k) 
       | (i, k)       -> let item = items.[i-1] 
                 let v1 = combinations_plain (i-1, k) 
                 let beforeItem = combinations_plain (i-1, k-item.Size) 
                 let v2 = beforeItem + item.Value 
                 max v1 v2 
    ) 

cacheHits <- 0 
cacheMisses <- 0 

printfn "combinations_plain" 
let res2 = time (fun() -> combinations_plain (N, K)) 
printfn "Answer: %d" res2 
printfn "Memo hits: %d" cacheHits 
printfn "Memo misses: %d" cacheMisses 
printfn "" 

let recursivelyMemoize f = 
    let cache = Dictionary<_, _>() 
    let rec memoizeAux x = 
     match cache.TryGetValue(x) with 
     | (true, v) -> 
      cacheHits <- cacheHits + 1 
      //printfn "Hit for %A - Result is %A" x v 
      v 
     | _ -> 
      cacheMisses <- cacheMisses + 1 
      //printfn "Miss for %A" x 
      let res = f memoizeAux x 
      cache.[x] <- res 
      res 
    memoizeAux 

let combinations_plain2 = 
    let combinations_plain2Aux combinations_plain2Aux key = 
       match key with 
       | (i, k) when i = 0 || k = 0  -> 0 
       | (i, k) when items.[i-1].Size > k -> combinations_plain2Aux (i-1, k) 
       | (i, k)       -> let item = items.[i-1] 
                 let v1 = combinations_plain2Aux (i-1, k) 
                 let beforeItem = combinations_plain2Aux (i-1, k-item.Size) 
                 let v2 = beforeItem + item.Value 
                 max v1 v2 
    let memoized = recursivelyMemoize combinations_plain2Aux 
    fun x -> memoized x 

cacheHits <- 0 
cacheMisses <- 0 

printfn "combinations_plain2" 
let res3 = time (fun() -> combinations_plain2 (N, K)) 
printfn "Answer: %d" res3 
printfn "Memo hits: %d" cacheHits 
printfn "Memo misses: %d" cacheMisses 
printfn "" 

let recursivelyMemoizeCont f = 
    let cache = Dictionary HashIdentity.Structural 
    let rec memoizeAux x k = 
     match cache.TryGetValue(x) with 
     | (true, v) -> 
      cacheHits <- cacheHits + 1 
      //printfn "Hit for %A - Result is %A" x v 
      k v 
     | _ -> 
      cacheMisses <- cacheMisses + 1 
      //printfn "Miss for %A" x 
      f memoizeAux x (fun y -> 
       cache.[x] <- y 
       k y) 
    memoizeAux 

let combinations_cont2 = 
    let combinations_cont2Aux combinations_cont2Aux key = 
     cont { 
       match key with 
       | (0, _) | (_, 0)     -> return 0 
       | (i, k) when items.[i-1].Size > k -> return! combinations_cont2Aux (i - 1, k) 
       | (i, k)       -> let item = items.[i-1] 
                 let! v1 = combinations_cont2Aux (i-1, k) 
                 let! beforeItem = combinations_cont2Aux (i-1, k - item.Size) 
                 let v2 = beforeItem + item.Value 
                 return max v1 v2 
     } 
    let memoized = recursivelyMemoizeCont combinations_cont2Aux 
    fun x -> memoized x id 

cacheHits <- 0 
cacheMisses <- 0 

printfn "combinations_cont2" 
let res4 = time (fun() -> combinations_cont2 (N, K)) 
printfn "Answer: %d" res4 
printfn "Memo hits: %d" cacheHits 
printfn "Memo misses: %d" cacheMisses 
printfn "" 

tôi nhận được những kết quả này:

N = 80, K = 400 
combinations_plain 
Took: 7.191000 
Answer: 6480 
Memo hits: 6231 
Memo misses: 6552 

combinations_plain2 
Took: 6.310800 
Answer: 6480 
Memo hits: 6231 
Memo misses: 6552 

combinations_cont2 
Took: 17.021200 
Answer: 6480 
Memo hits: 6231 
Memo misses: 6552 

• combinations_plain là từ câu trả lời của latkin.
• combinations_plain2 hiển thị bước ghi nhớ đệ quy một cách rõ ràng.
• combinations_cont2 điều chỉnh chức năng ghi nhớ đệ quy thành một hàm ghi nhớ các kết quả tiếp tục.
• combinations_cont2 hoạt động bằng cách chặn kết quả trong quá trình tiếp tục trước khi chuyển tiếp sang tiếp tục thực tế. Các cuộc gọi tiếp theo trên cùng một khóa cung cấp một sự tiếp tục và sự tiếp tục này được cung cấp cho câu trả lời mà chúng ta đã chặn ban đầu.

này cho thấy rằng chúng tôi có thể:

1. Memoize sử dụng tiếp tục phong cách đi qua.
2. Đạt được các đặc tính hiệu suất tương tự (ish) đối với phiên bản ghi nhớ vani.

Tôi hy vọng điều này sẽ xóa mọi thứ một chút. Xin lỗi, đoạn mã blog của tôi chưa hoàn thành (tôi nghĩ rằng tôi có thể đã mất nó khi định dạng lại gần đây).

Answer 2

Khi bạn ngây thơ áp dụng bộ ghi nhớ chung như thế này và sử dụng tính năng chuyển tiếp liên tục, các giá trị trong bộ nhớ cache ghi nhớ của bạn là tiếp tục, chứ không phải kết quả "cuối cùng" thông thường. Vì vậy, khi bạn nhận được một bộ nhớ cache hit, bạn không nhận được một kết quả cuối cùng, bạn đang nhận được một số chức năng mà hứa hẹn sẽ tính toán một kết quả khi bạn gọi nó. gọi này có thể rất tốn kém, có thể gọi continuations khác nhau, cuối cùng có thể đạt cache memoization lại chính nó, vv

memoizing có hiệu quả chức năng tiếp tục đi qua như vậy mà một) các bộ nhớ đệm có tác dụng đầy đủ hiệu lực thi hành và b) sự chức năng vẫn còn đệ quy đuôi là khá khó khăn. Đọc this thảo luận và quay lại khi bạn hoàn toàn hiểu tất cả. ;-)

Tác giả của bài đăng trên blog mà bạn đã liên kết đang sử dụng một trình ghi nhớ phức tạp hơn, ít chung chung hơn được trang bị đặc biệt cho vấn đề. Phải thừa nhận rằng, tôi không hoàn toàn grok nó (mã trên blog là không đầy đủ/bị hỏng, rất khó để thử nó ra), nhưng tôi nghĩ rằng ý chính của nó là nó "lực lượng" chuỗi liên tục trước khi bộ nhớ đệm số nguyên cuối cùng kết quả.

Để minh họa điểm này, đây là một cấu trúc lại nhanh chóng mã của bạn là hoàn toàn khép kín và vạch ra thông tin liên quan:

open System 
open System.Collections.Generic 

let mutable cacheHits = 0 
let mutable cacheMisses = 0 

let memoize f = 
    let cache = Dictionary<_, _>() 
    fun x -> 
     match cache.TryGetValue(x) with 
     | (true, v) -> 
      cacheHits <- cacheHits + 1 
      printfn "Hit for %A - Result is %A" x v 
      v 
     | _ -> 
      cacheMisses <- cacheMisses + 1 
      printfn "Miss for %A" x 
      let res = f x 
      cache.[x] <- res 
      res 

type Item = { Value : int; Size : int } 

type ContinuationBuilder() = 
    member b.Bind(x, f) = fun k -> x (fun x -> f x k) 
    member b.Return x = fun k -> k x 
    member b.ReturnFrom x = x 

let cont = ContinuationBuilder() 

let genItems n = 
    [| for i = 1 to n do 
     let size = i % 5 
     let value = (size * i) 
     yield { Value = value; Size = size } 
    |] 

let N, K = (5, 100) 
printfn "N = %d, K = %d" N K 

let items = genItems N 

let rec combinations_cont = 
    memoize (
    fun key -> 
     cont { 
       match key with 
       | (0, _) | (_, 0)     -> return 0 
       | (i, k) when items.[i-1].Size > k -> return! combinations_cont (i - 1, k) 
       | (i, k)       -> let item = items.[i-1] 
                 let! v1 = combinations_cont (i-1, k) 
                 let! beforeItem = combinations_cont (i-1, k - item.Size) 
                 let v2 = beforeItem + item.Value 
                 return max v1 v2 
     } 
    ) 

let res = combinations_cont (N, K) id 
printfn "Answer: %d" res 
printfn "Memo hits: %d" cacheHits 
printfn "Memo misses: %d" cacheMisses 
printfn "" 

let rec combinations_plain = 
    memoize (
    fun key -> 
       match key with 
       | (i, k) when i = 0 || k = 0  -> 0 
       | (i, k) when items.[i-1].Size > k -> combinations_plain (i-1, k) 
       | (i, k)       -> let item = items.[i-1] 
                 let v1 = combinations_plain (i-1, k) 
                 let beforeItem = combinations_plain (i-1, k-item.Size) 
                 let v2 = beforeItem + item.Value 
                 max v1 v2 
    ) 

cacheHits <- 0 
cacheMisses <- 0 

let res2 = combinations_plain (N, K) 
printfn "Answer: %d" res2 
printfn "Memo hits: %d" cacheHits 
printfn "Memo misses: %d" cacheMisses 

Như bạn có thể thấy, phiên bản CPS là bộ nhớ đệm continuations (không số nguyên) và có rất nhiều hoạt động bổ sung đang diễn ra vào cuối khi các lần tiếp tục được gọi.

Nếu bạn tăng kích thước vấn đề lên let (N, K) = (20, 100) (và xóa các câu lệnh printfn trong bộ ghi nhớ), bạn sẽ thấy phiên bản CPS kết thúc lên hơn 1 triệu lần tra cứu bộ nhớ cache, so với phiên bản thuần chỉ làm vài trăm.