Haskell:使用Monoid和Foldable排序

时间:2018-04-13 05:12:59

标签: haskell

我正在尝试使用MonoidFoldable实现排序。这就是我到目前为止所拥有的。这真的很慢。但是,当我在没有MonoidFoldable的情况下编写相同的函数时,速度相当快。任何关于我在这里做错的指示都将非常感激。

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函数的实现。它使用相同的leftHalfrightHalf来分割列表,并使用相同的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)

1 个答案:

答案 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 divided; 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.