module Algorithms.DivideAndConquer( divideAndConquer
, divideAndConquer1
, divideAndConquer1With
, mergeSorted, mergeSortedLists
, mergeSortedBy
, mergeSortedListsBy
) where
import Data.List.NonEmpty (NonEmpty(..),(<|))
import qualified Data.List.NonEmpty as NonEmpty
-- | Divide and conquer strategy
--
-- the running time is: O(n*L) + T(n) = 2T(n/2) + M(n)
--
-- where M(n) is the time corresponding to the semigroup operation of s
--
divideAndConquer1 :: Semigroup s => (a -> s) -> NonEmpty a -> s
divideAndConquer1 = divideAndConquer1With (<>)
-- | Divide and conquer for
divideAndConquer :: Monoid s => (a -> s) -> [a] -> s
divideAndConquer g = maybe mempty (divideAndConquer1 g) . NonEmpty.nonEmpty
-- | Divide and conquer strategy
--
-- the running time is: O(n*L) + T(n) = 2T(n/2) + M(n)
--
-- where M(n) is the time corresponding to the merge operation s
--
divideAndConquer1With :: (s -> s -> s) -> (a -> s) -> NonEmpty a -> s
divideAndConquer1With (<.>) g = repeatedly merge . fmap g
where
repeatedly _ (t :| []) = t
repeatedly f ts = repeatedly f $ f ts
merge ts@(_ :| []) = ts
merge (l :| r : []) = l <.> r :| []
merge (l :| r : ts) = l <.> r <| (merge $ NonEmpty.fromList ts)
--------------------------------------------------------------------------------
-- * Merging NonEmpties/Sorted lists
mergeSorted :: Ord a => NonEmpty a -> NonEmpty a -> NonEmpty a
mergeSorted = mergeSortedBy compare
mergeSortedLists :: Ord a => [a] -> [a] -> [a]
mergeSortedLists = mergeSortedListsBy compare
-- | Given an ordering and two nonempty sequences ordered according to that
-- ordering, merge them
mergeSortedBy :: (a -> a -> Ordering) -> NonEmpty a -> NonEmpty a -> NonEmpty a
mergeSortedBy cmp ls rs = NonEmpty.fromList
$ mergeSortedListsBy cmp (NonEmpty.toList ls) (NonEmpty.toList rs)
-- | Given an ordering and two nonempty sequences ordered according to that
-- ordering, merge them
mergeSortedListsBy :: (a -> a -> Ordering) -> [a] -> [a] -> [a]
mergeSortedListsBy cmp = go
where
go [] ys = ys
go xs [] = xs
go xs@(x:xs') ys@(y:ys') = case x `cmp` y of
LT -> x : go xs' ys
EQ -> x : go xs' ys
GT -> y : go xs ys'