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