longest common subsequence in elm with memoization

Question

I would like to make an efficient version of the LCS algorithm in elm. I like this ocaml version but it uses side effects in order to cache the results as it goes.

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

How should I do if I want to use memoization in elm?

Answer 1

Gilbert Kennen on slack gave me a version that seems to work even better:

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 )

it uses a dictionary to cache the results as it goes.