--------------------------------------------------------------------------------
-- |
-- Module      :  HGeometry.Algorithms.DivideAndConquer
-- Copyright   :  (C) Frank Staals
-- License     :  see the LICENSE file
-- Maintainer  :  Frank Staals
--------------------------------------------------------------------------------
module HGeometry.Algorithms.DivideAndConquer(
    divideAndConquer
  , divideAndConquer1
  , divideAndConquer1With

  , mergeSorted, mergeSortedLists
  , mergeSortedBy
  , mergeSortedListsBy
  ) where

import qualified Data.Foldable as F
import           Data.Foldable1
import           Data.List.NonEmpty (NonEmpty(..),(<|))
import qualified Data.List.NonEmpty as NonEmpty
-- import           Data.Semigroup.Foldable

--------------------------------------------------------------------------------

-- | Divide and conquer strategy
--
-- the running time satifies T(n) = 2T(n/2) + M(n),
--
-- where M(n) is the time corresponding to the semigroup operation of s on n elements.
--
--
divideAndConquer1 :: (Foldable1 f, Semigroup s) => (a -> s) -> f a -> s
divideAndConquer1 :: forall (f :: * -> *) s a.
(Foldable1 f, Semigroup s) =>
(a -> s) -> f a -> s
divideAndConquer1 = (s -> s -> s) -> (a -> s) -> f a -> s
forall (f :: * -> *) s a.
Foldable1 f =>
(s -> s -> s) -> (a -> s) -> f a -> s
divideAndConquer1With s -> s -> s
forall a. Semigroup a => a -> a -> a
(<>)

-- | Divide and conquer strategy. See 'divideAndConquer1'.
divideAndConquer   :: (Foldable f, Monoid s) => (a -> s) -> f a -> s
divideAndConquer :: forall (f :: * -> *) s a.
(Foldable f, Monoid s) =>
(a -> s) -> f a -> s
divideAndConquer a -> s
g = s -> (NonEmpty a -> s) -> Maybe (NonEmpty a) -> s
forall b a. b -> (a -> b) -> Maybe a -> b
maybe s
forall a. Monoid a => a
mempty ((a -> s) -> NonEmpty a -> s
forall (f :: * -> *) s a.
(Foldable1 f, Semigroup s) =>
(a -> s) -> f a -> s
divideAndConquer1 a -> s
g) (Maybe (NonEmpty a) -> s)
-> (f a -> Maybe (NonEmpty a)) -> f a -> s
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [a] -> Maybe (NonEmpty a)
forall a. [a] -> Maybe (NonEmpty a)
NonEmpty.nonEmpty ([a] -> Maybe (NonEmpty a))
-> (f a -> [a]) -> f a -> Maybe (NonEmpty a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. f a -> [a]
forall a. f a -> [a]
forall (t :: * -> *) a. Foldable t => t a -> [a]
F.toList

{- HLINT ignore divideAndConquer1With -}
-- | Divide and conquer strategy
--
-- the running time satifies T(n) = 2T(n/2) + M(n),
--
-- where M(n) is the time corresponding to the semigroup operation of s on n elements.
--
divideAndConquer1With         :: Foldable1 f => (s -> s -> s) -> (a -> s) -> f a -> s
divideAndConquer1With :: forall (f :: * -> *) s a.
Foldable1 f =>
(s -> s -> s) -> (a -> s) -> f a -> s
divideAndConquer1With s -> s -> s
(<.>) a -> s
g = (NonEmpty s -> NonEmpty s) -> NonEmpty s -> s
forall {t}. (NonEmpty t -> NonEmpty t) -> NonEmpty t -> t
repeatedly NonEmpty s -> NonEmpty s
merge (NonEmpty s -> s) -> (f a -> NonEmpty s) -> f a -> s
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a -> s) -> NonEmpty a -> NonEmpty s
forall a b. (a -> b) -> NonEmpty a -> NonEmpty b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> s
g (NonEmpty a -> NonEmpty s)
-> (f a -> NonEmpty a) -> f a -> NonEmpty s
forall b c a. (b -> c) -> (a -> b) -> a -> c
. f a -> NonEmpty a
forall a. f a -> NonEmpty a
forall (t :: * -> *) a. Foldable1 t => t a -> NonEmpty a
toNonEmpty
  where
    repeatedly :: (NonEmpty t -> NonEmpty t) -> NonEmpty t -> t
repeatedly NonEmpty t -> NonEmpty t
_ (t
t :| []) = t
t
    repeatedly NonEmpty t -> NonEmpty t
f NonEmpty t
ts        = (NonEmpty t -> NonEmpty t) -> NonEmpty t -> t
repeatedly NonEmpty t -> NonEmpty t
f (NonEmpty t -> t) -> NonEmpty t -> t
forall a b. (a -> b) -> a -> b
$ NonEmpty t -> NonEmpty t
f NonEmpty t
ts

    merge :: NonEmpty s -> NonEmpty s
merge ts :: NonEmpty s
ts@(s
_ :| [])  = NonEmpty s
ts
    merge (s
l :| s
r : []) = s
l s -> s -> s
<.> s
r s -> [s] -> NonEmpty s
forall a. a -> [a] -> NonEmpty a
:| []
    merge (s
l :| s
r : [s]
ts) = s
l s -> s -> s
<.> s
r s -> NonEmpty s -> NonEmpty s
forall a. a -> NonEmpty a -> NonEmpty a
<| NonEmpty s -> NonEmpty s
merge ([s] -> NonEmpty s
forall a. HasCallStack => [a] -> NonEmpty a
NonEmpty.fromList [s]
ts)


--------------------------------------------------------------------------------
-- * Merging NonEmpties/Sorted lists

-- | Merges two sorted non-Empty lists in linear time.
mergeSorted :: Ord a => NonEmpty a -> NonEmpty a -> NonEmpty a
mergeSorted :: forall a. Ord a => NonEmpty a -> NonEmpty a -> NonEmpty a
mergeSorted = (a -> a -> Ordering) -> NonEmpty a -> NonEmpty a -> NonEmpty a
forall a.
(a -> a -> Ordering) -> NonEmpty a -> NonEmpty a -> NonEmpty a
mergeSortedBy a -> a -> Ordering
forall a. Ord a => a -> a -> Ordering
compare

-- | Merges two sorted lists in linear time.
mergeSortedLists :: Ord a => [a] -> [a] -> [a]
mergeSortedLists :: forall a. Ord a => [a] -> [a] -> [a]
mergeSortedLists = (a -> a -> Ordering) -> [a] -> [a] -> [a]
forall a. (a -> a -> Ordering) -> [a] -> [a] -> [a]
mergeSortedListsBy a -> a -> Ordering
forall a. Ord a => a -> a -> Ordering
compare

-- | Given an ordering and two nonempty sequences ordered according to that
-- ordering, merge them.
--
-- running time: \(O(n*T)\), where \(n\) is the length of the list,
-- and \(T\) the time required to compare two elements.
mergeSortedBy           :: (a -> a -> Ordering) -> NonEmpty a -> NonEmpty a -> NonEmpty a
mergeSortedBy :: forall a.
(a -> a -> Ordering) -> NonEmpty a -> NonEmpty a -> NonEmpty a
mergeSortedBy a -> a -> Ordering
cmp NonEmpty a
ls NonEmpty a
rs = [a] -> NonEmpty a
forall a. HasCallStack => [a] -> NonEmpty a
NonEmpty.fromList
                        ([a] -> NonEmpty a) -> [a] -> NonEmpty a
forall a b. (a -> b) -> a -> b
$ (a -> a -> Ordering) -> [a] -> [a] -> [a]
forall a. (a -> a -> Ordering) -> [a] -> [a] -> [a]
mergeSortedListsBy a -> a -> Ordering
cmp (NonEmpty a -> [a]
forall a. NonEmpty a -> [a]
NonEmpty.toList NonEmpty a
ls) (NonEmpty a -> [a]
forall a. NonEmpty a -> [a]
NonEmpty.toList NonEmpty a
rs)

-- | Given an ordering and two nonempty sequences ordered according to that
-- ordering, merge them
--
-- running time: \(O(n*T)\), where \(n\) is the length of the list,
-- and \(T\) the time required to compare two elements.
mergeSortedListsBy     :: (a -> a -> Ordering) -> [a] -> [a] -> [a]
mergeSortedListsBy :: forall a. (a -> a -> Ordering) -> [a] -> [a] -> [a]
mergeSortedListsBy a -> a -> Ordering
cmp = [a] -> [a] -> [a]
go
  where
    go :: [a] -> [a] -> [a]
go []         [a]
ys     = [a]
ys
    go [a]
xs         []     = [a]
xs
    go xs :: [a]
xs@(a
x:[a]
xs') ys :: [a]
ys@(a
y:[a]
ys') = case a
x a -> a -> Ordering
`cmp` a
y of
                                 Ordering
LT -> a
x a -> [a] -> [a]
forall a. a -> [a] -> [a]
: [a] -> [a] -> [a]
go [a]
xs' [a]
ys
                                 Ordering
EQ -> a
x a -> [a] -> [a]
forall a. a -> [a] -> [a]
: [a] -> [a] -> [a]
go [a]
xs' [a]
ys
                                 Ordering
GT -> a
y a -> [a] -> [a]
forall a. a -> [a] -> [a]
: [a] -> [a] -> [a]
go [a]
xs  [a]
ys'