--------------------------------------------------------------------------------
-- |
-- Module      :  HGeometry.CircularList.Util
-- Copyright   :  (C) Frank Staals
-- License     :  see the LICENSE file
-- Maintainer  :  Frank Staals
--------------------------------------------------------------------------------
module HGeometry.CircularList.Util where

import           Control.Lens
import qualified Data.CircularList as C
import qualified Data.List as List
import qualified Data.List.NonEmpty as NonEmpty
import           Data.List.NonEmpty (NonEmpty(..))
import           Data.Tuple


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

-- $setup
-- >>> let ordList = C.fromList [5,6,10,20,30,1,2,3]



-- | Given a circular list, whose elements are in increasing order, insert the
-- new element into the Circular list in its sorted order.
--
-- >>> insertOrd 1 C.empty
-- fromList [1]
-- >>> insertOrd 1 $ C.fromList [2]
-- fromList [2,1]
-- >>> insertOrd 2 $ C.fromList [1,3]
-- fromList [1,2,3]
-- >>> insertOrd 31 ordList
-- fromList [5,6,10,20,30,31,1,2,3]
-- >>> insertOrd 1 ordList
-- fromList [5,6,10,20,30,1,1,2,3]
-- >>> insertOrd 4 ordList
-- fromList [5,6,10,20,30,1,2,3,4]
-- >>> insertOrd 11 ordList
-- fromList [5,6,10,11,20,30,1,2,3]
insertOrd :: Ord a => a -> C.CList a -> C.CList a
insertOrd :: forall a. Ord a => a -> CList a -> CList a
insertOrd = (a -> a -> Ordering) -> a -> CList a -> CList a
forall a. (a -> a -> Ordering) -> a -> CList a -> CList a
insertOrdBy a -> a -> Ordering
forall a. Ord a => a -> a -> Ordering
compare

-- | Insert an element into an increasingly ordered circular list, with
-- specified compare operator.
insertOrdBy       :: (a -> a -> Ordering) -> a -> C.CList a -> C.CList a
insertOrdBy :: forall a. (a -> a -> Ordering) -> a -> CList a -> CList a
insertOrdBy a -> a -> Ordering
cmp a
x = [a] -> CList a
forall a. [a] -> CList a
C.fromList ([a] -> CList a) -> (CList a -> [a]) -> CList a -> CList a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a -> a -> Ordering) -> a -> [a] -> [a]
forall a. (a -> a -> Ordering) -> a -> [a] -> [a]
insertOrdBy' a -> a -> Ordering
cmp a
x ([a] -> [a]) -> (CList a -> [a]) -> CList a -> [a]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CList a -> [a]
forall a. CList a -> [a]
C.rightElements

-- | List version of insertOrdBy; i.e. the list contains the elements in
-- cirulcar order. Again produces a list that has the items in circular order.
insertOrdBy'         :: (a -> a -> Ordering) -> a -> [a] -> [a]
insertOrdBy' :: forall a. (a -> a -> Ordering) -> a -> [a] -> [a]
insertOrdBy' a -> a -> Ordering
cmp a
x [a]
xs = case [a] -> Maybe (NonEmpty a)
forall a. [a] -> Maybe (NonEmpty a)
NonEmpty.nonEmpty [a]
rest of
    Maybe (NonEmpty a)
Nothing      -> (a -> a -> Ordering) -> a -> [a] -> [a]
forall a. (a -> a -> Ordering) -> a -> [a] -> [a]
List.insertBy a -> a -> Ordering
cmp a
x [a]
pref
    Just (a
z:|[a]
zs) -> case a
x a -> a -> Ordering
`cmp` a
z of
                      Ordering
GT -> a
z a -> [a] -> [a]
forall a. a -> [a] -> [a]
: (a -> a -> Ordering) -> a -> [a] -> [a]
forall a. (a -> a -> Ordering) -> a -> [a] -> [a]
List.insertBy a -> a -> Ordering
cmp a
x [a]
zs [a] -> [a] -> [a]
forall a. [a] -> [a] -> [a]
++ [a]
pref
                      Ordering
EQ -> a
x a -> [a] -> [a]
forall a. a -> [a] -> [a]
: [a]
xs -- == x : rest ++ pref
                      Ordering
