praxis

Various programming exercises.
git clone git://git.jtobin.io/praxis.git
Log | Files | Refs

minstack.hs (1504B)

      1 import Test.QuickCheck
      2 import Control.Monad
      3 
      4 data MinStack a = Bottom | Stack a a (MinStack a)
      5     deriving (Eq, Read)
      6 
      7 instance Show a => Show (MinStack a) where
      8     show Bottom        = "|"
      9     show (Stack m x s) =  "<" ++ show x ++ show s
     10 
     11 push x s@(Stack m _ _) = if x < m then Stack x x s else Stack m x s
     12 push x Bottom          = Stack x x Bottom
     13 
     14 pop Bottom        = error "nothing there"
     15 pop (Stack _ x s) = (x, s)
     16 
     17 smin Bottom        = error "nothing there"
     18 smin (Stack m _ _) = m
     19 
     20 -- Testing
     21 
     22 fromList :: Ord a => [a] -> MinStack a 
     23 fromList = foldr push Bottom
     24 
     25 toList :: MinStack a -> [a]
     26 toList Bottom        = []
     27 toList (Stack _ x s) = x : toList s
     28 
     29 instance (Ord a, Arbitrary a) => Arbitrary (MinStack a) where
     30     arbitrary = liftM fromList (arbitrary :: Arbitrary a => Gen [a])
     31 
     32 newtype NonEmptyMinStack a = NonEmptyMinStack {getValue :: MinStack a}
     33     deriving (Eq, Show, Read)
     34 
     35 instance (Ord a, Arbitrary a) => Arbitrary (NonEmptyMinStack a) where
     36     arbitrary = liftM NonEmptyMinStack (arbitrary `suchThat` (/= Bottom))
     37 
     38 sminReturnsMinimum (NonEmptyMinStack ms) = smin ms == minimum (toList ms)
     39 
     40 newtype LargeMinStack a = LargeMinStack {getValueOfLargeMinStack :: MinStack a}
     41     deriving (Eq, Show, Read)
     42 
     43 instance (Ord a, Arbitrary a) => Arbitrary (LargeMinStack a) where
     44     arbitrary = liftM LargeMinStack (arbitrary `suchThat` ((> 1) . length . toList))
     45 
     46 sminUnaffectedByPopping (LargeMinStack ms) = let (x, s) = pop ms in
     47     if smin ms /= smin s then x == smin ms else True
     48