hgeometry-combinatorial-0.12.0.2: Data structures, and Data types.
Copyright(C) Frank Staals
Licensesee the LICENSE file
MaintainerFrank Staals
Safe HaskellNone
LanguageHaskell2010

Data.CircularSeq

Description

 
Synopsis

Documentation

data CSeq a Source #

Nonempty circular sequence

Instances

Instances details
Functor CSeq Source # 
Instance details

Defined in Data.CircularSeq

Methods

fmap :: (a -> b) -> CSeq a -> CSeq b #

(<$) :: a -> CSeq b -> CSeq a #

Foldable CSeq Source # 
Instance details

Defined in Data.CircularSeq

Methods

fold :: Monoid m => CSeq m -> m #

foldMap :: Monoid m => (a -> m) -> CSeq a -> m #

foldMap' :: Monoid m => (a -> m) -> CSeq a -> m #

foldr :: (a -> b -> b) -> b -> CSeq a -> b #

foldr' :: (a -> b -> b) -> b -> CSeq a -> b #

foldl :: (b -> a -> b) -> b -> CSeq a -> b #

foldl' :: (b -> a -> b) -> b -> CSeq a -> b #

foldr1 :: (a -> a -> a) -> CSeq a -> a #

foldl1 :: (a -> a -> a) -> CSeq a -> a #

toList :: CSeq a -> [a] #

null :: CSeq a -> Bool #

length :: CSeq a -> Int #

elem :: Eq a => a -> CSeq a -> Bool #

maximum :: Ord a => CSeq a -> a #

minimum :: Ord a => CSeq a -> a #

sum :: Num a => CSeq a -> a #

product :: Num a => CSeq a -> a #

Traversable CSeq Source # 
Instance details

Defined in Data.CircularSeq

Methods

traverse :: Applicative f => (a -> f b) -> CSeq a -> f (CSeq b) #

sequenceA :: Applicative f => CSeq (f a) -> f (CSeq a) #

mapM :: Monad m => (a -> m b) -> CSeq a -> m (CSeq b) #

sequence :: Monad m => CSeq (m a) -> m (CSeq a) #

Foldable1 CSeq Source # 
Instance details

Defined in Data.CircularSeq

Methods

fold1 :: Semigroup m => CSeq m -> m #

foldMap1 :: Semigroup m => (a -> m) -> CSeq a -> m #

toNonEmpty :: CSeq a -> NonEmpty a #

Eq a => Eq (CSeq a) Source # 
Instance details

Defined in Data.CircularSeq

Methods

(==) :: CSeq a -> CSeq a -> Bool #

(/=) :: CSeq a -> CSeq a -> Bool #

Read a => Read (CSeq a) Source # 
Instance details

Defined in Data.CircularSeq

Show a => Show (CSeq a) Source # 
Instance details

Defined in Data.CircularSeq

Methods

showsPrec :: Int -> CSeq a -> ShowS #

show :: CSeq a -> String #

showList :: [CSeq a] -> ShowS #

Generic (CSeq a) Source # 
Instance details

Defined in Data.CircularSeq

Associated Types

type Rep (CSeq a) :: Type -> Type #

Methods

from :: CSeq a -> Rep (CSeq a) x #

to :: Rep (CSeq a) x -> CSeq a #

Arbitrary a => Arbitrary (CSeq a) Source # 
Instance details

Defined in Data.CircularSeq

Methods

arbitrary :: Gen (CSeq a) #

shrink :: CSeq a -> [CSeq a] #

NFData a => NFData (CSeq a) Source # 
Instance details

Defined in Data.CircularSeq

Methods

rnf :: CSeq a -> () #

type Rep (CSeq a) Source # 
Instance details

Defined in Data.CircularSeq

