Почему бессмысленная версия моей функции использует гораздо больше памяти
Я работал над проблемой Project Euler и получил файл на Haskell, который включал функцию, которая выглядела следующим образом:
matches :: (a -> a -> Bool) -> a -> [(a, Int)] -> Int
matches f cs = foldr (\(cs', n) a -> fromBool (f cs cs') * n + a) 0
С fromBool импортировано из Foreign.Marshal.Utils просто быстро конвертировать True в 1 а также False в 0,
Я пытался получить немного больше скорости от своего решения, поэтому я попытался переключиться с foldr в foldl' (переключение аргументов в процессе), как я предполагал foldr не имеет особого смысла использовать на числах.
Переключение с foldr в foldl' заставил меня выделить более чем в два раза больше памяти в соответствии с профайлером GHC.
Ради интереса я также решил заменить лямбду на версию функции без точек:
matches :: (a -> a -> Bool) -> a -> [(a, Int)] -> Int
matches f cs = foldr ((+) . uncurry ((*) . fromBool . f cs)) 0
Это привело к увеличению моего выделения памяти в 20 раз от foldr версия.
Теперь это не так уж важно, поскольку даже в 20-кратном случае общее выделение памяти составляло всего около 135Mb и время выполнения программы было относительно незатронутым, во всяком случае, версии с более высоким распределением памяти работали немного быстрее.
Но мне действительно любопытно, как эти результаты могут быть возможными, так что в будущем я смогу выбрать "правильную" функцию, когда у меня не так много свободы действий.
РЕДАКТИРОВАТЬ:
GHC версия 7.10.2, скомпилированная с -O2 -prof -fprof-auto, Выполнено с +RTS -p,
РЕДАКТИРОВАТЬ 2:
Хорошо, похоже, что это слишком сложно воспроизвести, чтобы пропустить остальную часть кода, ну вот и вся программа:
СПОЙЛЕРЫ НИЖЕ:
{-# LANGUAGE NoMonomorphismRestriction #-}
import Control.Monad
import Data.List
import Foreign.Marshal.Utils
data Color = Red | Green | Blue deriving (Eq, Enum, Bounded, Show)
colors :: [Color]
colors = [Red ..]
matches :: (a -> a -> Bool) -> a -> [(a, Int)] -> Int
matches f x = foldr ((+) . uncurry ((*) . fromBool . f x)) 0
-- matches f x = foldr (\(y, n) a -> fromBool (f x y) * n + a) 0
-- matches f x = foldl' (\a (y, n) -> fromBool (f x y) * n + a) 0
invert :: [([Color], Int)] -> [([Color], Int)]
invert rs = (\cs -> (cs, matches valid cs rs)) <$> choices
where
len = maximum $ length . fst <$> rs
choices = replicateM len colors
valid (x : xs) (y : ys) = x /= y && valid xs ys
valid _ _ = True
expand :: [([Color], Int)] -> [([Color], Int)]
expand rs = (\cs -> (cs, matches valid cs rs)) <$> choices
where
len = maximum $ length . fst <$> rs
choices = replicateM (len + 1) colors
valid (x1 : x2 : xs) (y : ys) = x1 /= y && x2 /= y && valid (x2 : xs) ys
valid _ _ = True
getRow :: Int -> [([Color], Int)]
getRow 1 = flip (,) 1 . pure <$> colors
getRow n = expand . invert $ getRow (n - 1)
result :: Int -> Int
result n = sum $ snd <$> getRow n
main :: IO ()
main = print $ result 8
1 ответ
Примечание: этот пост написан на грамотном языке Haskell. Скопируйте его в файл, сохраните как *.lhs и скомпилируйте / загрузите в GHC(i). Кроме того, я начал писать этот ответ до того, как вы отредактировали свой код, но урок остался прежним.
TL; DR
Prelude функция uncurry слишком ленив, в то время как ваш шаблон достаточно строг.
Слово предостережения и отказ от ответственности
Мы входим в волшебное, странное место. Осторожно. Кроме того, мои основные способности являются зачаточными. Теперь, когда я потерял весь свой авторитет, давайте начнем.
Протестированный код
Чтобы узнать, где мы получаем дополнительные требования к памяти, полезно иметь более двух функций.
> import Control.Monad (forM_)
Это ваш оригинальный, неочевидный вариант:
> matches :: (a -> a -> Bool) -> a -> [(a, Int)] -> Int
> matches f cs = foldr (\(cs', n) a -> fromEnum (f cs cs') * n + a) 0
Это вариант, который только немного бессмысленно, параметр a Это сокращено.
> matchesPF' :: (a -> a -> Bool) -> a -> [(a, Int)] -> Int
> matchesPF' f cs = foldr (\(cs', n) -> (+) (fromEnum (f cs cs') * n)) 0
Это вариант, который встраивает uncurry рукой.
> matchesPFI :: (a -> a -> Bool) -> a -> [(a, Int)] -> Int
> matchesPFI f cs = foldr ((+) . (\(cs', n) -> fromEnum (f cs cs') * n)) 0
Это ваша точечная версия.
> matchesPF :: (a -> a -> Bool) -> a -> [(a, Int)] -> Int
> matchesPF f cs = foldr ((+) . uncurry ((*) . fromEnum . f cs)) 0
Это вариант, который использует пользовательский uncurry, увидеть ниже.
> matchesPFU :: (a -> a -> Bool) -> a -> [(a, Int)] -> Int
> matchesPFU f cs = foldr ((+) . uncurryI ((*) . fromEnum . f cs)) 0
Это вариант, который использует пользовательский ленивый uncurry, увидеть ниже.
> matchesPFL :: (a -> a -> Bool) -> a -> [(a, Int)] -> Int
> matchesPFL f cs = foldr ((+) . uncurryL ((*) . fromEnum . f cs)) 0
Чтобы легко проверить функции, мы используем список:
> funcs = [matches, matchesPF', matchesPF, matchesPFL, matchesPFU, matchesPFI]
Наш самописец uncurry:
> uncurryI :: (a -> b -> c) -> (a, b) -> c
> uncurryI f (a,b) = f a b
Ленивый uncurry:
> uncurryL :: (a -> b -> c) -> (a, b) -> c
> uncurryL f p = f (fst p) (snd p)
Ленивый вариант uncurryL имеет ту же семантику, что и вариант в Prelude например,
uncurry (\_ _ -> 0) undefined == 0 == uncurryL (\_ _ -> 0) undefined
в то время как uncurryI строг в позвоночнике пары.
> main = do
> let f a b = a < b
> forM_ [1..10] $ \i ->
> forM_ funcs $ \m ->
> print $ m f i (zip (cycle [1..10]) [1..i*100000])
Список [1..i*100000] зависит от i намеренно, чтобы мы не вводили CAF и не искажали наш профиль распределения.
Обезвоженный код
Прежде чем мы углубимся в профиль, давайте посмотрим на desugared код каждой функции:
==================== Desugar (after optimization) ====================
Result size of Desugar (after optimization)
= {terms: 221, types: 419, coercions: 0}
uncurryL
uncurryL = \ @ a @ b @ c f p -> f (fst p) (snd p)
uncurryI
uncurryI = \ @ a @ b @ c f ds -> case ds of _ { (a, b) -> f a b }
-- uncurried inlined by hand
matchesPFI =
\ @ a f cs ->
foldr
$fFoldable[]
(. (+ $fNumInt)
(\ ds ->
case ds of _ { (cs', n) ->
* $fNumInt (fromEnum $fEnumBool (f cs cs')) n
}))
(I# 0)
-- lazy uncurry
matchesPFL =
\ @ a f cs ->
foldr
$fFoldable[]
(. (+ $fNumInt)
(uncurryL (. (* $fNumInt) (. (fromEnum $fEnumBool) (f cs)))))
(I# 0)
-- stricter uncurry
matchesPFU =
\ @ a f cs ->
foldr
$fFoldable[]
(. (+ $fNumInt)
(uncurryI (. (* $fNumInt) (. (fromEnum $fEnumBool) (f cs)))))
(I# 0)
-- normal uncurry
matchesPF =
\ @ a f cs ->
foldr
$fFoldable[]
(. (+ $fNumInt)
(uncurry (. (* $fNumInt) (. (fromEnum $fEnumBool) (f cs)))))
(I# 0)
-- eta-reduced a
matchesPF' =
\ @ a f cs ->
foldr
$fFoldable[]
(\ ds ->
case ds of _ { (cs', n) ->
+ $fNumInt (* $fNumInt (fromEnum $fEnumBool (f cs cs')) n)
})
(I# 0)
-- non-point-free
matches =
\ @ a f cs ->
foldr
$fFoldable[]
(\ ds a ->
case ds of _ { (cs', n) ->
+ $fNumInt (* $fNumInt (fromEnum $fEnumBool (f cs cs')) n) a
})
(I# 0)
Пока все вроде хорошо. В этом нет ничего удивительного. Функции классов типов заменяются их словарными вариантами, например foldr становится foldr $fFoldable[]`, так как мы вызываем его в списке.
Профиль
Пн Июл 18 15:47 Отчет по профилированию времени и распределения (окончательный)
Prof +RTS -s -p -RTS общее время = 1,45 с (1446 тиков на 1000 долл. США, 1 процессор) общее выделение = 1 144 197 200 байт (исключая накладные расходы на профилирование) COST МОДУЛЬ ЦЕНТРА% time% alloc matchPF 'Main 13.6 0.0 совпадений PF Main 13.3 11.5 main. \. \ Main 11.8 76.9 main.f Main 10.9 0.0 uncurryL Main 9.5 11.5 совпадений PFU Main 8.9 0.0 совпадений PFI Main 7.3 0.0 совпадений Main 6.9 0.0 совпадений PFL Main 6.3 0.0 uncurryI Main 5.3 0.0 совпадений PF '. \ Main 2.6 0.0 совпадений PFI. \ Main 2.0 0.0 совпадений. \ Main 1.5 0.0 отдельный унаследованный МОДУЛЬ COST CENTER no. записи%time %alloc %time %alloc
MAIN MAIN 44 0 0.0 0.0 100.0 100.0
main Main 89 0 0.0 0.0 100.0 100.0
main.\ Main 90 10 0.0 0.0 100.0 100.0
main.\.\ Main 92 60 11.8 76.9 100.0 100.0
funcs Main 93 0 0.0 0.0 88.2 23.1 совпадений PFI Main 110 10 7.3 0.0 11.7 0.0 совпадений PFI.\ Main 111 5500000 2.0 0.0 4.4 0.0
main.f Main 112 5500000 2.4 0.0 2.4 0.0 совпадений PFU Main 107 10 8.9 0.0 15,3.3 uncurryI Main 108 5500000 5.3 0.0 6.4 0.0
main.f Основной 109 5500000 1,1 0,0 1,1 0,0 совпадений PFL Основной 104 10 6.3 0,0 17,7 11,5
uncurryL Основной 105 5500000 9,5 11,5 11,4 11,5 main.f Основной 106 5500000 1,9 0,0 1,9 0,0 совпадений PF Основной 102 10 13,3 11,5 15,4 11,5 main.f Основной 103 5500000 2,1 0,0 2.1 0,0 совпадений PF' Main 99 10 13,6 0,0 17,2 0,0 совпадений PF'.\ Main 100 5500000 2,6 0,0 3,6 0,0 main.f Main 101 5500000 1,0 0,0 1,0 0,0 совпадений Main 94 10 6,9 0,0 10,9 0,0 совпадений.\ Main 97 5500000 1,5 0,0 4,0 0,0
main.f Main 98 5500000 2,5 0,0 2,5 0,0
CAF Main 87 0 0,0 0,0 0,0 0,0 func Main 91 1 0,0 0,0 0,0 0,0
main Main 88 1 0,0 0. 0 0,0 0,0
main.\ Main 95 0 0,0 0,0 0,0 0,0
main.\.\ Main 96 0 0,0 0,0 0,0 0,0
CAF GHC.IO.Handle.FD 84 0 0,0 0,0 0,0 0,0
CAF GHC.Conc.Signal 78 0 0,0 0,0 0,0 0,0
CAF GHC.IO.Encoding 76 0 0,0 0,0 0,0 0,0
CAF GHC.IO.Handle.Text 75 0 0,0 0,0 0,0 0,0
CAF GHC.IO.Encoding.Iconv 59 0 0,0 0,0 0,0 0,0 0,0 Игнорировать main\.\. шум, это просто список. Тем не менее, есть один момент, на который следует обратить внимание: matchesPF а также uncurryL использовать то же самое alloc%:
matchesPF Main 13.3 11.5
uncurryL Main 9.5 11.5
Как добраться до ядра
Теперь пришло время проверить полученный ЯДЕР (ghc -ddump-simpl). Мы заметим, что большинство функций были преобразованы в рабочие оболочки, и они выглядят более или менее одинаково (-dsuppress-all -dsuppress-uniques):
$wa5
$wa5 =
\ @ a1 w w1 w2 ->
letrec {
$wgo
$wgo =
\ w3 ->
case w3 of _ {
[] -> 0;
: y ys ->
case y of _ { (cs', n) ->
case $wgo ys of ww { __DEFAULT ->
case w w1 cs' of _ {
False -> case n of _ { I# y1 -> ww };
True -> case n of _ { I# y1 -> +# y1 ww }
}
}
}
}; } in
$wgo w2
Это твой обычный рабочий-фантик. $wgo берет список, проверяет, пусто ли, строго в голове (case y of _ { (cs', n) ->…) и ленив в рекурсивном результате $wgo ys of ww,
Все функции выглядят одинаково. Ну все кроме matchesPF (твой вариант)
-- matchesPF
$wa3 =
\ @ a1 w w1 w2 ->
letrec {
$wgo =
\ w3 ->
case w3 of _ {
[] -> 0;
: y ys ->
case $wgo ys of ww { __DEFAULT ->
case let {
x = case y of _ { (x1, ds) -> x1 } } in
case w w1 x of _ {
False ->
case y of _ { (ds, y1) -> case y1 of _ { I# y2 -> main13 } };
-- main13 is just #I 0
True -> case y of _ { (ds, y1) -> y1 }
}
of _ { I# x ->
+# x ww
}
}
}; } in
$wgo w2
а также matchesPFL (вариант, который использует ленивый uncurryL)
-- matchesPFL
$wa2
$wa2 =
\ @ a1 w w1 w2 ->
letrec {
$wgo =
\ w3 ->
case w3 of _ {
[] -> 0;
: y ys ->
case $wgo ys of ww { __DEFAULT ->
case snd y of ww1 { I# ww2 ->
case let {
x = fst y } in
case w w1 x of _ {
False -> main13;
True -> ww1
}
of _ { I# x ->
+# x ww
}
}
}
}; } in
$wgo w2
Они практически одинаковы. И оба они содержат let привязки. Это создаст громоотвод и, как правило, приведет к ухудшению требований к пространству.
Решение
Я думаю, что виновник в этом пункте ясен. это uncurry, GHC хочет обеспечить правильную семантику
uncurry (const (const 0)) undefined
Тем не менее, это добавляет лени и дополнительных громов. Ваш вариант без использования точек не представляет такого поведения, поскольку вы сопоставляете шаблон с парой:
foldr (\(cs', n) a -> …)
Все еще не доверяете мне? Используйте ленивый образец
foldr (\ ~(cs', n) a -> …)
и вы заметите, что matches будет вести себя так же, как matchesPF, Поэтому используйте более строгий вариант uncurry, uncurryI достаточно дать подсказку анализатора строгости.
Обратите внимание, что пары печально известны этим поведением. RWH проводит целую главу, пытаясь оптимизировать поведение отдельной функции, где промежуточные пары приводят к проблемам.