module Data.Dequeue (
Dequeue(..),
showDequeue,
readDequeue,
prop_pushpop_front,
prop_pushpop_back,
prop_push_front,
prop_push_back,
prop_takeFront,
prop_takeBack,
prop_length_toList,
prop_fromList_toList,
BankersDequeue,
prop_pushpop_front_bq,
prop_pushpop_back_bq,
prop_push_front_bq,
prop_push_back_bq,
prop_takeFront_bq,
prop_takeBack_bq,
prop_length_toList_bq,
prop_fromList_toList_bq,
prop_push_front_bq_balance,
prop_push_back_bq_balance,
prop_pop_front_bq_balance,
prop_pop_back_bq_balance,
prop_read_show_bq
) where
import Prelude hiding (foldl, foldr, foldl1, foldr1, length, last)
import Control.Monad
import Data.Foldable
import qualified Data.List as List
import Test.QuickCheck
#if MIN_VERSION_QuickCheck(2,0,0)
#else
hiding (check)
#endif
import Safe
import qualified Data.Dequeue.Show
class Foldable q => Dequeue q where
empty :: q a
null :: q a -> Bool
#if !MIN_VERSION_base(4,8,0)
length :: q a -> Int
#endif
first :: q a -> Maybe a
last :: q a -> Maybe a
takeFront :: Int -> q a -> [a]
takeBack :: Int -> q a -> [a]
pushFront :: q a -> a -> q a
popFront :: q a -> Maybe (a, q a)
pushBack :: q a -> a -> q a
popBack :: q a -> Maybe (a, q a)
fromList :: [a] -> q a
showDequeue :: (Foldable q, Dequeue q, Show a) => q a -> String
showDequeue q = show $ Data.Dequeue.Show.Dequeue (toList q)
readDequeue :: (Dequeue q, Read a) => ReadS (Data.Dequeue.Show.Dequeue a) -> ReadS (q a)
readDequeue readsDefn = \ s -> map convert (readsDefn s)
where convert (Data.Dequeue.Show.Dequeue values, s) = (fromList values, s)
prop_pushpop_front :: (Dequeue q, Eq a, Eq (q a)) => q a -> a -> Bool
prop_pushpop_front q a =
let Just (a', q') = popFront (pushFront q a) in
a' == a && q' == q
prop_pushpop_back :: (Dequeue q, Eq a, Eq (q a)) => q a -> a -> Bool
prop_pushpop_back q a =
let Just (a', q') = popBack (pushBack q a) in
a' == a && q' == q
prop_push_front :: (Dequeue q, Eq a) => q a -> a -> Bool
prop_push_front q a = first (pushFront q a) == Just a
prop_push_back :: (Dequeue q, Eq a) => q a -> a -> Bool
prop_push_back q a = last (pushBack q a) == Just a
prop_takeFront :: (Dequeue q, Eq a) => q a -> [a] -> Bool
prop_takeFront q as =
takeFront (List.length as) (foldr (flip pushFront) q as) == as
prop_takeBack :: (Dequeue q, Eq a) => q a -> [a] -> Bool
prop_takeBack q as =
takeBack (List.length as) (foldr (flip pushBack) q as) == as
prop_length_toList :: (Dequeue q, Foldable q) => q a -> Bool
prop_length_toList q = List.length (toList q) == length q
prop_fromList_toList :: (Dequeue q, Foldable q, Eq (q a)) => q a -> Bool
prop_fromList_toList q = (fromList . toList) q == q
data BankersDequeue a = BankersDequeue Int [a] Int [a]
instance Functor BankersDequeue where
fmap f (BankersDequeue sizeF front sizeR rear) =
BankersDequeue sizeF (fmap f front) sizeR (fmap f rear)
instance Foldable BankersDequeue where
fold (BankersDequeue _ front _ rear) = fold (front ++ reverse rear)
foldMap f (BankersDequeue _ front _ rear) = foldMap f (front ++ reverse rear)
foldr f a (BankersDequeue _ front _ rear) = foldr f a (front ++ reverse rear)
foldl f a (BankersDequeue _ front _ rear) = foldl f a (front ++ reverse rear)
foldr1 f (BankersDequeue _ front _ rear) = foldr1 f (front ++ reverse rear)
foldl1 f (BankersDequeue _ front _ rear) = foldl1 f (front ++ reverse rear)
#if MIN_VERSION_base(4,8,0)
length (BankersDequeue sizeF _ sizeR _) = sizeF + sizeR
#endif
instance Dequeue BankersDequeue where
empty = BankersDequeue 0 [] 0 []
null (BankersDequeue 0 [] 0 []) = True
null _ = False
#if !MIN_VERSION_base(4,8,0)
length (BankersDequeue sizeF _ sizeR _) = sizeF + sizeR
#endif
first (BankersDequeue _ [] _ [x]) = Just x
first (BankersDequeue _ front _ _) = headMay front
last (BankersDequeue _ [x] _ []) = Just x
last (BankersDequeue _ _ _ rear) = headMay rear
takeFront i (BankersDequeue sizeF front _ rear) =
take i front ++ take (i sizeF) (reverse rear)
takeBack i (BankersDequeue _ front sizeR rear) =
take i rear ++ take (i sizeR) (reverse front)
pushFront (BankersDequeue sizeF front sizeR rear) x =
check $ BankersDequeue (sizeF + 1) (x : front) sizeR rear
popFront (BankersDequeue _ [] _ []) = Nothing
popFront (BankersDequeue _ [] _ [x]) = Just (x, empty)
popFront (BankersDequeue _ [] _ _) = error "Queue is too far unbalanced."
popFront (BankersDequeue sizeF (f : fs) sizeR rear) =
Just (f, check $ BankersDequeue (sizeF 1) fs sizeR rear)
pushBack (BankersDequeue sizeF front sizeR rear) x =
check $ BankersDequeue sizeF front (sizeR + 1) (x : rear)
popBack (BankersDequeue _ [] _ []) = Nothing
popBack (BankersDequeue _ [x] _ []) = Just (x, empty)
popBack (BankersDequeue _ _ _ []) = error "Queue is too far unbalanced."
popBack (BankersDequeue sizeF front sizeR (r : rs)) =
Just (r, check $ BankersDequeue sizeF front (sizeR 1) rs)
fromList list = check $ BankersDequeue (List.length list) list 0 []
bqBalance :: Int
bqBalance = 4
check :: BankersDequeue a -> BankersDequeue a
check q@(BankersDequeue sizeF front sizeR rear)
| sizeF > c * sizeR + 1 =
let front' = take size1 front
rear' = rear ++ reverse (drop size1 front)
in
BankersDequeue size1 front' size2 rear'
| sizeR > c * sizeF + 1 =
let front' = front ++ reverse (drop size1 rear)
rear' = take size1 rear
in
BankersDequeue size2 front' size1 rear'
| otherwise = q
where
size1 = (sizeF + sizeR) `div` 2
size2 = (sizeF + sizeR) size1
c = bqBalance
instance (Arbitrary a) => Arbitrary (BankersDequeue a) where
arbitrary = (liftM fromList) arbitrary
#if MIN_VERSION_QuickCheck(2,0,0)
#else
coarbitrary (BankersDequeue _ front _ rear) =
variant 0 . coarbitrary front . coarbitrary rear
#endif
instance Eq a => Eq (BankersDequeue a) where
queue1 == queue2 = toList queue1 == toList queue2
instance Show a => Show (BankersDequeue a) where
show q = showDequeue q
instance Read a => Read (BankersDequeue a) where
readsPrec i = readDequeue $ readsPrec i
prop_pushpop_front_bq :: BankersDequeue Int -> Int -> Bool
prop_pushpop_front_bq = prop_pushpop_front
prop_pushpop_back_bq :: BankersDequeue Int -> Int -> Bool
prop_pushpop_back_bq = prop_pushpop_back
prop_push_front_bq :: BankersDequeue Int -> Int -> Bool
prop_push_front_bq = prop_push_front
prop_push_back_bq :: BankersDequeue Int -> Int -> Bool
prop_push_back_bq = prop_push_back
prop_takeFront_bq :: BankersDequeue Int -> [Int] -> Bool
prop_takeFront_bq = prop_takeFront
prop_takeBack_bq :: BankersDequeue Int -> [Int] -> Bool
prop_takeBack_bq = prop_takeBack
prop_length_toList_bq :: BankersDequeue Int -> Bool
prop_length_toList_bq = prop_length_toList
prop_fromList_toList_bq :: BankersDequeue Int -> Bool
prop_fromList_toList_bq = prop_fromList_toList
balanced :: BankersDequeue a -> Bool
balanced (BankersDequeue 0 _ 0 _) = True
balanced (BankersDequeue 1 _ 0 _) = True
balanced (BankersDequeue 0 _ 1 _) = True
balanced (BankersDequeue sizeF _ sizeR _) =
sizeF <= bqBalance * sizeR + 1 && sizeR <= bqBalance * sizeF + 1
prop_push_front_bq_balance :: BankersDequeue Int -> Int -> Property
prop_push_front_bq_balance q count = count < qcLimit ==>
let push queue _ = pushFront queue 0
q' = foldl push q [0 .. count] in
balanced q'
prop_push_back_bq_balance :: BankersDequeue Int -> Int -> Property
prop_push_back_bq_balance q count = count < qcLimit ==>
let push queue _ = pushBack queue 0
q' = foldl push q [0 .. count] in
balanced q'
prop_pop_front_bq_balance :: BankersDequeue Int -> Int -> Property
prop_pop_front_bq_balance q count = count < qcLimit ==>
let pop queue _ = (fromJustDef queue . liftM snd . popFront) queue
q' = foldl pop q [0 .. count] in
balanced q'
prop_pop_back_bq_balance :: BankersDequeue Int -> Int -> Property
prop_pop_back_bq_balance q count = count < qcLimit ==>
let pop queue _ = (fromJustDef queue . liftM snd . popBack) queue
q' = foldl pop q [0 .. count] in
balanced q'
qcLimit :: Int
qcLimit = 10 ^ (6 :: Int)
prop_read_show_bq :: BankersDequeue Int -> Bool
prop_read_show_bq q = (read . show) q == q