Комбинат запоминания и хвостовой рекурсии

Сложность мемоизации хвостовых рекурсивных функций заключается, конечно, в том, что когда хвостовая рекурсивная функция

let f x = 
   ......
   f x1

вызывает саму себя, ей не разрешается делать что-либо с результатом рекурсивного вызова, включая помещение его в кэш. Сложно; так что же мы можем сделать?

Критическая мысль здесь заключается в том, что поскольку рекурсивной функции не разрешается ничего делать с результатом рекурсивного вызова, результат для всех аргументов рекурсивных вызовов будет одинаковым! Поэтому если трассировка рекурсивного вызова такова

f x0 -> f x1 -> f x2 -> f x3 -> ... -> f xN -> res

то для всех x в x0,x1,...,xN результат f x будет один и тот же, а именно res. Таким образом, последний вызов рекурсивной функции, нерекурсивный вызов, знает результаты для всех предыдущих значений - он в состоянии кэшировать их. Единственное, что вам нужно сделать, это передать ему список посещенных значений. Вот как он может выглядеть для факториала:

let cache = Dictionary<_,_>()

let rec fact0 l ((n,res) as arg) = 
    let commitToCache r = 
        l |> List.iter  (fun a -> cache.Add(a,r))
    match cache.TryGetValue(arg) with
    |   true, cachedResult -> commitToCache cachedResult; cachedResult
    |   false, _ ->
            if n = 1 then
                commitToCache res
                cache.Add(arg, res)
                res
            else
                fact0 (arg::l) (n-1, n*res)

let fact n = fact0 [] (n,1)

Но подождите! Смотрите - l параметр fact0 содержит все аргументы рекурсивных вызовов fact0 - точно так же, как стек в нехвостовой рекурсивной версии! Это совершенно верно. Любой нехвостовой рекурсивный алгоритм может быть преобразован в хвостовой рекурсивный путем перемещения "списка кадров стека" из стека в кучу и преобразования "постобработки" результата рекурсивного вызова в проход по этой структуре данных.

Прагматическое замечание: приведенный выше пример с факториалом иллюстрирует общую технику. Он совершенно бесполезен как таковой - для функции factorial вполне достаточно кэшировать результат верхнего уровня fact n, поскольку вычисление fact n для конкретного n попадает только на уникальную серию пар (n,res) аргументов fact0 - если (n,1) еще не кэшировано, то ни одна из пар, на которых будет вызван fact0, таковой не является.

Обратите внимание, что в этом примере, когда мы перешли от нехвостового рекурсивного факториала к хвостовому рекурсивному факториалу, мы использовали тот факт, что умножение ассоциативно и коммутативно - хвостовой рекурсивный факториал выполняет другой набор умножений, чем нехвостовой рекурсивный.

На самом деле существует общая техника перехода от нехвостового рекурсивного к хвостовому рекурсивному алгоритму, которая дает алгоритм, эквивалентный тройнику. Эта техника называется "преобразование с непрерывным прохождением". Следуя этим путем, вы можете взять не рекурсивный мемоизирующий факториал и получить рекурсивный мемоизирующий факториал практически механическим преобразованием. Описание этого метода см. в ответе Брайана.

Я не уверен, что есть более простой способ сделать это, но один из подходов - создать мемоизирующий y-комбинатор:

let memoY f =
  let cache = Dictionary<_,_>()
  let rec fn x =
    match cache.TryGetValue(x) with
    | true,y -> y
    | _ -> let v = f fn x
           cache.Add(x,v)
           v
  fn

Затем вы можете использовать этот комбинатор вместо "let rec" с первым аргументом, представляющим функцию для рекурсивного вызова:

let tailRecFact =
  let factHelper fact (x, res) = 
    printfn "%i,%i" x res
    if x = 0 then res 
    else fact (x-1, x*res)
  let memoized = memoY factHelper
  fun x -> memoized (x,1)

EDIT

Как указал Митя, memoY не сохраняет хвостовые рекурсивные свойства памятки. Вот исправленный комбинатор, который использует исключения и изменяемое состояние для запоминания любой рекурсивной функции без переполнения стека (даже если исходная функция сама не является хвостовой рекурсивной!):

let memoY f =
  let cache = Dictionary<_,_>()
  fun x ->
    let l = ResizeArray([x])
    while l.Count <> 0 do
      let v = l.[l.Count - 1]
      if cache.ContainsKey(v) then l.RemoveAt(l.Count - 1)
      else
        try
          cache.[v] <- f (fun x -> 
            if cache.ContainsKey(x) then cache.[x] 
            else 
              l.Add(x)
              failwith "Need to recurse") v
        with _ -> ()
    cache.[x]

К сожалению, механизм, который вставляется в каждый рекурсивный вызов, довольно тяжелый. , поэтому производительность на незарегистрированных входных данных, требующих глубокой рекурсии, может быть немного медленной. Однако по сравнению с некоторыми другими решениями это имеет то преимущество, что требует минимальных изменений в естественном выражении рекурсивных функций:

let fib = memoY (fun fib n -> 
  printfn "%i" n; 
  if n <= 1 then n 
  else (fib (n-1)) + (fib (n-2)))

let _ = fib 5000

EDIT