type Rep (CSeq a) = D1 ('MetaData "CSeq" "Data.CircularSeq" "hgeometry-combinatorial-0.12.0.2-BPOszceZMWb3Na6sqXbM08" 'False) (C1 ('MetaCons "CSeq" 'PrefixI 'False) (S1 ('MetaSel ('Nothing :: Maybe Symbol) 'NoSourceUnpackedness 'SourceStrict 'DecidedStrict) (Rec0 (Seq a)) :*: (S1 ('MetaSel ('Nothing :: Maybe Symbol) 'NoSourceUnpackedness 'SourceStrict 'DecidedStrict) (Rec0 a) :*: S1 ('MetaSel ('Nothing :: Maybe Symbol) 'NoSourceUnpackedness 'SourceStrict 'DecidedStrict) (Rec0 (Seq a)))))

cseq :: Seq a -> a -> Seq a -> CSeq a Source #

smart constructor that automatically balances the seq

singleton :: a -> CSeq a Source #

O(1) CSeq with exactly one element.

fromNonEmpty :: NonEmpty a -> CSeq a Source #

builds a CSeq

fromList :: [a] -> CSeq a Source #

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!

focus :: CSeq a -> a Source #

Gets the focus of the CSeq.

running time: O(1)

index :: CSeq a -> Int -> a Source #

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

adjust :: (a -> a) -> Int -> CSeq a -> CSeq a Source #

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]

item :: Int -> Lens' (CSeq a) a Source #

Access the ith item in the CSeq (w.r.t the focus) as a lens

rotateL :: CSeq a -> CSeq a Source #

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]

rotateR :: CSeq a -> CSeq a Source #

rotates one to the right

running time: O(1) (amortized)

>>> rotateR $ fromList [3,4,5,1,2]
CSeq [4,5,1,2,3]

rotateNL :: Int -> CSeq a -> CSeq a Source #

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]

rotateNR :: Int -> CSeq a -> CSeq a Source #

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]

rightElements :: CSeq a -> Seq a Source #

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

leftElements :: CSeq a -> Seq a Source #

All elements, starting with the focus, going to the left

>>> leftElements $ fromList [3,4,5,1,2]
fromList [3,2,1,5,4]

asSeq :: CSeq a -> Seq a Source #

Convert to a single Seq, starting with the focus.

withIndices :: CSeq a -> CSeq (Int :+ a) Source #

Label the elements with indices.

>>> withIndices $ fromList [0..5]
CSeq [0 :+ 0,1 :+ 1,2 :+ 2,3 :+ 3,4 :+ 4,5 :+ 5]

reverseDirection :: CSeq a -> CSeq a Source #

Reverses the direction of the CSeq

running time: \(O(n)\)

>>> reverseDirection $ fromList [1..5]
CSeq [1,5,4,3,2]

allRotations :: CSeq a -> CSeq (CSeq a) Source #

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]

findRotateTo :: (a -> Bool) -> CSeq a -> Maybe (CSeq a) Source #

Finds an element in the CSeq

>>> findRotateTo (== 3) $ fromList [1..5]
Just (CSeq [3,4,5,1,2])
>>> findRotateTo (== 7) $ fromList [1..5]
Nothing

rotateTo :: Eq a => a -> CSeq a -> Maybe (CSeq a) Source #

Rotate to a specific element in the CSeq.

zipLWith :: (a -> b -> c) -> CSeq a -> CSeq b -> CSeq c Source #

"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.

zipL :: CSeq a -> CSeq b -> CSeq (a, b) Source #

see 'zipLWith

zip3LWith :: (a -> b -> c -> d) -> CSeq a -> CSeq b -> CSeq c -> CSeq d Source #

same as zipLWith but with three items

insertOrd :: Ord a => a -> CSeq a -> CSeq a Source #

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)\)

insertOrdBy :: (a -> a -> Ordering) -> a -> CSeq a -> CSeq a Source #

Insert an element into an increasingly ordered circular list, with specified compare operator.

running time: \(O(n)\)

isShiftOf :: Eq a => CSeq a -> CSeq a -> Bool Source #

Test if the circular list is a cyclic shift of the second list. We have that

(xs `isShiftOf` ys) == (xs `elem` allRotations (ys :: CSeq Int))

Running time: \(O(n+m)\), where \(n\) and \(m\) are the sizes of the lists.