Комбинация memoization и tail-recursion

Можно ли как-то совместить воспоминания и хвостовую рекурсию? Я изучаю F # на данный момент и понимаю обе концепции, но не могу их комбинировать.

Предположим, что у меня есть следующая функция memoize (из Функциональное программирование реального мира):

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)

и следующей функции factorial:

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

Запоминание factorial не слишком сложно и делает его хвостовым рекурсивом также:

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

let tailRecursiveFactorial(x) =
  let rec factorialUtil(x, res) = if (x = 0)
                                  then res
                                  else let newRes = x * res
                                       factorialUtil(x - 1, newRes)
  factorialUtil(x, 1)

Но можете ли вы объединить memoization и tail-recursion? Я сделал несколько попыток, но не могу заставить его работать. Или это просто невозможно?

ОТВЕТЫ

Ответ 1

Как всегда, продолжения дают элегантное решение tailcall:

open System.Collections.Generic 

let cache = Dictionary<_,_>()  // TODO move inside 
let memoizedTRFactorial =
    let rec fac n k =  // must make tailcalls to k
        match cache.TryGetValue(n) with
        | true, r -> k r
        | _ -> 
            if n=0 then
                k 1
            else
                fac (n-1) (fun r1 ->
                    printfn "multiplying by %d" n  //***
                    let r = r1 * n
                    cache.Add(n,r)
                    k r)
    fun n -> fac n id

printfn "---"
let r = memoizedTRFactorial 4
printfn "%d" r
for KeyValue(k,v) in cache do
    printfn "%d: %d" k v

printfn "---"
let r2 = memoizedTRFactorial 5
printfn "%d" r2

printfn "---"

// comment out *** line, then run this
//let r3 = memoizedTRFactorial 100000
//printfn "%d" r3

Существует два типа тестов. Во-первых, эти демонстрации, вызывающие F (4), кэшируют F (4), F (3), F (2), F (1), как вы бы хотели.

Затем закомментируйте *** printf и раскомментируйте окончательный тест (и скомпилируйте в режиме Release), чтобы показать, что он не StackOverflow (он правильно использует хвосты).

Возможно, я обобщу 'memoize' и продемонстрирую его на следующем рисунке.

ИЗМЕНИТЬ

Хорошо, вот следующий шаг, я думаю, развязывание memoization от factorial:

open System.Collections.Generic 

let cache = Dictionary<_,_>()  // TODO move inside 
let memoize fGuts n =
    let rec newFunc n k =  // must make tailcalls to k
        match cache.TryGetValue(n) with
        | true, r -> k r
        | _ -> 
            fGuts n (fun r ->
                        cache.Add(n,r)
                        k r) newFunc
    newFunc n id 
let TRFactorialGuts n k memoGuts =
    if n=0 then
        k 1
    else
        memoGuts (n-1) (fun r1 ->
            printfn "multiplying by %d" n  //***
            let r = r1 * n
            k r) 

let memoizedTRFactorial = memoize TRFactorialGuts 

printfn "---"
let r = memoizedTRFactorial 4
printfn "%d" r
for KeyValue(k,v) in cache do
    printfn "%d: %d" k v

printfn "---"
let r2 = memoizedTRFactorial 5
printfn "%d" r2

printfn "---"

// comment out *** line, then run this
//let r3 = memoizedTRFactorial 100000
//printfn "%d" r3

ИЗМЕНИТЬ

Хорошо, вот полностью обобщенная версия, которая, похоже, работает.

open System.Collections.Generic 

let memoize fGuts =
    let cache = Dictionary<_,_>()
    let rec newFunc n k =  // must make tailcalls to k
        match cache.TryGetValue(n) with
        | true, r -> k r
        | _ -> 
            fGuts n (fun r ->
                        cache.Add(n,r)
                        k r) newFunc
    cache, (fun n -> newFunc n id)
let TRFactorialGuts n k memoGuts =
    if n=0 then
        k 1
    else
        memoGuts (n-1) (fun r1 ->
            printfn "multiplying by %d" n  //***
            let r = r1 * n
            k r) 

let facCache,memoizedTRFactorial = memoize TRFactorialGuts 

printfn "---"
let r = memoizedTRFactorial 4
printfn "%d" r
for KeyValue(k,v) in facCache do
    printfn "%d: %d" k v

printfn "---"
let r2 = memoizedTRFactorial 5
printfn "%d" r2

printfn "---"

// comment out *** line, then run this
//let r3 = memoizedTRFactorial 100000
//printfn "%d" r3

let TRFibGuts n k memoGuts =
    if n=0 || n=1 then
        k 1
    else
        memoGuts (n-1) (fun r1 ->
            memoGuts (n-2) (fun r2 ->
                printfn "adding %d+%d" r1 r2 //%%%
                let r = r1+r2
                k r)) 
let fibCache, memoizedTRFib = memoize TRFibGuts 
printfn "---"
let r5 = memoizedTRFib 4
printfn "%d" r5
for KeyValue(k,v) in fibCache do
    printfn "%d: %d" k v

printfn "---"
let r6 = memoizedTRFib 5
printfn "%d" r6

printfn "---"

// comment out %%% line, then run this
//let r7 = memoizedTRFib 100000
//printfn "%d" r7

Ответ 2

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

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

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

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

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 - точно так же, как стек будет в нерекурсивной версии! Это точно. Любой нерекурсивный рекурсивный алгоритм может быть преобразован в хвостовую рекурсивную, перемещая "список кадров стека" из стека в кучу и преобразуя "постобработку" результата рекурсивного вызова в прогулку по этой структуре данных.

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

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

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

Ответ 3

Я не уверен, есть ли более простой способ сделать это, но одним из способов было бы создать memoizing y-combinator:

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)

ИЗМЕНИТЬ

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

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]

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

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

let _ = fib 5000

ИЗМЕНИТЬ

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

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]

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

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

Теперь нам нужно включить тот факт, что fib должен возвращать int option вместо 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()

Ответ 4

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

......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 возвращает те же результаты, что и прямая memoization, как эта функция.

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

Ответ 5

Это должно работать, если взаимная рекурсия хвоста через y не создает кадры стека:

let rec y f x = f (y f) x

let memoize (d:System.Collections.Generic.Dictionary<_,_>) f n = 
   if d.ContainsKey n then d.[n] 
   else d.Add(n, f n);d.[n]

let rec factorialucps factorial' n cont = 
    if n = 0I then cont(1I) else factorial' (n-1I) (fun k -> cont (n*k))

let factorialdpcps  = 
    let d =  System.Collections.Generic.Dictionary<_, _>()
    fun n ->  y (factorialucps >> fun f n -> memoize d f n ) n id


factorialdpcps 15I //1307674368000