我正在尝试使用Monoid
和Foldable
实现排序。这就是我到目前为止所拥有的。这真的很慢。但是,当我在没有Monoid
或Foldable
的情况下编写相同的函数时,速度相当快。任何关于我在这里做错的指示都将非常感激。
newtype MergeL a = MergeL { getMergeL :: [a] } deriving (Eq, Show)
instance Ord a => Monoid (MergeL a) where
mempty = MergeL []
mappend l r = MergeL $ merge (getMergeL l) (getMergeL r)
comp :: a -> MergeL a
comp a = MergeL [a]
instance Foldable MergeL where
foldMap f xs =
case divide xs of
(MergeL [], MergeL []) -> mempty
(MergeL l , MergeL []) -> foldMap f l
(MergeL [], MergeL r) -> foldMap f r
(MergeL l , MergeL r) -> foldMap f l <> foldMap f r
divide :: MergeL a -> (MergeL a, MergeL a)
-- now uses leftHalf and rightHalf
divide xs = (MergeL $ leftHalf ls, MergeL $ rightHalf ls)
where
ls = getMergeL xs
foldSort :: (Ord a, Foldable t) => t a -> [a]
foldSort = getMergeL . foldMap comp
mon :: Integer -> IO ()
mon n = (print . last . getMergeL . foldMap comp) $ MergeL [n,n - 1 ..0]
共享助手功能:
leftHalf :: [a] -> [a]
leftHalf xs = take (length xs `div` 2) xs
rightHalf :: [a] -> [a]
rightHalf xs = drop (length xs `div` 2) xs
merge :: Ord a => [a] -> [a] -> [a]
merge xs [] = xs
merge [] ys = ys
merge (x:xs) (y:ys)
| (x <= y) = x:(merge xs (y:ys))
| otherwise = y:(merge (x:xs) ys)
这是没有Monoid
的sort函数的实现。它使用相同的leftHalf
和rightHalf
来分割列表,并使用相同的merge
来合并列表:
mergesort :: Ord a => [a] -> [a]
mergesort [] = []
mergesort [x] = [x]
mergesort xs = merge (mergesort (leftHalf xs)) (mergesort (rightHalf xs))
plain :: Integer -> IO ()
plain n = (print . last . mergesort) [n,n - 1 ..0]
表现的差异是:
λ> mon 4000
4000
(2.20 secs, 1,328,105,368 bytes)
λ> plain 4000
4000
(0.03 secs, 11,130,816 bytes)
答案 0 :(得分:2)
The main problem here is quite easy to miss (in fact, I overlooked it until I threw in a trace
in divide
). One of your foldMap
cases is:
(MergeL l , MergeL r) -> foldMap f l <> foldMap f r
There, foldMap
is being called on l
and r
, which are plain lists, as opposed to MergeL
-wrapped lists. That being so, l
and r
are not divide
d; rather, they are merged element by element. As a consequence, the sorting becomes quadratic.
In addition to using the MergeL
foldMap
recursively, fixing the instance also requires adding extra cases for single element lists, as dividing them is as problematic as dividing empty lists:
instance Foldable MergeL where
foldMap f xs =
case divide xs of
(MergeL [], MergeL []) -> mempty
(ml, MergeL [y]) -> foldMap f ml <> f y
(MergeL [x], mr) -> f x <> foldMap f mr
(ml, MergeL []) -> foldMap f ml
(MergeL [], mr) -> foldMap f mr
(ml, mr) -> foldMap f ml <> foldMap f mr
This gives acceptable performance -- same complexity and order of magnitude of timings than the plain implementation without optimisations, and about the same performance with optimisations.