Я немного расскажу, как это по сравнению с другими решениями.Этот метод использует тот факт, что исключения предоставляют побочный канал: функция типа 'a ->' b на самом деле не должна возвращать значение типа 'b , но вместо этого может выйти через исключение. Нам не нужно было бы использовать исключения, если бы возвращаемый тип явно содержал дополнительное значение, указывающее на сбой. Конечно, для этой цели мы могли бы использовать опцию 'b в качестве возвращаемого типа функции. Это привело бы к следующему комбинатору мемоизации:

let memoO f =
  let cache = Dictionary<_,_>()
  fun x ->
    let l = ResizeArray([x])
    while l.Count <> 0 do
      let v = l.[l.Count - 1]
      if cache.ContainsKey v then l.RemoveAt(l.Count - 1)
      else
        match f(fun x -> if cache.ContainsKey x then Some(cache.[x]) else l.Add(x); None) v with
        | Some(r) -> cache.[v] <- r; 
        | None -> ()
    cache.[x]

Раньше наш процесс мемоизации выглядел так:

fun fib n -> 
  printfn "%i" n; 
  if n <= 1 then n 
  else (fib (n-1)) + (fib (n-2))
|> memoY

Теперь нам нужно включить тот факт, что fib должен возвращать параметр int вместо int . Учитывая подходящий рабочий процесс для типов option , это можно записать следующим образом:

fun fib n -> option {
  printfn "%i" n
  if n <= 1 then return n
  else
    let! x = fib (n-1)
    let! y = fib (n-2)
    return x + y
} |> memoO

Однако, если мы хотим изменить тип возвращаемого значения первого параметра (с int на int option в этом случае), мы можем пойти полностью и вместо этого просто использовать продолжения в возвращаемом типе, как в решении Брайана. Вот вариант его определений:

let memoC f =
  let cache = Dictionary<_,_>()
  let rec fn n k =
    match cache.TryGetValue(n) with
    | true, r -> k r
    | _ -> 
        f fn n (fun r ->
          cache.Add(n,r)
          k r)
  fun n -> fn n id

И снова, если у нас есть подходящее вычислительное выражение для построения функций CPS, мы можем определить нашу рекурсивную функцию следующим образом:

fun fib n -> cps {
  printfn "%i" n
  if n <= 1 then return n
  else
    let! x = fib (n-1)
    let! y = fib (n-2)
    return x + y
} |> memoC

Это в точности то же, что сделал Брайан, но я найти здесь синтаксис легче. Все, что нам нужно, чтобы это работало, - это следующие два определения:

type CpsBuilder() =
  member this.Return x k = k x
  member this.Bind(m,f) k = m (fun a -> f a k)

let cps = CpsBuilder()

Я написал тест для визуализации запоминания. Каждая точка - это рекурсивный вызов.

......720 // factorial 6
......720 // factorial 6
.....120  // factorial 5

......720 // memoizedFactorial 6
720       // memoizedFactorial 6
120       // memoizedFactorial 5

......720 // tailRecFact 6
720       // tailRecFact 6
.....120  // tailRecFact 5

......720 // tailRecursiveMemoizedFactorial 6
720       // tailRecursiveMemoizedFactorial 6
.....120  // tailRecursiveMemoizedFactorial 5

Решение kvb возвращает те же результаты, что и прямая мемоизация, как эта функция.

let tailRecursiveMemoizedFactorial = 
    memoize 
        (fun x ->
            let rec factorialUtil x res = 
                if x = 0 then 
                    res
                else 
                    printf "." 
                    let newRes = x * res
                    factorialUtil (x - 1) newRes

            factorialUtil x 1
        )

Тестовый исходный код.

open System.Collections.Generic

let memoize f = 
    let cache = new Dictionary<_, _>()
    (fun x -> 
        match cache.TryGetValue(x) with
        | true, y -> y
        | _ -> 
            let v = f(x)
            cache.Add(x, v)
            v)

let rec factorial(x) = 
    if (x = 0) then 
        1 
    else
        printf "." 
        x * factorial(x - 1)

let rec memoizedFactorial =
    memoize (
        fun x -> 
            if (x = 0) then 
                1 
            else 
                printf "."
                x * memoizedFactorial(x - 1))

let memoY f =
  let cache = Dictionary<_,_>()
  let rec fn x =
    match cache.TryGetValue(x) with
    | true,y -> y
    | _ -> let v = f fn x
           cache.Add(x,v)
           v
  fn

let tailRecFact =
  let factHelper fact (x, res) = 
    if x = 0 then 
        res 
    else
        printf "." 
        fact (x-1, x*res)
  let memoized = memoY factHelper
  fun x -> memoized (x,1)

let tailRecursiveMemoizedFactorial = 
    memoize 
        (fun x ->
            let rec factorialUtil x res = 
                if x = 0 then 
                    res
                else 
                    printf "." 
                    let newRes = x * res
                    factorialUtil (x - 1) newRes

            factorialUtil x 1
        )

factorial 6 |> printfn "%A"
factorial 6 |> printfn "%A"
factorial 5 |> printfn "%A\n"

memoizedFactorial 6 |> printfn "%A"
memoizedFactorial 6 |> printfn "%A"
memoizedFactorial 5 |> printfn "%A\n"

tailRecFact 6 |> printfn "%A"
tailRecFact 6 |> printfn "%A"
tailRecFact 5 |> printfn "%A\n"

tailRecursiveMemoizedFactorial 6 |> printfn "%A"
tailRecursiveMemoizedFactorial 6 |> printfn "%A"
tailRecursiveMemoizedFactorial 5 |> printfn "%A\n"

System.Console.ReadLine() |> ignore