Динамическое программирование и ленивые вычисления

Динамическое программирование является довольно важным подходом в решении многих сложных задач, основанным на разбиении задачи на подзадачи и решении этих подзадач единожды, даже если они являются частью нескольких других подзадач. Перед людьми, которые только начинают овладевать функциональным программированием часто возникает вопрос: «как избежать повторного решения подзадач, если не использовать переменные для сохранения результатов?». В этом вопросе одна особенность функционального программирования — отсутствие переменных — мешает кешировать результаты решения подзадач, но другая особенность поможет — ленивые вычисления.

Рассмотрим задачу о нахождении водосборов:

Дана карта местности, представленная прямоугольной матрицей высот (например целочисленных). Из каждой клетки вода будет стекать в одну из соседних клеток (север, восток, юг, запад) с наименьшей высотой, если
она меньше высоты данной клетки. Иначе эта клетка называется водосток. Необходимо пометить одинаково все клетки карты, вода из которых будет стекать в один и тот же водосток.

Таким образом, чтобы найти водосток одной клетки, нужно найти водосток ее соседа (если она сама не является водостоком), причем понятно, что вода из нескольких разных клеток может собираться и течь по одинаковому маршруту в один водосток.
На ум приходит довольно несложный рекурсивный алгоритм:

drainOf cell = 
  case lowestNeighbourOf cell of
    Nothing → cell
    Just nb → drainOf nb

Но в таком случае сток каждой клетки будет вычисляться множество раз, что не может не удручать.
В этом случае нам помогут ленивые вычисления: суть их состоит в том, что выражение не будет вычислено, пока его результат не потребуется где-то еще, а после вычисления результат будет использован повторно при необходимости.
Это то, что нам нужно!
Возникает вопрос: если в Haskell все (почти) вычисления ленивы, то почему приведенный выше код не будет кешировать промежуточные результаты?
Все дело в том, что в следующем коде выражения разные и функция будет вызвана дважды!

print (drainOf cell)
print (drainOf cell)

А вот в следующем коде функция будет вызвана только один раз:

let drain = drainOf cell
print drain
print drain

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

cells = ( (1,1), (width,height) )

altitude :: (Int,Int) → Int

-- вот он, массив стоков всех клеток! Но вычисляется он лениво
-- т.е. пока это только список вызовов функции drainOf, но не ее результатов
drains = array cells [ (cell, drainOf cell) | cell ← range cells ]
  
drainOf cell = 
  case lowestNeighbourOf cell of
    Nothing → cell
    Just nb → drains ! nb -- обращение к элементу массива стоков
    -- тут при первом обращении произойдет вычисление drainOf,
    -- а при втором — возврат кешированного результата

lowestNeighbourOf (x,y) =
  let neighbours = filter (inRange cells) [ 
                        (x,y-1), (x+1,y), (x,y+1), (x-1,y) ]
      lowest = minimumBy (compare`on`altitude) neighbours
  in
      if altitude lowest ≥ altitude (x,y)
            then Nothing
            else Just lowest

Вот и все, надеюсь вам стало понятнее, что такое ленивые вычисления.

UPD: Решил добавить полную программу и ее вывод, чтобы не быть голословным.

import Data.Array
import Debug.Trace (trace)
import Control.Monad (forM_)
import Data.List (minimumBy,transpose)
import Data.Function (on)

-- simple data --

cells = ( (1,1), (3,3) )

altitudes = listArray cells $ concat $ transpose [
    [ 10,  8, 10 ],
    [ 15,  3, 15 ],
    [ 20, 25, 20 ] ]

-- common functions --

altitude :: (Int,Int) → Int
altitude cell = altitudes ! cell

lowestNeighbourOf (x,y) =
  let neighbours = filter (inRange cells) [ 
                        (x,y-1), (x+1,y), (x,y+1), (x-1,y) ]
      lowest = minimumBy (compare`on`altitude) neighbours
  in
      if altitude lowest ≥ altitude (x,y)
            then Nothing
            else Just lowest

printArray arr =
    let ((sx,sy),(ex,ey)) = bounds arr
        printRow y = forM_ [sx..ex] (λ x → putStr (show (arr!(x,y)) ++ "\t"))
    in
        forM_ [sy..ey] (λ y → printRow y » putStrLn "")

main = 
  do printArray altitudes
     putStrLn "-- drains -------------"
     printArray drains
     putStrLn "-- drains′ ------------"
     printArray drains′

-- simple recursion --

drains = array cells [ (cell, drainOf cell) | cell ← range cells ]

drainOf cell | trace ("drainOf "++ show cell) False = undefined
drainOf cell = 
  case lowestNeighbourOf cell of
    Nothing → cell
    Just nb → drainOf nb

-- lazy caching --

drains′ = array cells [ (cell, drainOf′ cell) | cell ← range cells ]

drainOf′ cell | trace ("drainOf′ "++ show cell) False = undefined
drainOf′ cell = 
  case lowestNeighbourOf cell of
    Nothing → cell
    Just nb → drains′ ! nb

Результат:

10	8	10	
15	3	15	
20	25	20	
- drains -------------
drainOf (1,1)
drainOf (2,1)
drainOf (2,2)
drainOf (2,1)
drainOf (2,2)
drainOf (3,1)
drainOf (2,1)
drainOf (2,2)
(2,2)	(2,2)	(2,2)	
drainOf (1,2)
drainOf (2,2)
drainOf (2,2)
drainOf (3,2)
drainOf (2,2)
(2,2)	(2,2)	(2,2)	
drainOf (1,3)
drainOf (1,2)
drainOf (2,2)
drainOf (2,3)
drainOf (2,2)
drainOf (3,3)
drainOf (3,2)
drainOf (2,2)
(2,2)	(2,2)	(2,2)	
- drains' ------------
drainOf' (1,1)
drainOf' (2,1)
drainOf' (2,2)
drainOf' (3,1)
(2,2)	(2,2)	(2,2)	
drainOf' (1,2)
drainOf' (3,2)
(2,2)	(2,2)	(2,2)	
drainOf' (1,3)
drainOf' (2,3)
drainOf' (3,3)
(2,2)	(2,2)	(2,2)	

Как видите, первый вариант вычислял сток каждой ячейки снова и снова, тогда как второй вриант сделал это ровно один раз.