Friday, November 12, 2010

Динамическое программирование на Haskell. Часть 3

В продолжение моих предыдущих постов (1, 2) о замечательном языке программирования Haskell. Вот мы решили задачу, получили программу, которую можно запускать и увидеть результат. Но что же со временем выполнения? А как собственно измерить время выполнения программы или части программы в Haskell?
Эта задача оказывается сложнее чем в императивных языках. И причиной тому, склонностью Haskell к ленивым вычислениям. Haskell настолько ленив, что не будет вычислять ничего до тех пор пока в этом не возникнет реальной необходимости. С одной стороны это открывает перед нами такие возможности как бесконечные массивы и бесконечная рекурсия. А с другой стороны, это создает некоторые трудности для нас, привыкших к императивному мышлению.
Итак, поехали. Имеется программа:
import Array

change :: [Int] -> Int -> Int
change xs n = dp!n
where
dp = listArray (0,n) [ cell i | i<-[0..n]]
cell 0 = 0
cell i = succ$minl [dp!(i-x)| x<-xs, i>=x]

minl :: [Int] -> Int
minl [] =  0
minl xs =  minimum xs


В императивном языке, можно было бы просто написать:
timer :: Int -> IO()
timer n = do
t0 <- getCPUTime
let c = change [1,2,5,10,50] n –(1)
t1 <- getCPUTime
putStrLn $ show $ div (t1-t0) cpuTimePrecision
Но в нашем случае, это не работает. Результат будет все время 0, потому что Haskell заметит, что переменная c не нужна и, стало быть, вычислять её не стоит. Чтобы все-таки получить результат, необходимо модифицировать строчку помеченную (1), получим следующую программу:
timer :: Int -> IO()
timer n = do
t0 <- getCPUTime
return $! change [1,2,5,10,50] n  -- (1)
t1 <- getCPUTime
putStrLn $ show $ div (t1-t0) cpuTimePrecision
Результат работы этой программы: 1000000 : 255656 100000 : 4093 10000 : 187 1000 : 15 Как мы видим время выполнения далеко от полиномиального, как предполагается в динамическом программировании. И, к сожалению, большая часть этого времени тратится в сборщике мусора. В чем легко убедиться запустив программу с ключиком: +RTS –sstderr %GC time 97.8% Проблема в том, что наша программа выделяет слишком много слишком много массивов. К счастью, решение есть. Пусть и несколько более запутанное:
change :: [Int] -> Int -> Int
change xs n = cs!!n
where
cs = 0 : (map succ (foldl1 minimize (map (\x -> replicate (x-1) maxBound ++ cs) xs)))

minimize [] [] = []
minimize (x:xs) (y:ys) = (min x y) : minimize xs ys


Что здесь происходит? Мы создаем ленивый массив cs в котором храним все решения задачи для заданного набора монет. Как вычисляются значения в этом массиве? Для этого мы создаем по ленивому массиву для каждой монеты, очевидно что если величина монеты X то первые X-1 значение в этом массиве будут не определены. Ведь мы не можем разменять сумму монетой большего достоинства чем сама сумма. Чтобы не усложнять вычисления, вместо неопределенности мы вбиваем самое большое возможное значение maxBound. Оставшиеся значения в этом массиве заполняются результирующим массивом (вот она прелесть Хаскеля, массив заполняет сам себя!)
Дальнейшее просто, каждый элемент массива cs равен минимальному значению из всех соответствующих элементов частных массивов плюс единица.

Запускаем еще раз наш таймер и смотрим время выполнения:

1000000 : 8656
100000 : 718
10000 : 62
1000 : 0

Мы не только добились полиномиального времени выполнения, как обещает динамическое программирование, но и увеличили скорость работы алгоритма на порядок.

1 comment: