dequeue (empty) → 0.1

raw patch · 5 files changed

+329/−0 lines, 5 filesdep +QuickCheckdep +basedep +safebuild-type:Customsetup-changed

Dependencies added: QuickCheck, base, safe

Files

• LICENSE +11/−0
• Setup.lhs +7/−0
• dequeue.cabal +22/−0
• src/Data/Dequeue.hs +268/−0
• src/Tests.hs +21/−0

@@ -0,0 +1,11 @@+Copyright (c) 2009, Henry Bucklow+All rights reserved.++Redistribution and use in source and binary forms, with or without modification, are permitted provided that the following conditions are met:++    * Redistributions of source code must retain the above copyright notice, this list of conditions and the following disclaimer.+    * Redistributions in binary form must reproduce the above copyright notice, this list of conditions and the following disclaimer in the documentation and/or other materials provided with the distribution.+    * Neither the name of Henry Bucklow nor the names of the contributors may be used to endorse or promote products derived from this software without specific prior written permission.++THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.+

@@ -0,0 +1,7 @@+#! /usr/bin/env runhaskell++> import Distribution.Simple+> import System.Cmd+> tests _ _ _ _ = system "runhaskell src/Tests.hs" >> return ()+> main = defaultMainWithHooks (simpleUserHooks {runTests = tests})+

@@ -0,0 +1,22 @@+Build-Type: Custom+Name: dequeue+Category: "Data Structures"+Version: 0.1+Cabal-Version: >= 1.2+Synopsis: A typeclass and an implementation for double-ended queues.+Description:+    A typeclass for double-ended queues, and an implementation of Banker's+    Dequeues, as described in Chris Okasaki's Purely Functional Data+    Structures.+License: BSD3+License-File: LICENSE+Copyright: (c) 2009 Henry Bucklow+Author: Henry Bucklow+Maintainer: Henry Bucklow <henry@elsie.org.uk>+Tested-With: GHC==6.10+Build-Depends: base, safe, QuickCheck+Exposed-Modules: Data.Dequeue+Hs-Source-Dirs: src+Extra-Source-Files: src/Tests.hs+GHC-Options: -Wall+