LT -> [a]
rest [a] -> [a] -> [a]
forall a. [a] -> [a] -> [a]
++ (a -> a -> Ordering) -> a -> [a] -> [a]
forall a. (a -> a -> Ordering) -> a -> [a] -> [a]
List.insertBy a -> a -> Ordering
cmp a
x [a]
pref
  where
    -- split the list at its maximum.
    ([a]
pref,[a]
rest) = (a -> a -> Ordering) -> [a] -> ([a], [a])
forall a. (a -> a -> Ordering) -> [a] -> ([a], [a])
splitIncr a -> a -> Ordering
cmp [a]
xs

-- | Given a list of elements that is supposedly a a cyclic-shift of a list of
-- increasing items, find the splitting point. I.e. returns a pair of lists
-- (ys,zs) such that xs = zs ++ ys, and ys ++ zs is (supposedly) in sorted
-- order.
splitIncr              :: (a -> a -> Ordering) -> [a] -> ([a],[a])
splitIncr :: forall a. (a -> a -> Ordering) -> [a] -> ([a], [a])
splitIncr a -> a -> Ordering
_   []       = ([],[])
splitIncr a -> a -> Ordering
cmp xs :: [a]
xs@(a
x:[a]
_) = ([a], [a]) -> ([a], [a])
forall a b. (a, b) -> (b, a)
swap (([a], [a]) -> ([a], [a]))
-> ([(a, a)] -> ([a], [a])) -> [(a, a)] -> ([a], [a])
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([(a, a)] -> [a])
-> ([(a, a)] -> [a]) -> ([(a, a)], [(a, a)]) -> ([a], [a])
forall a b c d. (a -> b) -> (c -> d) -> (a, c) -> (b, d)
forall (p :: * -> * -> *) a b c d.
Bifunctor p =>
(a -> b) -> (c -> d) -> p a c -> p b d
bimap (((a, a) -> a) -> [(a, a)] -> [a]
forall a b. (a -> b) -> [a] -> [b]
map (a, a) -> a
forall a b. (a, b) -> b
snd) (((a, a) -> a) -> [(a, a)] -> [a]
forall a b. (a -> b) -> [a] -> [b]
map (a, a) -> a
forall a b. (a, b) -> b
snd)
                       (([(a, a)], [(a, a)]) -> ([a], [a]))
-> ([(a, a)] -> ([(a, a)], [(a, a)])) -> [(a, a)] -> ([a], [a])
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((a, a) -> Bool) -> [(a, a)] -> ([(a, a)], [(a, a)])
forall a. (a -> Bool) -> [a] -> ([a], [a])
List.break (\(a
a,a
b) -> (a
a a -> a -> Ordering
`cmp` a
b) Ordering -> Ordering -> Bool
forall a. Eq a => a -> a -> Bool
== Ordering
GT) ([(a, a)] -> ([a], [a])) -> [(a, a)] -> ([a], [a])
forall a b. (a -> b) -> a -> b
$ [a] -> [a] -> [(a, a)]
forall a b. [a] -> [b] -> [(a, b)]
zip (a
xa -> [a] -> [a]
forall a. a -> [a] -> [a]
:[a]
xs) [a]
xs

-- | Test if the circular list is a cyclic shift of the second list.
-- Running time: O(n), where n is the size of the smallest list
isShiftOf         :: Eq a => C.CList a -> C.CList a -> Bool
CList a
xs isShiftOf :: forall a. Eq a => CList a -> CList a -> Bool
`isShiftOf` CList a
ys = let rest :: CList a -> [a]
rest = CList a -> [a]
forall a. CList a -> [a]
C.leftElements
                    in Bool -> (CList a -> Bool) -> Maybe (CList a) -> Bool
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Bool
False (\CList a
xs' -> CList a -> [a]
forall a. CList a -> [a]
rest CList a
xs' [a] -> [a] -> Bool
forall a. Eq a => a -> a -> Bool
== CList a -> [a]
forall a. CList a -> [a]
rest CList a
ys) (Maybe (CList a) -> Bool) -> Maybe (CList a) -> Bool
forall a b. (a -> b) -> a -> b
$
                         CList a -> Maybe a
forall a. CList a -> Maybe a
C.focus CList a
ys Maybe a -> (a -> Maybe (CList a)) -> Maybe (CList a)
forall a b. Maybe a -> (a -> Maybe b) -> Maybe b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (a -> CList a -> Maybe (CList a))
-> CList a -> a -> Maybe (CList a)
forall a b c. (a -> b -> c) -> b -> a -> c
flip a -> CList a -> Maybe (CList a)
forall a. Eq a => a -> CList a -> Maybe (CList a)
C.rotateTo CList a
xs