Rozwiązywanie plecak prob w F #: wydajność

Question

znalazłem artykuł:
Solving the 0-1 knapsack problem using continuation-passing style with memoization in F#

o problem plecakowy realizowanego w F #. Ponieważ uczę się tego języka, uznałem to za naprawdę interesujące i próbowałem to trochę zbadać. Oto kod I wykonany:

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 

Jednak problem z tego wdrożenia jest to, że veeeery powolny (w praktyce jestem w stanie rozwiązać problemu z 50 elementów i pojemności ~ 300000, który zostaje rozwiązane przez mój naiwny implementacja w języku C# w czasie krótszym niż 1 s).

Czy możesz mi powiedzieć, czy gdzieś popełniłem błąd? A może wdrożenie jest poprawne i jest to po prostu nieskuteczny sposób rozwiązania tego problemu.

Answer 1

Od uruchomiony ten kod w 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 "" 

uzyskać te wyniki:

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 wynosi od latkin na odpowiedź.
• combinations_plain2 jawnie ujawnia krok rekurencyjnej notacji.
• combinations_cont2 dostosowuje funkcję memoization rekurencyjnej do jednego, że memoizes wyniki kontynuację.
• combinations_cont2 działa przechwytując wynik w kontynuacji przed przekazaniem go do rzeczywistej kontynuacji. Kolejne wywołania tego samego klucza zapewniają kontynuację, a ta kontynuacja jest odpowiedzią, którą przechwyciliśmy pierwotnie.

To pokazuje, że jesteśmy w stanie:

1. Memoize użyciu kontynuacji przechodzącą styl.
2. Osiągnięcie podobnych (ish) charakterystyk wydajności do wersji z pamięcią waniliową.

Mam nadzieję, że to trochę wyjaśni. Niestety, fragment kodu na blogu był niekompletny (prawdopodobnie został utracony po niedawnym przeformatowaniu).

Answer 2

Kiedy naiwnie stosujesz ogólny typ pamięci i stosujesz przekazywanie kontynuacji, wartości w pamięci podręcznej zapamiętywania są następujące: kontynuacja, a nie regularne "końcowe" wyniki. Tak więc, gdy otrzymasz trafienie w pamięci podręcznej, nie otrzymasz sfinalizowanego wyniku, otrzymujesz z powrotem jakąś funkcję, która obiecuje obliczyć wynik, gdy go przywołasz. To wezwanie może być drogie, może wywołać różne inne kontynuacje, może ostatecznie trafić cache memoization znowu sama, itp

Skutecznie memoizing funkcje uzupełniające pominięciem takich, że a) buforowanie pracować z pełną mocą oraz b) się funkcja pozostaje rekursywna ogonowo jest dość trudna. Przeczytaj dyskusję this i wróć, kiedy w pełni to zrozumiesz. ;-)

Autor blogu ty połączonego stosuje bardziej wyrafinowane, mniej rodzajowe memoizer który został specjalnie dopasowany do problemu. Trzeba przyznać, że nie w pełni to jeszcze gram (kod na blogu jest niekompletny/zepsuty, tak trudny do wypróbowania), ale myślę, że sedno tego polega na tym, że "wymusza" łańcuch kontynuacji przed zapisaniem końcowej liczby całkowitej. wynik.

Aby zilustrować punkt, oto szybkie Refactor swojego kodu, który jest w pełni samowystarczalny i ślady na odpowiednią informację:

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 

Jak widać, wersja CPS jest buforowanie kontynuacje (nie całkowite) i jest wiele dodatkowej aktywności pod koniec, gdy przywoływane są kontynuacje.

Jeśli zwiększenie rozmiaru problemu do let (N, K) = (20, 100) (i usunąć printfn oświadczenia w memoizer), widać, że wersja CPS kończy się robi ponad 1 mln wyszukiwań cache, w porównaniu do zwykłej wersji robi tylko kilkaset.