plus longue sous-séquence commune en orme avec memoization

Question

Je voudrais faire une version efficace de l'algorithme LCS en orme. J'aime cette version ocaml mais elle utilise des effets secondaires pour mettre en cache les résultats au fur et à mesure.

let lcs xs ys = 
    let cache = Hashtbl.create 16 in 
    let rec lcs xs ys = 
    try Hashtbl.find cache (xs, ys) with 
    | Not_found -> 
     let result = 
      match xs, ys with 
      | [], _ -> [] 
      | _, [] -> [] 
      | x :: xs, y :: ys when x = y -> 
       x :: lcs xs ys 
      | _ :: xs_rest, _ :: ys_rest -> 
       let a = lcs xs_rest ys in 
       let b = lcs xs  ys_rest in 
       if (List.length a) > (List.length b) then a else b 
     in 
     Hashtbl.add cache (xs, ys) result; 
     result 
    in 
    lcs xs ys 

Comment faire si je veux utiliser memoization dans elm?

Answer 1

Gilbert Kennen sur slack m'a donné une version qui semble fonctionner encore mieux:

lcs : List a -> List a -> List a 
lcs xs ys = 
    lcsHelper xs ys (0, 0) Dict.empty 
     |> Dict.get (0, 0) 
     |> Maybe.map Tuple.second 
     |> Maybe.withDefault [] 


lcsHelper : List a -> List a -> (Int, Int) -> Dict (Int, Int) (Int, List a) -> Dict (Int, Int) (Int, List a) 
lcsHelper xs ys position memo = 
    case (Dict.get position memo, xs, ys) of 
     (Nothing, x :: xRest, y :: yRest) -> 
      let 
       nextYPos = 
        Tuple.mapSecond ((+) 1) position 

       nextXPos = 
        Tuple.mapFirst ((+) 1) position 

       newMemo = 
        memo 
         |> lcsHelper xs yRest nextYPos 
         |> lcsHelper xRest ys nextXPos 

       best = 
        maxListTuple 
         (get nextXPos newMemo) 
         (get nextYPos newMemo) 
         |> consIfEqual x y 
      in 
       Dict.insert position best newMemo 

     _ -> 
      memo 

get : (Int, Int) -> Dict (Int, Int) (Int, List a) -> (Int, List a) 
get position memo = 
    Dict.get position memo |> Maybe.withDefault (0, []) 


maxListTuple : (Int, List a) -> (Int, List a) -> (Int, List a) 
maxListTuple (xLen, xs) (yLen, ys) = 
    if yLen > xLen then 
     (yLen, ys) 
    else 
     (xLen, xs) 


consIfEqual : a -> a -> (Int, List a) -> (Int, List a) 
consIfEqual x y (listLen, list) = 
    if x == y then 
     (listLen + 1, x :: list) 
    else 
     (listLen, list) 

il utilise un dictionnaire pour mettre en cache les résultats comme il va.

Answer 2

Vous souhaiterez peut-être utiliser le Lazy package, qui effectue une mémoisation automatique, ou le elm-lazy package, qui utilise la mémo explicite.

En encapsulant la fonction récursive interne dans Lazy, vous pouvez réduire le nombre d'évaluations. Dans mon exemple à https://ellie-app.com/4hXx2X753wfa1/0, il y a environ 300 Debug entrées de journal à la version paresseuse, et environ 700 entrées pour la version non paresseuse.