Disclaimer: всего лишь собственные наблюдения, захотелось поделиться. Может кому интересно будет.
Haskell заработал репутацию чрезвычайно тормознутого языка. Ленивость, добавляющая свой оверхед к любой операции, все значения в хипе, иммутабельность значений — все это, конечно, скорости не добавляет.
Понадобилось решить одну задачку, связанную с разбором гибридного бинарно-текстового формата. Поскольку смысл этого решения — всего лишь упрощение собственной повседневной работы, позволил себе повыбирать средство реализации. В том числе и по быстродействию. И в велосипедописании потренироваться. И вот тут Haskell очень сильно удивил.
Поскольку много кода дублировать на разных языках ой как не хотелось, тест сведен к простой задаче: парсинг потока double'ов. В качестве источника данных — текстовый файл, содержащий 5 000 000 чисел в диапазоне [-10 000; 10 000], размером около 82 мб (сгенереный таким вот C#-кодом):
static void Main(string[] args)
{
using (Stream stm = new FileStream(@"d:\numbers_large.txt", FileMode.Create))
{
TextWriter wr = new StreamWriter(stm);
System.Random r = new System.Random();
for (int i = 0; i < 5000000; i++)
{
double d=10000*r.NextDouble() * (r.NextDouble() > 0.7 ? -1.0 : 1.0);
wr.Write("{0} ", d);
}
wr.Flush();
}
А вот код парсера на Haskell. Код наверняка далек от идеального и избыточен (но и писался он не только для такой простой задачи). Кстати, если кто из здешних знатоков Haskell найдет что покритиковать — буду грейтфул
Компилятор GHC 6.8.2, компиляция, естественно, с оптимизацией:
{-# LANGUAGE NoMonomorphismRestriction, FlexibleInstances,
MultiParamTypeClasses, FunctionalDependencies,
BangPatterns #-}module Main (main) where
import System.Time
import Control.Monad
import Control.Monad.Trans
import qualified Data.ByteString.Char8 as B8
import qualified Data.ByteString.Lazy.Char8 as BL8
import Data.Char
import Data.Int
import Data.Maybe{- результат работы любого парсера:
Pass - успешное завершение,
s - остаток входного потока, a - полученное значение
Fail - неуспешное, s - остаток входного потока в позиции, где случилась ошибка
-}data ParseResult s a = Pass s a | Fail s --deriving Showinstance Show a => Show (ParseResult s a) where
show (Pass _ a) = "Pass: " ++ show a
show _ = "Fail"{- чтобы удобным образом применять преобразования
к полученному от парсера результату, объявим
ParseResult инстансом класса Functor
это даст нам функцию fmap c типом
ParseResult s a -> (a -> b) -> ParseResult s b
-}instance Functor (ParseResult s) where
fmap f (Pass s a) = Pass s (f a)
fmap _ (Fail s) = Fail s
{- для того, чтобы на вход парсера можно было подавать
не только список, но и любой другой тип, например, ByteString,
определим класс типов ParserInput
-}class ParserInput s e | s -> e where
p_get :: s -> ParseResult s e
{- и его инстансы для списка и ByteString -}instance ParserInput [e] e where
p_get (h:t) = Pass t h
p_get s = Fail s
instance ParserInput B8.ByteString Char where
p_get s | B8.null s = Fail s
| otherwise = Pass (B8.tail s) (B8.head s)
instance ParserInput BL8.ByteString Char where
p_get s | BL8.null s = Fail s
| otherwise = Pass (BL8.tail s) (BL8.head s)
{- базовый тип парсера - функция, принимающая как аргумент
входной поток символов, и возвращающая ParseResult,
т.е. при успехе - остаток входного потока и результат,
при неуспехе - только остаток потока после ошибки
-}newtype Parser s a = Parser { runParser :: s -> ParseResult s a }
{- Parser тоже объявим инстансом класса Functor -}instance Functor (Parser s) where
fmap f (Parser p) = Parser $ fmap f . p
{- теперь начинаются монадические заморочки. В принципе, можно
обойтись и без них, но так зато получаем удобную форму
записи с использованием do-notation, а также бонус
в виде некоторых стандартных функций, работающих с монадами
-}
{- return a - возвращает парсер, который независимо от
входного потока завершается успешно и возвращает значение a
bind (>>=) - связывает два парсера в последовательное выполнение,
при неуспехе первого второй не вызывается. Как это выглядит
с использованием do-нотации - будет ниже.
-}instance Monad (Parser s) where
return a = Parser $ \s -> Pass s a
(Parser p) >>= f = Parser $ \s ->
case p s of
Pass s' a' -> runParser (f a') s'
Fail s -> Fail s
{- Объявив парсер инстансом класса MonadPlus, получаем
две функции: mzero - парсер, который в любом случае
завершается с неуспехом, и mplus - альтернатива,
т.е. при неуспехе первого парсера отрабатывает второй
-}instance MonadPlus (Parser s) where
mzero = Parser $ \s -> Fail s
(Parser p1) `mplus` (Parser p2) = Parser $ \s ->
case p1 s of { ok@(Pass _ _) -> ok; _ -> p2 s }
{- теперь вот еще какая штука: часто результат разбора в
виде строки/списка нам вообще не нужен, а нужен результат
некоей операции над этим списком - типа fold'а
Можно определить тип парсера, который сразу же
по мере обработки потока будет эту свертку выполнять.
Получается нечто очень похожее на стандартную монаду
Writer, но Writer требует, чтобы хранящееся в нем
значение было моноидом - что-то у меня не получилось
с этим обходиться -}newtype WriterP w m a = WriterP { runWriterP :: w -> m (w, a) }
instance Monad m => Monad (WriterP w m) where
return a = WriterP $ \w -> return (w, a)
(WriterP p) >>= f = WriterP $ \w -> do
(w', a') <- p w
runWriterP (f a') w'
instance MonadTrans (WriterP w) where
lift m = WriterP $ \w -> do { a <- m; return (w, a) }
instance MonadPlus m => MonadPlus (WriterP w m) where
mzero = lift mzero
(WriterP p1) `mplus` (WriterP p2) = WriterP $ \w -> p1 w `mplus` p2 w
instance Functor m => Functor (WriterP w m) where
fmap f (WriterP p) = WriterP $ \w -> fmap (apply2 f) (p w)
where apply2 f (a, b) = (a, f b)
{- базовый "кирпичик", на основе которого строятся все парсеры -
парсер, который берет 1 символ из входного потока,
и успешно завершается, если поток не пуст.
Чтобы компилятор мог сам вывести тип - Parser или WriterP Parser,
определим класс типов ParseMonad -}class Monad m => ParseMonad m a where
p_take :: m a
instance ParserInput s a => ParseMonad (Parser s) a where
p_take = Parser p_get
instance ParseMonad m a => ParseMonad (WriterP w m) a where
p_take = lift p_take
{- теперь на основе базового "кирпичика" чуть более полезные
строительные блоки -}
{- парсер на основе предиката - завершается успешно,
если символ из входного потока соответствует условию -}
p_pred :: (ParseMonad p a, MonadPlus p) => (a -> Bool) -> p a
p_pred f = do
a <- p_take
if f a then return a else mzero
{- парсер, принимающий только заданный символ -}
p_sym :: (Eq a, ParseMonad p a, MonadPlus p) => a -> p a
p_sym c = p_pred (==c)
{- и, для удобства, его вариация - один из двух символов -}
p_sym2 :: (Eq a, ParseMonad p a, MonadPlus p) => a -> a -> p a
p_sym2 c d = p_pred $ \a -> a == c || a == d
{- парсер, принимающий заданную строку -}
p_string = mapM p_sym
{- p_try - парсер, который всегда завершается успешно,
но возвращает не a, a Maybe a -}
p_try :: (Functor p, MonadPlus p) => p a -> p (Maybe a)
p_try p = fmap Just p `mplus` return Nothing{- many - множественный (0 или более) повтор парсера
не возвращает значения, предполагается что
парсером будет WriterP -}
many :: (Functor p, MonadPlus p) => p a -> p ()
many p = mn
where mn = do
a <- p_try p
case a of {Just _ -> mn; _ -> return () }
{- 1 или более -}
many1 p = p >> many p
{-- ============================================
теперь вернемся к WriterP. Чтобы иметь возможность
накапливать значение по мере парсинга, определим
класс типов - накопителей
-- ============================================ -}class Accumulator a e | a -> e where
a_empty :: a
a_append :: e -> a -> a
{- и его инстанс для списка, чтобы иметь возможность
получать результат парсера в виде списка -}instance Accumulator [e] e where
a_empty = []
a_append = (:)
{- теперь трансформер для парсера, который преобразует
его в аккумулирующий -}
writing :: (Accumulator w a, Monad p) => p a -> WriterP w p ()
writing p = WriterP $ \(!w) -> do
a <- p
return (a_append a w, ())
{- и для случаев, если отдельный тип-аккумулятор
заводить не хочется -}
writingF :: Monad p => (a -> w -> w) -> p a -> WriterP w p ()
writingF f p = WriterP $ \(!w) -> do
a <- p
return (f a w, ())
{- обратный трансформер - аккумулирующий парсер
в возвращающий накопленное значение -}
wrRun :: (Monad p, Functor p) => WriterP w p x -> w -> p w
wrRun (WriterP p) w = fmap fst $ p w
{- и еще одна вариация -}
wrUnwrap :: (Functor p, Accumulator w e) => WriterP w p x -> (w -> a) -> p a
wrUnwrap (WriterP p) f = fmap (f . fst) $ p a_empty
(|>|) = wrUnwrap
{- =========================================
теперь ближе к предмету - пусть пока
это будут числа -}
{- digit - парсер, принимающий символы от '0' до '9'
и возвращающий уже их числовое значение -}
digit = fmap digitToInt $ p_pred isDigit
spaces = many $ p_pred isSpace
dot = p_sym2 ',' '.'{- sign - парсер, опционально принимающий знаки '+' и '-',
возвращающий Double-множитель, -1.0 для '-',
1.0 в противном случае -}
sign = fmap getSign $ p_try (p_sym2 '-' '+')
where getSign (Just '-') = -1.0
getSign _ = 1.0
data IntAcc = IntAcc { getInt :: {-# UNPACK #-} !Double }
instance Accumulator IntAcc Int where
a_empty = IntAcc 0.0
a_append i (IntAcc a) = IntAcc $ a * 10.0 + fromIntegral i
{- intPart - разбор целой части -}
intPart = many1 (writing digit) |>| getInt
{- а если не хочется городить отдельный тип для аккумулятора -
можно так -}
intPart2 = wrRun (many1 (writingF intFold digit)) 0.0
where intFold e !i = i * 10.0 + fromIntegral e
data FrAcc = FrAcc { mult :: {-# UNPACK #-} !Double,
getFrac :: {-# UNPACK #-} !Double }
instance Accumulator FrAcc Int where
a_empty = FrAcc 0.1 0.0
a_append i (FrAcc m a) = FrAcc (m * 0.1) (a + m * fromIntegral i)
{- fracPart - разбор дробной части -}
fracPart = dot >> many1 (writing digit) |>| getFrac
{- expn - разбор экспоненты -}
expn = do
p_sym2 'e' 'E'
s <- sign
i <- intPart
return $ 10 ** (s * i)
{- number - разбор числового значения -}
number = do
spaces
s <- sign
i <- p_try intPart
f <- p_try fracPart
exp <- liftM (fromMaybe 1.0) $ p_try expn
case (i, f) of
(Nothing, Nothing) -> mzero
_ -> return $! exp * s * (fmay i + fmay f)
where fmay = fromMaybe 0.0
data Sum a = Sum {getSum :: {-# UNPACK #-} !a}
instance Num a => Accumulator (Sum a) a where
a_empty = Sum $ fromIntegral 0
a_append e (Sum a) = Sum $ e + a
sumNumbers = many (writing number) |>| getSum
{- выполнение IO action c замером времени -}
measured :: IO a -> IO (a, Double)
measured act = do
let getSeconds t = fromIntegral (tdPicosec t) / 1000000000000.0 + fromIntegral (tdSec t)
start <- getClockTime
!r <- act
end <- getClockTime
let delta = getSeconds $ diffClockTimes end start
return (r, delta)
calculateSumm str = do
let res = runParser sumNumbers str
putStrLn $ "Sum: " ++ show res
return ()
benchMark = do
str <- B8.readFile "d:\\numbers_large.txt"
(_, time) <- measured $ calculateSumm str
putStrLn $ "Time: " ++ show time ++ " s."let thr = fromIntegral (B8.length str) / time / 1048576.0;
putStrLn $ "Throughput: " ++ show thr ++ " Mb/s"
return ()
main = benchMark
От имени C++ выступает boost::spirit, как инструмент, дающий в руки C++-программиста абстракции, примерно идентичные ФП-шным комбинаторным парсерам. Вот такой (все просто, т.к. используется встроенный спиритовский парсер real_p)
Компилятор — Visual C++ Express 2008. Все опции оптимизации на максимум — Full optimization, inline any suitable, favor fast code, link-time code generation.
Результат работы (Core2Duo 3,12 ггц)
Haskell — ~1.56 секунды. 52,5 мб/сек.
C++ (spirit) — ~1.88 секунды. 44 мб/сек. Правда, если рантайм сменить с DLL на статически линкуемый, то ~1.65 секунды.
Вот так. Haskell вровень с C++, и даже опережает.
Хотел привести еще то же решение на F#, но если не скатываться к традиционному императивному решению (а зачем тогда F# нужен?), быстрее 10 сек. пока не получилось.
Вообще, старичок двухплюсатый все равно на высоте — если все переписать вручную (код тупой, приводить не охота), отрабатывает за 0,45 сек. Только ведь в более сложном случае вероятность такого ручного расписывания невелика.
Ну а по выразительности c Haskell сложно что-либо сравнивать. Монады — вообще чертовски интересная штука. Этакий очень абстрактный интерфейс, который, если придумать, как пристегнуть к своей задаче, дает бонус в виде стандартных библиотечных функций, ориентированных на работу с монадами. Например, из кода выше:
-- p_sym - парсер, принимающий заданный символ
-- p_string - парсер, принимающий заданную строку
p_string = mapM p_sym -- mapM - стандартная функция, которой
-- достаточно только того, что p_sym - монада
Re: Haskell :: не такой тормоз, как кажется
От:
Аноним
Дата:
22.02.08 06:22
Оценка:
Здравствуйте, Schade:
вы сравниваете не хаскель и с++, а свой парсер со спиритом. здесь же на rsdn было показано, что парсер на с# в 10 раз быстрей спирита. сам по себе спирит — достаточно тормозная штуковина
Здравствуйте, Аноним, Вы писали:
А>вы сравниваете не хаскель и с++, а свой парсер со спиритом.
Ну, в общем, да. Вроде бы прямым текстом об этом и пишу. И причина указана: более-менее одинаковый подход к решению задачи (насколько это вообще возможно в случае C++ и Haskell)
A>здесь же на rsdn было показано, что парсер на с# в 10 раз быстрей спирита. сам по себе спирит — достаточно тормозная штуковина
Ссылку можно? Интересно поглядеть. Вообще, я привел результат на C++ врукопашную (только код не приводил )- где-то в 3,5 раза быстрее. Если перекомпилировать тот же код в режиме /clr:pure, разница сокращается до 2,5 раз.
Знаем-с. Могу ошибаться, но по-моему в тех ранкигнах Haskell выезжает в основном на использовании более продвинутых алгоритмов, сложных в реализации на более низкоуровневых языках. Мне же было интересно сравнить на более-менее одинаковых алгоритмах, собственно почему и сравнивал со спиритом. В некотором роде этот пост — ответ на заявление
Здравствуйте, Schade, Вы писали:
А>>вы сравниваете не хаскель и с++, а свой парсер со спиритом. S>Ну, в общем, да. Вроде бы прямым текстом об этом и пишу. И причина указана: более-менее одинаковый подход к решению задачи (насколько это вообще возможно в случае C++ и Haskell)
А если то же самое эксперимента ради на Parsec переписать?
Здравствуйте, Аноним, Вы писали:
А>А если то же самое эксперимента ради на Parsec переписать?
Надо попробовать. Я правда как-то сходу им не проникся, там можно без промежуточных списков обойтись? А то на deforestation надейся, а сам не плошай — со списками такая тормозуха получается.
Симпатично. Некоторое количество замечаний таки набралось.
S>instance Functor (ParseResult s) where S> fmap f (Pass s a) = Pass s (f a) S> fmap _ (Fail s) = Fail s
Зачем? Мы используем этот fmap только в одном месте — см. ниже.
S>instance Functor (Parser s) where S> fmap f (Parser p) = Parser $ fmap f . p
Тут проще написать ... where fmap = liftM. И всё. И не требуется instance Functor (ParseResult s).
S>instance Monad (Parser s) where S> return a = Parser $ \s -> Pass s a S> (Parser p) >>= f = Parser $ \s -> S> case p s of S> Pass s' a' -> runParser (f a') s' S> Fail s -> Fail s
Очень не вредно объявить fail _ = Parser $ \s -> Fail s
S>newtype WriterP w m a = WriterP { runWriterP :: w -> m (w, a) }
А не проще воспользоваться mtl-ным StateT? Он ведь ровно так и определяется, с точностью до порядка элементов в паре.
S>instance Monad m => Monad (WriterP w m) where ... S>instance MonadTrans (WriterP w) where ... S>instance MonadPlus m => MonadPlus (WriterP w m) where ... S>instance Functor m => Functor (WriterP w m) where ...
Всё это мы получаем от StateT бесплатно, кроме последнего — в mtl там стоит контекст (Monad m) — но нам ведь это по фигу? Кстати, это, похоже, баг в mtl, надо, действительно, Functor.
S>class Monad m => ParseMonad m a where S> p_take :: m a
Очень правильно, интерфейс монады надо определять в классе.
S>instance ParseMonad m a => ParseMonad (WriterP w m) a where S> p_take = lift p_take
Ну, понятно, StateT вместо WriterP. Дальше заменять не буду, и так понятно. Или можно просто сказать type WriterP w m a = StateT w m a.
S>p_pred :: (ParseMonad p a, MonadPlus p) => (a -> Bool) -> p a S>p_pred f = do S> a <- p_take S> if f a then return a else mzero
Последнюю строчку я бы разбил на две:
guard $ f a
return a
S>many :: (Functor p, MonadPlus p) => p a -> p () S>many p = mn S> where mn = do S> a <- p_try p S> case a of {Just _ -> mn; _ -> return () }
Может, просто написать many p = many1 p `mplus` return ()? Или, если уж на то пошло, сделать many :: p a -> p [a]; many p = many1 p `mplus` return []
S>many1 p = p >> many p
Соответственно, many1 p = liftM2 ( p $ many p?
S>writing p = WriterP $ \(!w) -> do S> a <- p S> return (a_append a w, ())
Уй! Можно уровнем повыше работать. Во-1, если уж (!), то импортировать Control.Monad.State.Strict. Во-2, переписать таким образом: writing p = do {a <- lift p; modify $ a_append a; return ()}. Кстати, а почему мы обязательно возращаем ()?
S>writingF f p = WriterP $ \(!w) -> do S> a <- p S> return (f a w, ())
Аналогично: writingF f p = do {a <- lift p; modify $ f a; return ()}; кстати, тогда не вредно бы определить выше writing как writingF a_append.
S>wrRun :: (Monad p, Functor p) => WriterP w p x -> w -> p w S>wrRun (WriterP p) w = fmap fst $ p w
wrRun = execStateT
S>wrUnwrap :: (Functor p, Accumulator w e) => WriterP w p x -> (w -> a) -> p a
Ценой замены Functor на Monad, получаем wrUnwrap p f = liftM f $ execStateT p a_empty
S>digit = fmap digitToInt $ p_pred isDigit
ИМХО — только ИМХО — для монад лучше читается liftM, а не fmap (хотя это одно и то же).
S>data IntAcc = IntAcc { getInt :: {-# UNPACK #-} !Double }
А почему не newtype?
S>measured act = do S> let getSeconds t = fromIntegral (tdPicosec t) / 1000000000000.0 + fromIntegral (tdSec t) S> start <- getClockTime S> !r <- act S> end <- getClockTime S> let delta = getSeconds $ diffClockTimes end start S> return (r, delta)
Чего-то мне в голову стукнуло, что bang patterns внутри do-блоков ничего не делают.
Не ручаюсь, что что-нибудь из этого не вызовет падения производительности. Кстати, я слышал, что с какими-то ghc поставлялась mtl, откомпилированная без оптимизации — что, естественно, замедляло работу.
Re[2]: Haskell :: не такой тормоз, как кажется
От:
Аноним
Дата:
22.02.08 18:48
Оценка:
Блин. Дико извиняюсь, (:) заменилось на корявый смайлик.
Здравствуйте, http://migmit.vox.com/, Вы писали:
HMV>Симпатично. Некоторое количество замечаний таки набралось.
Замечательно, что набралось.
S>>instance Functor (ParseResult s) where HMV>Зачем? Мы используем этот fmap только в одном месте — см. ниже.
Ну, в конечном итоге, мы же все равно вызываем runParser и получаем ParseResult. Почему бы и не оставить? Хотя в принципе да, liftM достаточно.
S>>instance Functor (Parser s) where S>> fmap f (Parser p) = Parser $ fmap f . p HMV>Тут проще написать ... where fmap = liftM. И всё. И не требуется instance Functor (ParseResult s).
+1. Сам заметил уже после.
S>>instance Monad (Parser s) where HMV>Очень не вредно объявить fail _ = Parser $ \s -> Fail s
+1
S>>newtype WriterP w m a = WriterP { runWriterP :: w -> m (w, a) }
HMV>А не проще воспользоваться mtl-ным StateT? Он ведь ровно так и определяется, с точностью до порядка элементов в паре.
S>>instance Monad m => Monad (WriterP w m) where ... S>>instance MonadTrans (WriterP w) where ... S>>instance MonadPlus m => MonadPlus (WriterP w m) where ... S>>instance Functor m => Functor (WriterP w m) where ...
HMV>Всё это мы получаем от StateT бесплатно, кроме последнего — в mtl там стоит контекст (Monad m) — но нам ведь это по фигу? Кстати, это, похоже, баг в mtl, надо, действительно, Functor.
В общем-то, сначала проглядел наличие в стандартной библиотеке strict state Ну и дух велосипедизма — хотелось в своей голове утрясти. Я ж только с C++-ной пальмы слез
S>>many :: (Functor p, MonadPlus p) => p a -> p () S>>many p = mn S>> where mn = do S>> a <- p_try p S>> case a of {Just _ -> mn; _ -> return () }
HMV>Может, просто написать many p = many1 p `mplus` return ()? Или, если уж на то пошло, сделать many :: p a -> p [a]; many p = many1 p `mplus` return [] S>>many1 p = p >> many p HMV>Соответственно, many1 p = liftM2 ( p $ many p?
Что касается первого варианта: many p = many1 p `mplus` return () — ленивость языка, конечно, позволяет уделять меньше внимания преобразованию наивной рекурсии в хвостовую. Но тут не спасает — на сколько-нибудть серьезных объемах данных получаем stack overflow.
many :: p a -> p [a] — это самое очевидное, наглядное, удобное в использовании и легкочитаемое решение. Но, как часто бывает в таких случаях, полный (_|_) bottom по части производительности.
А если в результате нужен все-таки список, можем определить
manyL :: (Functor p, MonadPlus p) => p a -> p [a]
manyL p = many (writing p) |>| reverse
Хотя, конечно, не идеально. Хорошо бы без reverse обойтись.
S>>writing p = WriterP $ \(!w) -> do S>> a <- p S>> return (a_append a w, ())
HMV>Уй! Можно уровнем повыше работать. Во-1, если уж (!), то импортировать Control.Monad.State.Strict. Во-2, переписать таким образом: writing p = do {a <- lift p; modify $ a_append a; return ()}. Кстати, а почему мы обязательно возращаем ()?
(!) — это потому что с ленивым Хаскелем именно в этом месте нужно обойтись со всей строгостью во избежание space leak. Ну, по поводу StateT все понятно, а что еще возвращать, кроме ()? То же самое a? Вроде как путаница получается — и к состоянию это значение присовокупляем, и возвращаем. Вообще надо подумать.
HMV>Аналогично: writingF f p = do {a <- lift p; modify $ f a; return ()}; кстати, тогда не вредно бы определить выше writing как writingF a_append.
+1
HMV>wrRun = execStateT
+1
HMV>Ценой замены Functor на Monad, получаем wrUnwrap p f = liftM f $ execStateT p a_empty
+1
S>>digit = fmap digitToInt $ p_pred isDigit HMV>ИМХО — только ИМХО — для монад лучше читается liftM, а не fmap (хотя это одно и то же).
S>>data IntAcc = IntAcc { getInt :: {-# UNPACK #-} !Double } HMV>А почему не newtype?
Для newtype не позволяет указать strictness annotation. Хотя да, в случае с newtype компилятор, похоже, и сам выполняет UNPACK, даже процентов на 5 в итоге быстрее получается. Что-то я в прошлый раз не так делал, что с newtype получил тормоза.
Здравствуйте, Аноним, Вы писали:
А>А если то же самое эксперимента ради на Parsec переписать?
{-# LANGUAGE BangPatterns#-}module Main where
import System.Time
import System.IO
import Control.Monad
import Text.ParserCombinators.Parsec
import Text.ParserCombinators.Parsec.Language
import Text.ParserCombinators.Parsec.Token
import qualified Data.ByteString.Char8 as B8
sign = liftM getSign (optionMaybe $ oneOf "-+")
where getSign (Just '-') = -1.0
getSign _ = 1.0
number = do
s <- sign
d <- liftM getN $ naturalOrFloat haskell
return $! s * d
where getN (Left i) = fromIntegral i
getN (Right f) = f
sep = spaces >> return (+)
sumNumbers = spaces >> chainl number sep 0.0
measured act = do
let getSeconds t = fromIntegral (tdPicosec t) / 1000000000000.0 + fromIntegral (tdSec t)
start <- getClockTime
!r <- act
end <- getClockTime
let delta = getSeconds $ diffClockTimes end start
return (r, delta)
calculateSumm str = do
let !res = parse sumNumbers "" str
putStrLn $ "Sum: " ++ show res
return ()
benchmark = do
str <- readFile "d:\\numbers.txt"
(_, time) <- measured $ calculateSumm str
putStrLn $ "Time: " ++ show time ++ " s."let thr = fromIntegral (length str) / time / 1048576.0;
putStrLn $ "Throughput: " ++ show thr ++ " Mb/s"
return ()
main = benchmark
Работает только при относительно небольшом объеме данных. С 1 000 000 чисел не справляется — долгое пыхтение, затем stack overflow. Явный признак чрезмерной ленивости. Увеличиваем стек — отрабатывает со скоростью примерно 1,33 мб/сек, в 35-37 раз медленнее моего примера.
Беда в том, что в чужом коде не всегда легко понять, в каком месте прищемить хаскелю его ленивость.
Ну и конечно просто убивает традиция haskell community писать так, как будто данных всегда будет заведомо мало, а память и стек бесконечны.
Наверное можно переписать так, чтобы отрабатывало нормально, но все равно будет медленнее. Хотя бы из-за того, что входной поток может быть только списком.
[]
Опп... неспортивно обошелся с парсеком...
Во первых, списки не настолько дешевы, чтобы все время работы держать ссылку на голову списка
Во вторых, явно нужно добавить строгости:
sumNumbers = sn 0.0
where sn !acc = do
n <- optionMaybe number
case n of { Just v -> sn (acc+v); _ -> return acc }
Так на основном тестовом файле отрабатывает. Но скорость...
136 секунд. В 87 раз медленнее.
Re[6]: Haskell :: не такой тормоз, как кажется
От:
Аноним
Дата:
27.02.08 14:17
Оценка:
Здравствуйте, Schade, Вы писали:
S>Так на основном тестовом файле отрабатывает. Но скорость...
Действительно, быстро доработать Parsec чтобы тот парсил BypeString не получается... уж чень он завязан на String.
Ну а если взять например, Text.ParserCombinators.ReadP.ByteString ?
Хотя он не его набор готовых примитивов не столь разнообразен, как парсековский
Ради интереса изобразил нечто подобное на OCaml с использованием enumerations из ExtLib.
На Core2Duo 2.0 GHz получается всего 3,8 МБ/с..
open ExtString;;
let (>>=) o f = match o with Some x -> f x | None -> None;;
let (>>) x f = f x;;
let digit c = c>='0' && c<='9';;
let p_pred p e =
match Enum.peek e with
| Some c -> if p c then Enum.get e else None
| None -> None;;
let manyf prs f s e =
let rec frec v =
match prs e with
| Some c -> frec (f v c)
| None -> v
in frec s;;
let rec many prs e =
match prs e with
| Some _ -> many prs e
| None -> ();;
let mkInt v c = v*10 + (int_of_char c) - 48;;
let mkFrac (fv,fr) c = (fv +. (float_of_int ((int_of_char c)-48))*.fr, fr*.0.1);;
let p_spaces = many (p_pred ((=) ' '));;
let p_sign e = match p_pred ((=) '-') e with Some _ -> -1.0 | None -> 1.0;;
let p_int e = Some (manyf (p_pred digit) mkInt 0 e);;
let p_dot = p_pred ((=) ',');;
let p_frac e = let (fv,fr) = manyf (p_pred digit) mkFrac (0.0, 0.1) e in Some fv;;
let p_float e =
p_spaces e >> fun _ ->
p_sign e >> fun s ->
p_int e >>= fun n ->
p_dot e >>= fun _ ->
p_frac e >>= fun fr ->
Some(s *. ((float_of_int n) +. fr));;
let sumNumbers = manyf p_float (+.) 0.0;;
let measured f =
let t0 = Unix.times() in
let _ = f () in
let t1 = Unix.times() in
t1.Unix.tms_utime -. t0.Unix.tms_utime;;
let ic = open_in "e:\\numbers_large.txt" in
let str = input_line ic in
let t = measured (fun ()->print_float (sumNumbers (String.enum str))) in
close_in ic;
Printf.printf " %f s, %f MB/s" t ((float_of_int (String.length str)) /. t /. 1048576.0);;
Здравствуйте, D. Mon, Вы писали:
DM>Ради интереса изобразил нечто подобное на OCaml с использованием enumerations из ExtLib. DM>На Core2Duo 2.0 GHz получается всего 3,8 МБ/с..
Вообще странно конечно. Вроде бы Камл считается шустрым. У меня отработал немного быстрее — 5,4 Мб/с.
Но вот что интересно — подобное на F# оказалось быстрее (причем F# с участием его новой фичи —
computation expressions aka monads).
[страшный нечитаемый ужас]
#light
open System
type sc = System.Console
module Accumulator =
type ('e, 'a) t = 'a * ('e -> 'a -> 'a)
let create a f = (a, f)
let append e (a, f) = (f e a, f)
let get = fst
module Iterator =
type 'a t = {buf: 'a array; len: int; pos: int}
let iterate arr from = {buf=arr; len=Array.length arr; pos=from}
let inline valid i = i.pos < i.len
let current i = i.buf.(i.pos)
let next i = {i with pos = i.pos+1}
let measured f =
let sd = System.Diagnostics.Stopwatch()
sd.Start()
let res = f()
sd.Stop()
let time = double (sd.ElapsedMilliseconds) / 1000.0
(res, time)
module A = Accumulator
module I = Iterator
type ('a, 's) ParseResult = Pass of 'a * 's | Fail
let pr_map f = function Pass (a, s) -> Pass(f a, s) | _ -> Fail
type ('a, 's) Parser = 's -> ('a, 's) ParseResult
let p_map f p = p >> (pr_map f)
let p_take s = if I.valid s then Pass(I.current s, I.next s) else Fail
let p_pred f = p_take >> function Pass(a, _) as ok when f a -> ok | _ -> Fail
let p_sym c = p_pred ((=) c)
let p_sym2 a b = p_pred (fun c -> c=a || c = b)
let p_try p s = p s |> function Pass(a, s') -> Pass(Some(a), s') | _ -> Pass(None, s)
let (<|>) p1 p2 s = p1 s |> function Pass(_, _) as ok -> ok | _ -> p2 s
let many p ac =
let rec m acc s = match p s with Pass(a', s') -> m (A.append a' acc) s' | _ -> Pass(acc, s)
m ac
let skipmany p =
let rec m s = match p s with Pass(_, s') -> m s'| _ -> Pass((), s)
m
let fconst a = fun _ -> a
type ParseMonad() =
member x.Delay p = p ()
member x.Return a = fun s -> Pass(a, s)
member x.Bind(p, f) = p >> function Pass(a', s') -> (f a') s' | _ -> Fail
member x.Let(a, f) = f a
member x.Zero() = fconst Fail
let parse = ParseMonad()
let many1 p acc =
parse { let! r1 = p
let! r2 = many p (A.append r1 acc)
return r2
}
let isDigit c = c >= 48uy && c <= 57uy
let digitToInt c = int (c - 48uy)
let digit = p_map digitToInt (p_pred isDigit)
let intAcc = A.create 0.0 (fun e a -> double e + a * 10.0)
let intPart = p_map A.get (many1 digit intAcc)
let frAcc = A.create (0.1, 0.0) (fun e (m, a) -> (m*0.1, a + m * double e))
let fracPartImpl = p_map (A.get >> snd) (many1 digit frAcc)
let sign = p_map (function Some(45uy) -> -1.0 | _ -> 1.0) (p_try (p_sym2 45uy 43uy))
let dot = p_map (fconst ()) (p_sym2 46uy 44uy)
let spaces = skipmany (p_sym 32uy)
let fracPart =
parse { do! dot
let! r = fracPartImpl
return r
}
let exponent =
parse { do! p_map ignore (p_sym2 101uy 69uy)
let! r = intPart
return 10.0 ** double r
}
let fromOption a = function Some x -> x | _ -> a
let number =
let fmay = fromOption 0.0
parse { do! spaces
let! s = sign
let! i = p_try intPart
let! f = p_try fracPart
let! exp = p_map (fromOption 1.0) (p_try exponent)
match (i, f) with
| (None, None) -> return! (fconst Fail)
| _ -> return (exp * s * (fmay i + fmay f))
}
let manyNumbers iter () = iter |> p_map (A.get) (many number (A.create 0.0 (+)))
let benchMark() =
let str = IO.File.ReadAllBytes @"d:\numbers_large.txt"let i = I.iterate str 0
let (res, time) = measured (manyNumbers i)
match res with
| Pass(sum, _) ->
let thr = double (Array.length str) / 1048576.0 / time
sc.WriteLine("Sum: {0}; Time: {1} s", sum, time)
sc.WriteLine("Throughput: {0} Mb/s", thr)
| _ -> sc.WriteLine "Fail"do
sc.WriteLine "Here I go"
benchMark()
sc.ReadKey() |> ignore
[/страшный нечитаемый ужас]
Отрабатывает со скоростью 7,3 Мб/с, процентов на 40 шустрее. И все равно отставание от Хаскеля катастрофическое — в 7 раз
Заменил в своем OCaml коде монады на то, что они эмулировали, скорость возросла в 4,3 раза до 16 МБ/с.
exception Noparse;;
let reader s =
let len = String.length s and pos = ref 0 in
fun p ->
if !pos>=len then raise Noparse else
let c = s.[!pos] in
if p c then (incr pos; c) else raise Noparse;;
let digit c = c>='0' && c<='9';;
let manyf prs f s r =
let cv = ref s in
try let rec frec v = cv := v; frec (f v (prs r)) in frec s
with Noparse -> !cv;;
let many prs r =
try let rec frec () = let _ = prs r in frec () in frec ()
with Noparse->();;
let mkInt v c = v*10 + (int_of_char c) - 48;;
let mkFrac (fv,fr) c = (fv +. (float_of_int ((int_of_char c)-48))*.fr, fr*.0.1);;
let p_pred p r = r p;;
let p_spaces = many (p_pred ((=) ' '));;
let p_sign r = try let _ = p_pred ((=) '-') r in (-1.0) with Noparse -> 1.0;;
let p_int = manyf (p_pred digit) mkInt 0;;
let p_dot = p_pred ((=) ',');;
let p_frac r = let (fv,fr) = manyf (p_pred digit) mkFrac (0.0, 0.1) r in fv;;
let p_float r =
let _ = p_spaces r in
let s = p_sign r in
let n = p_int r in
let _ = p_dot r in
let fr = p_frac r in
s *. ((float_of_int n) +. fr);;
let sumNumbers = manyf p_float (+.) 0.0;;
let measured f =
let t0 = Unix.times() in
let _ = f () in
let t1 = Unix.times() in
t1.Unix.tms_utime -. t0.Unix.tms_utime;;
let ic = open_in "e:\\numbers_large.txt" in
let str = input_line ic in
let t = measured (fun ()->print_float (sumNumbers (reader str))) in
close_in ic;
Printf.printf " %f s, %f MB/s" t ((float_of_int (String.length str)) /. t /. 1048576.0);;
Здравствуйте, Basil B, Вы писали:
BB>? На плюсах получилось гораздо короче и яснее, имхо.
Ну, вообще-то, чтобы сравнивать приведенный Haskell-код с плюсами к плюсовому коду нужно прибавить еще весь boost::spirit.
И тут от краткости и ясности камня на камне не останется.
Schade wrote:
> > Ну, вообще-то, чтобы сравнивать приведенный Haskell-код с плюсами к > плюсовому коду нужно прибавить еще весь boost::spirit. И тут от краткости > и ясности камня на камне не останется.
Ты, кстати, с Parsec'ом 3-й версии не пробовал?
Posted via RSDN NNTP Server 2.1 beta
Побеждающий других — силен,
Побеждающий себя — Могущественен.
Лао Цзы