--------------------------------------------------------------------------------
-- |
-- Module      :  Data.CircularSeq
-- Copyright   :  (C) Frank Staals
-- License     :  see the LICENSE file
-- Maintainer  :  Frank Staals
--------------------------------------------------------------------------------
module Data.CircularSeq( CSeq
                       , cseq
                       , singleton
                       , fromNonEmpty
                       , fromList

                       , focus
                       , index, adjust
                       , item

                       , rotateL
                       , rotateR
                       , rotateNL, rotateNR

                       , rightElements
                       , leftElements
                       , asSeq
                       , withIndices

                       , reverseDirection
                       , allRotations

                       , findRotateTo
                       , rotateTo

                       , zipLWith, zipL
                       , zip3LWith


                       , insertOrd, insertOrdBy
                       , isShiftOf
                       ) where

import           Algorithms.StringSearch.KMP (isSubStringOf)
import           Control.DeepSeq
import           Control.Lens (Lens', bimap, lens)
import           Data.Ext
import qualified Data.Foldable as F
import qualified Data.List as L
import qualified Data.List.NonEmpty as NonEmpty
import           Data.Maybe (isJust)
import           Data.Semigroup.Foldable
import           Data.Sequence               (Seq, ViewL (..), ViewR (..), (<|),
                                              (|>))
import qualified Data.Sequence as S
import qualified Data.Traversable as T
import           Data.Tuple (swap)
import           GHC.Generics (Generic)
import           Test.QuickCheck (Arbitrary (..))
import           Test.QuickCheck.Instances ()

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

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


-- | Nonempty circular sequence
data CSeq a = CSeq !(Seq a) !a !(Seq a)
  deriving ((forall x. CSeq a -> Rep (CSeq a) x)
-> (forall x. Rep (CSeq a) x -> CSeq a) -> Generic (CSeq a)
forall x. Rep (CSeq a) x -> CSeq a
forall x. CSeq a -> Rep (CSeq a) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall a x. Rep (CSeq a) x -> CSeq a
forall a x. CSeq a -> Rep (CSeq a) x
$cto :: forall a x. Rep (CSeq a) x -> CSeq a
$cfrom :: forall a x. CSeq a -> Rep (CSeq a) x
Generic)
                     -- we keep the seq balanced, i.e. size left >= size right

instance NFData a => NFData (CSeq a)

instance Eq a => Eq (CSeq a) where
  CSeq a
a == :: CSeq a -> CSeq a -> Bool
== CSeq a
b = CSeq a -> Seq a
forall a. CSeq a -> Seq a
asSeq CSeq a
a Seq a -> Seq a -> Bool
forall a. Eq a => a -> a -> Bool
== CSeq a -> Seq a
forall a. CSeq a -> Seq a
asSeq CSeq a
b

instance Show a => Show (CSeq a) where
  showsPrec :: Int -> CSeq a -> ShowS
showsPrec Int
d CSeq a
s = Bool -> ShowS -> ShowS
showParen (Int
d Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
app_prec) (ShowS -> ShowS) -> ShowS -> ShowS
forall a b. (a -> b) -> a -> b
$
                    String -> ShowS
showString ((String
"CSeq " String -> ShowS
forall a. Semigroup a => a -> a -> a
<>) ShowS -> (CSeq a -> String) -> CSeq a -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [a] -> String
forall a. Show a => a -> String
show ([a] -> String) -> (CSeq a -> [a]) -> CSeq a -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Seq a -> [a]
forall (t :: * -> *) a. Foldable t => t a -> [a]
F.toList (Seq a -> [a]) -> (CSeq a -> Seq a) -> CSeq a -> [a]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CSeq a -> Seq a
forall a. CSeq a -> Seq a
rightElements (CSeq a -> String) -> CSeq a -> String
forall a b. (a -> b) -> a -> b
$ CSeq a
s)
    where app_prec :: Int
app_prec = Int
10

instance Read a => Read (CSeq a) where
  readsPrec :: Int -> ReadS (CSeq a)
readsPrec Int
d = Bool -> ReadS (CSeq a) -> ReadS (CSeq a)
forall a. Bool -> ReadS a -> ReadS a
readParen (Int
d Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
app_prec) (ReadS (CSeq a) -> ReadS (CSeq a))
-> ReadS (CSeq a) -> ReadS (CSeq a)
forall a b. (a -> b) -> a -> b
$ \String
r ->
      [ ([a] -> CSeq a
forall a. [a] -> CSeq a
fromList [a]
lst, String
t) | (String
"CSeq", String
s) <- ReadS String
lex String
r, ([a]
lst, String
t) <- ReadS [a]
forall a. Read a => ReadS a
reads String
s ]
    where app_prec :: Int
app_prec = Int
10

-- traverses starting at the focus, going to the right.
instance T.Traversable CSeq where
  traverse :: (a -> f b) -> CSeq a -> f (CSeq b)
traverse a -> f b
f (CSeq Seq a
l a
x Seq a
r) = (\b
x' Seq b
r' Seq b
l' -> Seq b -> b -> Seq b -> CSeq b
forall a. Seq a -> a -> Seq a -> CSeq a
CSeq Seq b
l' b
x' Seq b
r')
                         (b -> Seq b -> Seq b -> CSeq b)
-> f b -> f (Seq b -> Seq b -> CSeq b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> a -> f b
f a
x f (Seq b -> Seq b -> CSeq b) -> f (Seq b) -> f (Seq b -> CSeq b)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (a -> f b) -> Seq a -> f (Seq b)
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse a -> f b
f Seq a
r f (Seq b -> CSeq b) -> f (Seq b) -> f (CSeq b)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (a -> f b) -> Seq a -> f (Seq b)
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse a -> f b
f Seq a
l
-- instance Traversable1 CSeq where
--   traverse1 f (CSeq l x r) = liftF3 (\x' r' l' -> CSeq l' x' r')
--                                     (f x) (traverse f r) (traverse f l)

instance Foldable1 CSeq

instance F.Foldable CSeq where
  foldMap :: (a -> m) -> CSeq a -> m
foldMap = (a -> m) -> CSeq a -> m
forall (t :: * -> *) m a.
(Traversable t, Monoid m) =>
(a -> m) -> t a -> m
T.foldMapDefault
  length :: CSeq a -> Int
length (CSeq Seq a
l a
_ Seq a
r) = Int
1 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Seq a -> Int
forall a. Seq a -> Int
S.length Seq a
l Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Seq a -> Int
forall a. Seq a -> Int
S.length Seq a
r

instance Functor CSeq where
  fmap :: (a -> b) -> CSeq a -> CSeq b
fmap = (a -> b) -> CSeq a -> CSeq b
forall (t :: * -> *) a b. Traversable t => (a -> b) -> t a -> t b
T.fmapDefault

instance Arbitrary a => Arbitrary (CSeq a) where
  arbitrary :: Gen (CSeq a)
arbitrary = Seq a -> a -> Seq a -> CSeq a
forall a. Seq a -> a -> Seq a -> CSeq a
CSeq (Seq a -> a -> Seq a -> CSeq a)
-> Gen (Seq a) -> Gen (a -> Seq a -> CSeq a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Gen (Seq a)
forall a. Arbitrary a => Gen a
arbitrary Gen (a -> Seq a -> CSeq a) -> Gen a -> Gen (Seq a -> CSeq a)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Gen a
forall a. Arbitrary a => Gen a
arbitrary Gen (Seq a -> CSeq a) -> Gen (Seq a) -> Gen (CSeq a)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Gen (Seq a)
forall a. Arbitrary a => Gen a
arbitrary

-- | /O(1)/ CSeq with exactly one element.
singleton   :: a -> CSeq a
singleton :: a -> CSeq a
singleton a
x = Seq a -> a -> Seq a -> CSeq a
forall a. Seq a -> a -> Seq a -> CSeq a
CSeq Seq a
forall a. Seq a
S.empty a
x Seq a
forall a. Seq a
S.empty

-- | Gets the focus of the CSeq.
--
-- running time: O(1)
focus              :: CSeq a -> a
focus :: CSeq a -> a
focus (CSeq Seq a
_ a
x Seq a
_) = a
x

-- | Access the i^th item (w.r.t the focus; elements numbered in
-- increasing order towards the right) in the CSeq (indices modulo n).
--
-- running time: \(O(\log (i \mod n))\)
--
-- >>> index (fromList [0..5]) 1
-- 1
-- >>> index (fromList [0..5]) 2
-- 2
-- >>> index (fromList [0..5]) 5
-- 5
-- >>> index (fromList [0..5]) 10
-- 4
-- >>> index (fromList [0..5]) 6
-- 0
-- >>> index (fromList [0..5]) (-1)
-- 5
-- >>> index (fromList [0..5]) (-6)
-- 0
index                   :: CSeq a -> Int -> a
index :: CSeq a -> Int -> a
index s :: CSeq a
s@(CSeq Seq a
l a
x Seq a
r) Int
i' = let i :: Int
i  = Int
i' Int -> Int -> Int
forall a. Integral a => a -> a -> a
`mod` CSeq a -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length CSeq a
s
                              rn :: Int
rn = Seq a -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length Seq a
r
                          in if Int
i Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
0 then a
x
                               else if Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1 Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
rn then Seq a -> Int -> a
forall a. Seq a -> Int -> a
S.index Seq a
r (Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1)
                                                  else Seq a -> Int -> a
forall a. Seq a -> Int -> a
S.index Seq a
l (Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
rn Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1)

-- | Label the elements with indices.
--
-- >>> withIndices $ fromList [0..5]
-- CSeq [0 :+ 0,1 :+ 1,2 :+ 2,3 :+ 3,4 :+ 4,5 :+ 5]
withIndices              :: CSeq a -> CSeq (Int :+ a)
withIndices :: CSeq a -> CSeq (Int :+ a)
withIndices (CSeq Seq a
l a
x Seq a
r) = let s :: Int
s = Int
1 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Seq a -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length Seq a
r in
  Seq (Int :+ a) -> (Int :+ a) -> Seq (Int :+ a) -> CSeq (Int :+ a)
forall a. Seq a -> a -> Seq a -> CSeq a
CSeq ((Int -> a -> Int :+ a) -> Seq a -> Seq (Int :+ a)
forall a b. (Int -> a -> b) -> Seq a -> Seq b
S.mapWithIndex (\Int
i a
y -> Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
s Int -> a -> Int :+ a
forall core extra. core -> extra -> core :+ extra
:+ a
y) Seq a
l) (Int
0 Int -> a -> Int :+ a
forall core extra. core -> extra -> core :+ extra
:+ a
x) ((Int -> a -> Int :+ a) -> Seq a -> Seq (Int :+ a)
forall a b. (Int -> a -> b) -> Seq a -> Seq b
S.mapWithIndex (\Int
i a
y -> Int
iInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
1 Int -> a -> Int :+ a
forall core extra. core -> extra -> core :+ extra
:+ a
y) Seq a
r)


-- | Adjusts the i^th element w.r.t the focus in the CSeq
--
-- running time: \(O(\log (i \mod n))\)
--
-- >>> adjust (const 1000) 2 (fromList [0..5])
-- CSeq [0,1,1000,3,4,5]
adjust                     :: (a -> a) -> Int -> CSeq a -> CSeq a
adjust :: (a -> a) -> Int -> CSeq a -> CSeq a
adjust a -> a
f Int
i' s :: CSeq a
s@(CSeq Seq a
l a
x Seq a
r) = let i :: Int
i  = Int
i' Int -> Int -> Int
forall a. Integral a => a -> a -> a
`mod` CSeq a -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length CSeq a
s
                                 rn :: Int
rn = Seq a -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length Seq a
r
                             in if Int
i Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
0 then Seq a -> a -> Seq a -> CSeq a
forall a. Seq a -> a -> Seq a -> CSeq a
CSeq Seq a
l (a -> a
f a
x) Seq a
r
                                else if Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1 Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
rn
                                     then Seq a -> a -> Seq a -> CSeq a
forall a. Seq a -> a -> Seq a -> CSeq a
CSeq Seq a
l                           a
x ((a -> a) -> Int -> Seq a -> Seq a
forall a. (a -> a) -> Int -> Seq a -> Seq a
S.adjust a -> a
f (Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1) Seq a
r)
                                     else Seq a -> a -> Seq a -> CSeq a
forall a. Seq a -> a -> Seq a -> CSeq a
CSeq ((a -> a) -> Int -> Seq a -> Seq a
forall a. (a -> a) -> Int -> Seq a -> Seq a
S.adjust a -> a
f (Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
rn Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1) Seq a
l) a
x Seq a
r


-- | Access the ith item in the CSeq (w.r.t the focus) as a lens
item   :: Int -> Lens' (CSeq a) a
item :: Int -> Lens' (CSeq a) a
item Int
i = (CSeq a -> a) -> (CSeq a -> a -> CSeq a) -> Lens' (CSeq a) a
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
lens (CSeq a -> Int -> a
forall a. CSeq a -> Int -> a
`index` Int
i) (\CSeq a
s a
x -> (a -> a) -> Int -> CSeq a -> CSeq a
forall a. (a -> a) -> Int -> CSeq a -> CSeq a
adjust (a -> a -> a
forall a b. a -> b -> a
const a
x) Int
i CSeq a
s)


resplit   :: Seq a -> (Seq a, Seq a)
resplit :: Seq a -> (Seq a, Seq a)
resplit Seq a
s = (Seq a, Seq a) -> (Seq a, Seq a)
forall a b. (a, b) -> (b, a)
swap ((Seq a, Seq a) -> (Seq a, Seq a))
-> (Seq a, Seq a) -> (Seq a, Seq a)
forall a b. (a -> b) -> a -> b
$ Int -> Seq a -> (Seq a, Seq a)
forall a. Int -> Seq a -> (Seq a, Seq a)
S.splitAt (Seq a -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length Seq a
s Int -> Int -> Int
forall a. Integral a => a -> a -> a
`div` Int
2) Seq a
s


-- | smart constructor that automatically balances the seq
cseq                   :: Seq a -> a -> Seq a -> CSeq a
cseq :: Seq a -> a -> Seq a -> CSeq a
cseq Seq a
l a
x Seq a
r
    | Int
ln Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
1 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
2Int -> Int -> Int
forall a. Num a => a -> a -> a
*Int
rn    = a -> Seq a -> CSeq a
forall a. a -> Seq a -> CSeq a
withFocus a
x (Seq a
r Seq a -> Seq a -> Seq a
forall a. Semigroup a => a -> a -> a
<> Seq a
l)
    | Int
ln Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
rn Int -> Int -> Int
forall a. Integral a => a -> a -> a
`div`  Int
2 = a -> Seq a -> CSeq a
forall a. a -> Seq a -> CSeq a
withFocus a
x (Seq a
r Seq a -> Seq a -> Seq a
forall a. Semigroup a => a -> a -> a
<> Seq a
l)
    | Bool
otherwise        = Seq a -> a -> Seq a -> CSeq a
forall a. Seq a -> a -> Seq a -> CSeq a
CSeq Seq a
l a
x Seq a
r
  where
    rn :: Int
rn = Seq a -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length Seq a
r
    ln :: Int
ln = Seq a -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length Seq a
l

-- smart constructor that automatically balances the sequence.
-- pre: at least one of the two seq's is NonEmpty
--
cseq'     :: Seq a -> Seq a -> CSeq a
cseq' :: Seq a -> Seq a -> CSeq a
cseq' Seq a
l Seq a
r = case Seq a -> ViewL a
forall a. Seq a -> ViewL a
S.viewl Seq a
r of
              (a
x :< Seq a
r') -> Seq a -> a -> Seq a -> CSeq a
forall a. Seq a -> a -> Seq a -> CSeq a
cseq Seq a
l a
x Seq a
r'
              ViewL a
EmptyL    -> let (a
x :< Seq a
l') = Seq a -> ViewL a
forall a. Seq a -> ViewL a
S.viewl Seq a
l in Seq a -> a -> Seq a -> CSeq a
forall a. Seq a -> a -> Seq a -> CSeq a
cseq Seq a
l' a
x Seq a
r

-- | Builds a balanced seq with the element as the focus.
withFocus     :: a -> Seq a -> CSeq a
withFocus :: a -> Seq a -> CSeq a
withFocus a
x Seq a
s = let (Seq a
l,Seq a
r) = Seq a -> (Seq a, Seq a)
forall a. Seq a -> (Seq a, Seq a)
resplit Seq a
s in Seq a -> a -> Seq a -> CSeq a
forall a. Seq a -> a -> Seq a -> CSeq a
CSeq Seq a
l a
x Seq a
r

-- | rotates one to the right
--
-- running time: O(1) (amortized)
--
-- >>> rotateR $ fromList [3,4,5,1,2]
-- CSeq [4,5,1,2,3]
rotateR                :: CSeq a -> CSeq a
rotateR :: CSeq a -> CSeq a
rotateR s :: CSeq a
s@(CSeq Seq a
l a
x Seq a
r) = case Seq a -> ViewL a
forall a. Seq a -> ViewL a
S.viewl Seq a
r of
                           ViewL a
EmptyL    -> case Seq a -> ViewL a
forall a. Seq a -> ViewL a
S.viewl Seq a
l of
                             ViewL a
EmptyL    -> CSeq a
s
                             (a
y :< Seq a
l') -> Seq a -> a -> Seq a -> CSeq a
forall a. Seq a -> a -> Seq a -> CSeq a
cseq (a -> Seq a
forall a. a -> Seq a
S.singleton a
x) a
y Seq a
l'
                           (a
y :< Seq a
r') -> Seq a -> a -> Seq a -> CSeq a
forall a. Seq a -> a -> Seq a -> CSeq a
cseq (Seq a
l Seq a -> a -> Seq a
forall a. Seq a -> a -> Seq a
|> a
x) a
y Seq a
r'

-- | rotates the focus to the left
--
-- running time: O(1) (amortized)
--
-- >>> rotateL $ fromList [3,4,5,1,2]
-- CSeq [2,3,4,5,1]
-- >>> mapM_ print . take 5 $ iterate rotateL $ fromList [1..5]
-- CSeq [1,2,3,4,5]
-- CSeq [5,1,2,3,4]
-- CSeq [4,5,1,2,3]
-- CSeq [3,4,5,1,2]
-- CSeq [2,3,4,5,1]
rotateL                :: CSeq a -> CSeq a
rotateL :: CSeq a -> CSeq a
rotateL s :: CSeq a
s@(CSeq Seq a
l a
x Seq a
r) = case Seq a -> ViewR a
forall a. Seq a -> ViewR a
S.viewr Seq a
l of
                           ViewR a
EmptyR    -> case Seq a -> ViewR a
forall a. Seq a -> ViewR a
S.viewr Seq a
r of
                             ViewR a
EmptyR    -> CSeq a
s
                             (Seq a
r' :> a
y) -> Seq a -> a -> Seq a -> CSeq a
forall a. Seq a -> a -> Seq a -> CSeq a
cseq Seq a
r' a
y (a -> Seq a
forall a. a -> Seq a
S.singleton a
x)
                           (Seq a
l' :> a
y) -> Seq a -> a -> Seq a -> CSeq a
forall a. Seq a -> a -> Seq a -> CSeq a
cseq Seq a
l' a
y (a
x a -> Seq a -> Seq a
forall a. a -> Seq a -> Seq a
<| Seq a
r)


-- | Convert to a single Seq, starting with the focus.
asSeq :: CSeq a -> Seq a
asSeq :: CSeq a -> Seq a
asSeq = CSeq a -> Seq a
forall a. CSeq a -> Seq a
rightElements


-- | All elements, starting with the focus, going to the right

-- >>> rightElements $ fromList [3,4,5,1,2]
-- fromList [3,4,5,1,2]
rightElements              :: CSeq a -> Seq a
rightElements :: CSeq a -> Seq a
rightElements (CSeq Seq a
l a
x Seq a
r) = a
x a -> Seq a -> Seq a
forall a. a -> Seq a -> Seq a
<| Seq a
r Seq a -> Seq a -> Seq a
forall a. Semigroup a => a -> a -> a
<> Seq a
l


-- | All elements, starting with the focus, going to the left
--
-- >>> leftElements $ fromList [3,4,5,1,2]
-- fromList [3,2,1,5,4]
leftElements              :: CSeq a -> Seq a
leftElements :: CSeq a -> Seq a
leftElements (CSeq Seq a
l a
x Seq a
r) = a
x a -> Seq a -> Seq a
forall a. a -> Seq a -> Seq a
<| Seq a -> Seq a
forall a. Seq a -> Seq a
S.reverse Seq a
l Seq a -> Seq a -> Seq a
forall a. Semigroup a => a -> a -> a
<> Seq a -> Seq a
forall a. Seq a -> Seq a
S.reverse Seq a
r

-- | builds a CSeq
fromNonEmpty                    :: NonEmpty.NonEmpty a -> CSeq a
fromNonEmpty :: NonEmpty a -> CSeq a
fromNonEmpty (a
x NonEmpty.:| [a]
xs) = a -> Seq a -> CSeq a
forall a. a -> Seq a -> CSeq a
withFocus a
x (Seq a -> CSeq a) -> Seq a -> CSeq a
forall a b. (a -> b) -> a -> b
$ [a] -> Seq a
forall a. [a] -> Seq a
S.fromList [a]
xs

{- HLINT ignore fromList -}
-- | /O(n)/ Convert from a list to a CSeq.
--
-- Warning: the onus is on the user to ensure that their list
-- is not empty, otherwise all bets are off!
fromList        :: [a] -> CSeq a
fromList :: [a] -> CSeq a
fromList (a
x:[a]
xs) = a -> Seq a -> CSeq a
forall a. a -> Seq a -> CSeq a
withFocus a
x (Seq a -> CSeq a) -> Seq a -> CSeq a
forall a b. (a -> b) -> a -> b
$ [a] -> Seq a
forall a. [a] -> Seq a
S.fromList [a]
xs
fromList []     = String -> CSeq a
forall a. HasCallStack => String -> a
error String
"fromList: Empty list"

-- | Rotates i elements to the right.
--
-- pre: 0 <= i < n
--
-- running time: \(O(\log i)\) amortized
--
-- >>> rotateNR 0 $ fromList [1..5]
-- CSeq [1,2,3,4,5]
-- >>> rotateNR 1 $ fromList [1..5]
-- CSeq [2,3,4,5,1]
-- >>> rotateNR 4 $ fromList [1..5]
-- CSeq [5,1,2,3,4]
rotateNR   :: Int -> CSeq a -> CSeq a
rotateNR :: Int -> CSeq a -> CSeq a
rotateNR Int
i = (Seq a -> Seq a -> CSeq a) -> (Seq a, Seq a) -> CSeq a
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry Seq a -> Seq a -> CSeq a
forall a. Seq a -> Seq a -> CSeq a
cseq' ((Seq a, Seq a) -> CSeq a)
-> (CSeq a -> (Seq a, Seq a)) -> CSeq a -> CSeq a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Seq a -> (Seq a, Seq a)
forall a. Int -> Seq a -> (Seq a, Seq a)
S.splitAt Int
i (Seq a -> (Seq a, Seq a))
-> (CSeq a -> Seq a) -> CSeq a -> (Seq a, Seq a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CSeq a -> Seq a
forall a. CSeq a -> Seq a
rightElements

-- | Rotates i elements to the left.
--
-- pre: 0 <= i < n
--
-- running time: \(O(\log i)\) amoritzed
--
-- >>> rotateNL 0 $ fromList [1..5]
-- CSeq [1,2,3,4,5]
-- >>> rotateNL 1 $ fromList [1..5]
-- CSeq [5,1,2,3,4]
-- >>> rotateNL 2 $ fromList [1..5]
-- CSeq [4,5,1,2,3]
-- >>> rotateNL 3 $ fromList [1..5]
-- CSeq [3,4,5,1,2]
-- >>> rotateNL 4 $ fromList [1..5]
-- CSeq [2,3,4,5,1]
rotateNL     :: Int -> CSeq a -> CSeq a
rotateNL :: Int -> CSeq a -> CSeq a
rotateNL Int
i CSeq a
s = let (a
x :< Seq a
xs) = Seq a -> ViewL a
forall a. Seq a -> ViewL a
S.viewl (Seq a -> ViewL a) -> Seq a -> ViewL a
forall a b. (a -> b) -> a -> b
$ CSeq a -> Seq a
forall a. CSeq a -> Seq a
rightElements CSeq a
s
                   (Seq a
l',Seq a
r)    = Int -> Seq a -> (Seq a, Seq a)
forall a. Int -> Seq a -> (Seq a, Seq a)
S.splitAt (CSeq a -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length CSeq a
s Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
i) (Seq a -> (Seq a, Seq a)) -> Seq a -> (Seq a, Seq a)
forall a b. (a -> b) -> a -> b
$ Seq a
xs Seq a -> a -> Seq a
forall a. Seq a -> a -> Seq a
|> a
x
               in case Seq a -> ViewR a
forall a. Seq a -> ViewR a
S.viewr Seq a
l' of
                    Seq a
l :> a
y   -> Seq a -> a -> Seq a -> CSeq a
forall a. Seq a -> a -> Seq a -> CSeq a
cseq Seq a
l a
y Seq a
r
                    ViewR a
S.EmptyR -> let (a
y :< Seq a
r') = Seq a -> ViewL a
forall a. Seq a -> ViewL a
S.viewl Seq a
r in Seq a -> a -> Seq a -> CSeq a
forall a. Seq a -> a -> Seq a -> CSeq a
cseq Seq a
l' a
y Seq a
r'


-- | Reverses the direction of the CSeq
--
-- running time: \(O(n)\)
--
-- >>> reverseDirection $ fromList [1..5]
-- CSeq [1,5,4,3,2]
reverseDirection              :: CSeq a -> CSeq a
reverseDirection :: CSeq a -> CSeq a
reverseDirection (CSeq Seq a
l a
x Seq a
r) = Seq a -> a -> Seq a -> CSeq a
forall a. Seq a -> a -> Seq a -> CSeq a
CSeq (Seq a -> Seq a
forall a. Seq a -> Seq a
S.reverse Seq a
r) a
x (Seq a -> Seq a
forall a. Seq a -> Seq a
S.reverse Seq a
l)


-- | Finds an element in the CSeq
--
-- >>> findRotateTo (== 3) $ fromList [1..5]
-- Just (CSeq [3,4,5,1,2])
-- >>> findRotateTo (== 7) $ fromList [1..5]
-- Nothing
findRotateTo   :: (a -> Bool) -> CSeq a -> Maybe (CSeq a)
findRotateTo :: (a -> Bool) -> CSeq a -> Maybe (CSeq a)
findRotateTo a -> Bool
p = (CSeq a -> Bool) -> [CSeq a] -> Maybe (CSeq a)
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Maybe a
L.find (a -> Bool
p (a -> Bool) -> (CSeq a -> a) -> CSeq a -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CSeq a -> a
forall a. CSeq a -> a
focus) ([CSeq a] -> Maybe (CSeq a))
-> (CSeq a -> [CSeq a]) -> CSeq a -> Maybe (CSeq a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CSeq a -> [CSeq a]
forall a. CSeq a -> [CSeq a]
allRotations'

-- | Rotate to a specific element in the CSeq.
rotateTo   :: Eq a => a -> CSeq a -> Maybe (CSeq a)
rotateTo :: a -> CSeq a -> Maybe (CSeq a)
rotateTo a
x = (a -> Bool) -> CSeq a -> Maybe (CSeq a)
forall a. (a -> Bool) -> CSeq a -> Maybe (CSeq a)
findRotateTo (a -> a -> Bool
forall a. Eq a => a -> a -> Bool
== a
x)


-- | All rotations, the input CSeq is the focus.
--
-- >>> mapM_ print . allRotations $ fromList [1..5]
-- CSeq [1,2,3,4,5]
-- CSeq [2,3,4,5,1]
-- CSeq [3,4,5,1,2]
-- CSeq [4,5,1,2,3]
-- CSeq [5,1,2,3,4]
allRotations :: CSeq a -> CSeq (CSeq a)
allRotations :: CSeq a -> CSeq (CSeq a)
allRotations = [CSeq a] -> CSeq (CSeq a)
forall a. [a] -> CSeq a
fromList ([CSeq a] -> CSeq (CSeq a))
-> (CSeq a -> [CSeq a]) -> CSeq a -> CSeq (CSeq a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CSeq a -> [CSeq a]
forall a. CSeq a -> [CSeq a]
allRotations'

allRotations'   :: CSeq a -> [CSeq a]
allRotations' :: CSeq a -> [CSeq a]
allRotations' CSeq a
s = Int -> [CSeq a] -> [CSeq a]
forall a. Int -> [a] -> [a]
take (CSeq a -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length CSeq a
s) ([CSeq a] -> [CSeq a])
-> (CSeq a -> [CSeq a]) -> CSeq a -> [CSeq a]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (CSeq a -> CSeq a) -> CSeq a -> [CSeq a]
forall a. (a -> a) -> a -> [a]
iterate CSeq a -> CSeq a
forall a. CSeq a -> CSeq a
rotateR (CSeq a -> [CSeq a]) -> CSeq a -> [CSeq a]
forall a b. (a -> b) -> a -> b
$ CSeq a
s

-- | "Left zip": zip the two CLists, pairing up every element in the *left*
-- list with its corresponding element in the right list. If there are more
-- items in the right clist they are discarded.
zipLWith         :: (a -> b -> c) -> CSeq a -> CSeq b -> CSeq c
zipLWith :: (a -> b -> c) -> CSeq a -> CSeq b -> CSeq c
zipLWith a -> b -> c
f CSeq a
as CSeq b
bs = [c] -> CSeq c
forall a. [a] -> CSeq a
fromList ([c] -> CSeq c) -> [c] -> CSeq c
forall a b. (a -> b) -> a -> b
$ (a -> b -> c) -> [a] -> [b] -> [c]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith a -> b -> c
f (CSeq a -> [a]
forall (t :: * -> *) a. Foldable t => t a -> [a]
F.toList CSeq a
as) (CSeq b -> [b]
forall (t :: * -> *) a. Foldable t => t a -> [a]
F.toList CSeq b
bs)

-- | see 'zipLWith
zipL :: CSeq a -> CSeq b -> CSeq (a, b)
zipL :: CSeq a -> CSeq b -> CSeq (a, b)
zipL = (a -> b -> (a, b)) -> CSeq a -> CSeq b -> CSeq (a, b)
forall a b c. (a -> b -> c) -> CSeq a -> CSeq b -> CSeq c
zipLWith (,)


-- | same as zipLWith but with three items
zip3LWith            :: (a -> b -> c -> d) -> CSeq a -> CSeq b -> CSeq c -> CSeq d
zip3LWith :: (a -> b -> c -> d) -> CSeq a -> CSeq b -> CSeq c -> CSeq d
zip3LWith a -> b -> c -> d
f CSeq a
as CSeq b
bs CSeq c
cs = [d] -> CSeq d
forall a. [a] -> CSeq a
fromList ([d] -> CSeq d) -> [d] -> CSeq d
forall a b. (a -> b) -> a -> b
$ (a -> b -> c -> d) -> [a] -> [b] -> [c] -> [d]
forall a b c d. (a -> b -> c -> d) -> [a] -> [b] -> [c] -> [d]
zipWith3 a -> b -> c -> d
f (CSeq a -> [a]
forall (t :: * -> *) a. Foldable t => t a -> [a]
F.toList CSeq a
as) (CSeq b -> [b]
forall (t :: * -> *) a. Foldable t => t a -> [a]
F.toList CSeq b
bs) (CSeq c -> [c]
forall (t :: * -> *) a. Foldable t => t a -> [a]
F.toList CSeq c
cs)




-- | Given a circular seq, whose elements are in increasing order, insert the
-- new element into the Circular seq in its sorted order.
--
-- >>> insertOrd 1 $ fromList [2]
-- CSeq [2,1]
-- >>> insertOrd 2 $ fromList [1,3]
-- CSeq [1,2,3]
-- >>> insertOrd 31 ordList
-- CSeq [5,6,10,20,30,31,1,2,3]
-- >>> insertOrd 1 ordList
-- CSeq [5,6,10,20,30,1,1,2,3]
-- >>> insertOrd 4 ordList
-- CSeq [5,6,10,20,30,1,2,3,4]
-- >>> insertOrd 11 ordList
-- CSeq [5,6,10,11,20,30,1,2,3]
--
-- running time: \(O(n)\)
insertOrd :: Ord a => a -> CSeq a -> CSeq a
insertOrd :: a -> CSeq a -> CSeq a
insertOrd = (a -> a -> Ordering) -> a -> CSeq a -> CSeq a
forall a. (a -> a -> Ordering) -> a -> CSeq a -> CSeq 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.
--
-- running time: \(O(n)\)
insertOrdBy       :: (a -> a -> Ordering) -> a -> CSeq a -> CSeq a
insertOrdBy :: (a -> a -> Ordering) -> a -> CSeq a -> CSeq a
insertOrdBy a -> a -> Ordering
cmp a
x = [a] -> CSeq a
forall a. [a] -> CSeq a
fromList ([a] -> CSeq a) -> (CSeq a -> [a]) -> CSeq a -> CSeq 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]) -> (CSeq a -> [a]) -> CSeq a -> [a]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Seq a -> [a]
forall (t :: * -> *) a. Foldable t => t a -> [a]
F.toList (Seq a -> [a]) -> (CSeq a -> Seq a) -> CSeq a -> [a]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CSeq a -> Seq a
forall a. CSeq a -> Seq a
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' :: (a -> a -> Ordering) -> a -> [a] -> [a]
insertOrdBy' a -> a -> Ordering
cmp a
x [a]
xs = case ([a]
rest, a
x a -> a -> Ordering
`cmp` [a] -> a
forall a. [a] -> a
head [a]
rest) of
    ([],  Ordering
_)   -> (a -> a -> Ordering) -> a -> [a] -> [a]
forall a. (a -> a -> Ordering) -> a -> [a] -> [a]
L.insertBy a -> a -> Ordering
cmp a
x [a]
pref
    (a
z:[a]
zs, 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]
L.insertBy a -> a -> Ordering
cmp a
x [a]
zs [a] -> [a] -> [a]
forall a. [a] -> [a] -> [a]
++ [a]
pref
    (a
_:[a]
_,  Ordering
EQ) -> a
x a -> [a] -> [a]
forall a. a -> [a] -> [a]
: [a]
xs -- == x : rest ++ pref
    (a
_:[a]
_,  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]
L.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 :: (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 (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])
L.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. We have that
--
-- prop> (xs `isShiftOf` ys) == (xs `elem` allRotations (ys :: CSeq Int))
--
-- Running time: \(O(n+m)\), where \(n\) and \(m\) are the sizes of
-- the lists.
isShiftOf         :: Eq a => CSeq a -> CSeq a -> Bool
CSeq a
xs isShiftOf :: CSeq a -> CSeq a -> Bool
`isShiftOf` CSeq a
ys = let twice :: CSeq a -> Seq a
twice CSeq a
zs    = let zs' :: Seq a
zs' = CSeq a -> Seq a
forall a. CSeq a -> Seq a
leftElements CSeq a
zs in Seq a
zs' Seq a -> Seq a -> Seq a
forall a. Semigroup a => a -> a -> a
<> Seq a
zs'
                        once :: CSeq a -> Seq a
once        = CSeq a -> Seq a
forall a. CSeq a -> Seq a
leftElements
                        check :: CSeq a -> CSeq a -> Bool
check CSeq a
as CSeq a
bs = Maybe Int -> Bool
forall a. Maybe a -> Bool
isJust (Maybe Int -> Bool) -> Maybe Int -> Bool
forall a b. (a -> b) -> a -> b
$ CSeq a -> Seq a
forall a. CSeq a -> Seq a
once CSeq a
as Seq a -> Seq a -> Maybe Int
forall a (p :: * -> *) (t :: * -> *).
(Eq a, Foldable p, Foldable t) =>
p a -> t a -> Maybe Int
`isSubStringOf` CSeq a -> Seq a
forall a. CSeq a -> Seq a
twice CSeq a
bs
                    in CSeq a -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length CSeq a
xs Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== CSeq a -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length CSeq a
ys Bool -> Bool -> Bool
&& CSeq a -> CSeq a -> Bool
forall a. Eq a => CSeq a -> CSeq a -> Bool
check CSeq a
xs CSeq a
ys