Haskell: сделать Writer таким же эффективным, как обычный код, когда журнал не нужен

Question

Я хотел бы написать один код, который можно было бы запускать в двух «режимах»:

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

Я пытался написать следующий код, который создает два модуля записи, один нормальный (для режима ведения журнала) и один глупый (который ничего не записывает, для эффективного режима). Затем я определяю новый класс LogFunctionCalls, который позволяет мне запускать мою функцию в одном из этих двух Writers.

Однако я попытался сравнить скорость кода с помощью Stupid Writer, и он значительно медленнее, чем обычный код без писателя: вот информация о профилировании:

• код без писателя: общее время = 0,27 с, общее количество c = 55 800 байт
• код с тупым писателем StupidLogEntry: общее время = 0,74 с, общее количество c = 600 060 408 байт (примечание: реальное время намного больше 0,74 с ...)
• код с реальным писателем LogEntry: общее время = 5,03 с, всего алло c = 1 920 060 624 байта

Вот код (вы можете прокомментировать, в зависимости от того, какой прогон вы хотите использовать):

{-# LANGUAGE ScopedTypeVariables #-}
module Main where

--- It depends on the transformers, containers, and base packages.

--- You can profile it with:
--- $ cabal v2-run --enable-profiling debug -- +RTS -p
--- and a file debug.prof will be created.

import qualified Data.Map.Strict as MapStrict
import qualified Data.Map.Merge.Strict as MapMerge

import qualified Control.Monad as CM
import Control.Monad.Trans.Writer.Strict (Writer)
import qualified Control.Monad.Trans.Writer.Strict as Wr
import qualified Data.Time as Time

-- Test using writer monad

-- The actual LogEntry, that should associate a number
-- to each name
newtype LogEntry = LogEntry { logMap:: MapStrict.Map String Int }
  deriving (Eq, Show)

-- A logentry that does not record anything, always empty
newtype StupidLogEntry = StupidLogEntry { stupidLogMap:: MapStrict.Map String Int }
  deriving (Eq, Show)

-- Create the Monoid instances
instance Semigroup LogEntry where
  (LogEntry m1) <> (LogEntry m2) =
    LogEntry $ MapStrict.unionWith (+) m1 m2
instance Monoid LogEntry where
  mempty = LogEntry MapStrict.empty

instance Semigroup StupidLogEntry where
  (StupidLogEntry m1) <> (StupidLogEntry m2) =
    StupidLogEntry $ m1
instance Monoid StupidLogEntry where
  mempty = StupidLogEntry MapStrict.empty

-- Create a class that allows me to use the function "myTell"
-- that adds a number in the writer (either the LogEntry
-- or StupidLogEntry one)
class (Monoid r) => LogFunctionCalls r where
  myTell :: String -> Int -> Writer r ()

instance LogFunctionCalls LogEntry where
  myTell namefunction n = do
    Wr.tell $ LogEntry $ MapStrict.singleton namefunction n

instance LogFunctionCalls StupidLogEntry where
  myTell namefunction n = do
    -- Wr.tell $ StupidLogEntry $ Map.singleton namefunction n
    return ()

-- Function in itself, with writers
countNumberCalls :: (LogFunctionCalls r) => Int -> Writer r Int
countNumberCalls 0 = return 0
countNumberCalls n = do
  myTell "countNumberCalls" 1
  x <- countNumberCalls $ n - 1
  return $ 1 + x

--- Without any writer, pretty efficient
countNumberCallsNoWriter :: Int -> Int
countNumberCallsNoWriter 0 = 0
countNumberCallsNoWriter n = 1 + countNumberCallsNoWriter (n-1)

main :: IO ()
main = do
  putStrLn $ "Hello"
  -- Version without any writter
  print =<< Time.getZonedTime
  let n = countNumberCallsNoWriter 15000000
  putStrLn $ "Without any writer, the result is " ++ (show n)
  -- Version with Logger
  print =<< Time.getZonedTime
  let (n, log :: LogEntry) = Wr.runWriter $ countNumberCalls 15000000
  putStrLn $ "The result is " ++ (show n)
  putStrLn $ "With the logger, the number of calls is " ++ (show $ (logMap log))
  -- Version with the stupid logger
  print =<< Time.getZonedTime
  let (n, log :: StupidLogEntry) = Wr.runWriter $ countNumberCalls 15000000
  putStrLn $ "The result is " ++ (show n)
  putStrLn $ "With the stupid logger, the number of calls is " ++ (show $ (stupidLogMap log))
  print =<< Time.getZonedTime  

Answer 1

Монада Writer - узкое место. Лучший способ обобщить ваш код, чтобы он мог работать в этих двух «режимах», - это изменить интерфейс , т.е. , класс LogFunctionCalls, который будет параметризован монадой:

class Monad m => LogFunctionCalls m where
  myTell :: String -> Int -> m ()

Затем мы можем использовать монаду идентичности (или преобразователь монады), чтобы реализовать ее тривиально:

newtype NoLog a = NoLog a
  deriving (Functor, Applicative, Monad) via Identity

instance LogFunctionCalls NoLog where
  myTell _ _ = pure ()

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

countNumberCalls :: (LogFunctionCalls m) => Int -> m Int

Давайте вставим его в тест, который имеет все виды методологических проблем, как указано в комментариях, но все же что-то интересное происходит, если мы скомпилируем его с помощью ghc -O:

main :: IO ()
main = do
  let iternumber = 1500000
  putStrLn $ "Hello"
  t0 <- Time.getCurrentTime

  -- Non-monadic version
  let n = countNumberCallsNoWriter iternumber
  putStrLn $ "Without any writer, the result is " ++ (show n)
  t1 <- Time.getCurrentTime
  print (Time.diffUTCTime t1 t0)

  -- NoLog version
  let n = unNoLog $ countNumberCalls iternumber
  putStrLn $ "The result is " ++ (show n)
  t2 <- Time.getCurrentTime
  print (Time.diffUTCTime t2 t1)

Результат:

Hello
Without any writer, the result is 1500000
0.022030957s
The result is 1500000
0.000081533s

Как мы видим, вторая версия (та, которая нам важна) заняла нулевое время. Если мы удалим первую версию из теста, тогда оставшаяся займет 0,022 секунды предыдущего.

Итак, GH C фактически оптимизировал один из двух тестов, потому что увидел, что они одинаковы , который достигает того, что мы изначально хотели: код «журналирования» выполняется так же быстро, как специализированный код, без журналирования, потому что они буквально одинаковы, а числа тестов не имеют значения.

Это также может быть подтверждено глядя на сгенерированное ядро; запустите ghc -O -ddump-simpl -ddump-to-file -dsuppres-all и разберитесь с файлом Main.dump-simpl. Или используйте инспекция-тестирование .

Составная сущность: https://gist.github.com/Lysxia/2f98c4a8a61034dcc614de5e95d7d5f8