Почему в бесплатной версии моей функции используется гораздо больше памяти

Я работал над проблемой 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

Это привело к тому, что распределение памяти увеличилось на 20x из версии foldr.

Теперь это не огромная сделка, так как даже в случае 20x общее распределение памяти было только около 135Mb, и время выполнения программы было относительно незатронуто, если что-то более высокие версии выделения памяти выполнялись немного быстрее.

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

EDIT:

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 слишком ленива, тогда как совпадение шаблона достаточно строгое.

Слово предостережения и отказ от ответственности

Мы входим в волшебное, странное место. Осторожно. Кроме того, мои способности CORE являются рудиментарными. Теперь, когда я потерял весь свой авторитет, давайте начнем.

Проверенный код

Чтобы узнать, где мы получаем дополнительные требования к памяти, полезно иметь более двух функций.

> 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 является eta-reduced.

> 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 и не отклоняем наш профиль распределения.

Отказанный код

Прежде чем углубиться в профиль, давайте посмотрим на десугрированный код каждой функции:

==================== 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)

Пока все хорошо. Ничего удивительного не происходит. Функции Tепекса заменены их вариантами словаря, например. foldr становится foldr $fFoldable [] `, так как мы называем его в списке.

Профиль

   Mon Jul 18 15:47 2016 Time and Allocation Profiling Report  (Final)

       Prof +RTS -s -p -RTS

    total time  =        1.45 secs   (1446 ticks @ 1000 us, 1 processor)
    total alloc = 1,144,197,200 bytes  (excludes profiling overheads)

COST CENTRE  MODULE    %time %alloc

matchesPF'   Main       13.6    0.0
matchesPF    Main       13.3   11.5
main.\.\     Main       11.8   76.9
main.f       Main       10.9    0.0
uncurryL     Main        9.5   11.5
matchesPFU   Main        8.9    0.0
matchesPFI   Main        7.3    0.0
matches      Main        6.9    0.0
matchesPFL   Main        6.3    0.0
uncurryI     Main        5.3    0.0
matchesPF'.\ Main        2.6    0.0
matchesPFI.\ Main        2.0    0.0
matches.\    Main        1.5    0.0


                                                             individual     inherited
COST CENTRE        MODULE                  no.     entries  %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
     matchesPFI    Main                    110          10    7.3    0.0    11.7    0.0
      matchesPFI.\ Main                    111     5500000    2.0    0.0     4.4    0.0
       main.f      Main                    112     5500000    2.4    0.0     2.4    0.0
     matchesPFU    Main                    107          10    8.9    0.0    15.3    0.0
      uncurryI     Main                    108     5500000    5.3    0.0     6.4    0.0
       main.f      Main                    109     5500000    1.1    0.0     1.1    0.0
     matchesPFL    Main                    104          10    6.3    0.0    17.7   11.5
      uncurryL     Main                    105     5500000    9.5   11.5    11.4   11.5
       main.f      Main                    106     5500000    1.9    0.0     1.9    0.0
     matchesPF     Main                    102          10   13.3   11.5    15.4   11.5
      main.f       Main                    103     5500000    2.1    0.0     2.1    0.0
     matchesPF'    Main                     99          10   13.6    0.0    17.2    0.0
      matchesPF'.\ Main                    100     5500000    2.6    0.0     3.6    0.0
       main.f      Main                    101     5500000    1.0    0.0     1.0    0.0
     matches       Main                     94          10    6.9    0.0    10.9    0.0
      matches.\    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
  funcs            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

Игнорируйте шум main\.\., это просто список. Однако есть одно замечание, которое следует сразу заметить: matchesPF и uncurryL использовать тот же alloc%:

matchesPF    Main       13.3   11.5
uncurryL     Main        9.5   11.5

Как добраться до CORE

Теперь пришло время проверить полученный CORE (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 передает целую главу, пытаясь оптимизировать поведение одной функции, где промежуточные пары приводят к проблемам.