@@ -0,0 +1,268 @@+{- |+Module      :  Data.Dequeue+Description :  A typeclass and an implementation for double-ended queues.+Copyright   :  (c) Henry Bucklow 2009+License     :  BSD3++Maintainer  :  henry@elsie.org.uk+Stability   :  provisional+Portability :  portable++A typeclass for double-ended queues, and an implementation of Banker's+Dequeues, as described in Chris Okasaki's Purely Functional Data Structures.+-}+module Data.Dequeue (+    -- * The 'Dequeue' type class.+    Dequeue(..),+    -- * QuickCheck properties for 'Dequeue' instances+    prop_pushpop_front,+    prop_pushpop_back,+    prop_push_front,+    prop_push_back,+    prop_length_toList,+    -- * Banker's Dequeues+    BankersDequeue,+    -- * QuickCheck properties for 'BankersDequeue'+    prop_pushpop_front_bq,+    prop_pushpop_back_bq,+    prop_push_front_bq,+    prop_push_back_bq,+    prop_length_toList_bq,+    prop_push_front_bq_balance,+    prop_push_back_bq_balance,+    prop_pop_front_bq_balance,+    prop_pop_back_bq_balance+) 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 hiding (check)++import Safe++-- | A typeclass for double-ended queues.+class Dequeue q where+    -- | Generates an empty queue.+    empty :: q a+    -- | Returns 'True' if this queue is empty.+    null :: q a -> Bool+    -- | Returns the number of elements in this queue.+    length :: q a -> Int+    -- | Returns the item on the front of the queue.+    first :: q a -> Maybe a+    -- | Returns the item on the end of the queue.+    last :: q a -> Maybe a+    -- | Returns the first n items from the front of the queue.+    takeFront :: Int -> q a -> [a]+    -- | Returns the last n items from the end of the queue.+    takeBack :: Int -> q a -> [a]+    -- | Pushes an item onto the front of the queue.+    pushFront :: q a -> a -> q a+    -- | Pops an item from the front of the queue.+    popFront :: q a -> (Maybe a, q a)+    -- | Pushes an item onto the back of the queue.+    pushBack :: q a -> a -> q a+    -- | Pops an item from the back of the queue.+    popBack :: q a -> (Maybe a, q a)+    -- | Converts a list into a queue.+    fromList :: [a] -> q a++-- QuickCheck properties for Dequeue instances.++-- | Validates that if you push, then pop, the front of the queue,+--   you get the same queue.+prop_pushpop_front :: (Dequeue q, Eq a, Eq (q a)) => q a -> a -> Bool+prop_pushpop_front q a =+    let (a', q') = popFront (pushFront q a) in+    a' == Just a && q' == q++-- | Validates that if you push, then pop, the back of the queue,+--   you get the same queue.+prop_pushpop_back :: (Dequeue q, Eq a, Eq (q a)) => q a -> a -> Bool+prop_pushpop_back q a =+    let (a', q') = popBack (pushBack q a) in+    a' == Just a && q' == q++-- | Validates that 'first' returns the last 'pushFront''d element.+prop_push_front :: (Dequeue q, Eq a) => q a -> a -> Bool+prop_push_front q a = first (pushFront q a) == Just a++-- | Validates that 'last' returns the last 'pushBack''d element.+prop_push_back :: (Dequeue q, Eq a) => q a -> a -> Bool+prop_push_back q a = last (pushBack q a) == Just a++-- | Validates that the length of a queue is the same as the length of the+--   list generated from the queue.+prop_length_toList :: (Dequeue q, Foldable q) => q a -> Bool+prop_length_toList q = List.length (toList q) == length q++-- | An implementation of Banker's Dequeues, as described in Chris Okasaki's+--   Purely Functional Data Structures. The functions for the 'Dequeue'+--   instance have the following complexities (where n is the 'length' of the+--   queue):+--+--    * 'length': O(1)+--+--    * 'first': O(1)+--+--    * 'last': O(1)+--+--    * 'takeFront': O(n)+--+--    * 'takeBack': O(n)+--+--    * 'pushFront': O(1) amortised+--+--    * 'popFront': O(1) amortised+--+--    * 'pushBack': O(1) amortised+--+--    * 'popBack': O(1) amortised+--+--    * 'fromList': O(n)+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)++instance Dequeue BankersDequeue where+    empty = BankersDequeue 0 [] 0 []+    null (BankersDequeue 0 [] 0 []) = True+    null _ = False+    length (BankersDequeue sizeF _ sizeR _) = sizeF + sizeR+    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) =+        reverse $ 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, empty)+    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, empty)+    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 []++-- | The maximum number of times longer one half of a 'BankersDequeue' is+--   permitted to be relative to the other.+bqBalance :: Int+bqBalance = 4++-- | Checks to see if the queue is too far out of balance. If it is, it+--   rebalances it.+check :: BankersDequeue a -> BankersDequeue a+check q@(BankersDequeue sizeF front sizeR rear)+    | sizeF > c * sizeR + 1 =+        let front' = take size1 front+            rear' = rear ++ 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+    coarbitrary (BankersDequeue _ front _ rear) =+        variant 0 . coarbitrary front . coarbitrary rear++instance Eq a => Eq (BankersDequeue a) where+    queue1 == queue2 = toList queue1 == toList queue2++instance Show a => Show (BankersDequeue a) where+    show q = "BankersDequeue " ++ show (toList q)++-- QuickCheck properties for BankersDequeue.++-- | Validates that if you push, then pop, the front of a 'BankersQueue',+--   you get the same queue.+prop_pushpop_front_bq :: BankersDequeue Int -> Int -> Bool+prop_pushpop_front_bq = prop_pushpop_front++-- | Validates that if you push, then pop, the back of a 'BankersDequeue',+--   you get the same queue.+prop_pushpop_back_bq :: BankersDequeue Int -> Int -> Bool+prop_pushpop_back_bq = prop_pushpop_back++-- | Validates that 'first' returns the last 'pushFront''d element.+prop_push_front_bq :: BankersDequeue Int -> Int -> Bool+prop_push_front_bq = prop_push_front++-- | Validates that 'last' returns the last 'pushBack''d element.+prop_push_back_bq :: BankersDequeue Int -> Int -> Bool+prop_push_back_bq = prop_push_back++-- | Validates that the length of a 'BankersDequeue' is the same as the length+--   of the list generated from the queue.+prop_length_toList_bq :: BankersDequeue Int -> Bool+prop_length_toList_bq = prop_length_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++-- | Validates that a 'BankersDequeue' remains balanced despite repeated+--   pushes to the front.+prop_push_front_bq_balance :: BankersDequeue Int -> Int -> Bool+prop_push_front_bq_balance q count =+    let push _ = (flip pushFront) 0+        q' = foldr push q [0 .. count] in+    balanced q'++-- | Validates that a 'BankersDequeue' remains balanced despite repeated+--   pushes to the back.+prop_push_back_bq_balance :: BankersDequeue Int -> Int -> Bool+prop_push_back_bq_balance q count =+    let push _ = (flip pushBack) 0+        q' = foldr push q [0 .. count] in+    balanced q'++-- | Validates that a 'BankersDequeue' remains balanced despite repeated+--   pops from the front.+prop_pop_front_bq_balance :: BankersDequeue Int -> Int -> Bool+prop_pop_front_bq_balance q count =+    let pop _ queue = let (_, queue') = popFront queue in queue'+        q' = foldr pop q [0 .. count] in+    balanced q'++-- | Validates that a 'BankersDequeue' remains balanced despite repeated+--   pops from the back.+prop_pop_back_bq_balance :: BankersDequeue Int -> Int -> Bool+prop_pop_back_bq_balance q count =+    let pop _ queue = let (_, queue') = popBack queue in queue'+        q' = foldr pop q [0 .. count] in+    balanced q'+

@@ -0,0 +1,21 @@+module Main where++import Data.Dequeue+import Text.Printf+import Test.QuickCheck++tests :: [(String, IO ())]+tests = [+    ("pushpop_front_bq", quickCheck prop_pushpop_front_bq),+    ("pushpop_back_bq", quickCheck prop_pushpop_back_bq),+    ("push_front_bq", quickCheck prop_push_front_bq),+    ("push_back_bq", quickCheck prop_push_back_bq),+    ("length_toList_bq", quickCheck prop_length_toList_bq),+    ("push_back_bq_balance", quickCheck prop_push_back_bq_balance),+    ("push_front_bq_balance", quickCheck prop_push_front_bq_balance),+    ("pop_front_bq_balance", quickCheck prop_pop_front_bq_balance),+    ("pop_back_bq_balance", quickCheck prop_pop_back_bq_balance)]++main :: IO ()+main = mapM_ (\(s,a) -> printf "%-25s: " s >> a) tests+