{-# LANGUAGE TemplateHaskell #-} {- | Second assignment for IB016, semester spring 2018. = Task overview Your task is to implement a trie data structure and tests for it. Trie is a simple tree data structure which can be used as an alternative to search trees. It is used to implement associative maps in which keys can be split into individual elements (from some reasonably small set). Examples include associative maps with string keys (can be split to characters), or binary sequence keys (can be split to individual booleans). In tries, keys are encoded in the path from root to the node (in contrast which search trees that store whole keys in the nodes). Each child of a node is also associated with the part of the key – the full key value consists of all parts from the trie root to the value node concatenated. An example: <> This is a trie which associates key @"a"@ with value @3@, key @"aha"@ with value @2@ and key @"ahoj"@ with @42@. You task is to implement basic operations on this data structure (insertion, deleting, searching) as well as some tests for it. You are given the definition of the data structure itself. You can find description of the required operations below. No trie is allowed to have leaves without values (unless it is an empty trie). As for the tests, writing an instance of 'Arbitrary' for 'Trie' is quite tedious, as it requires generating valid tries of reasonable size. Therefore we have written an instance of 'Arbitrary' for 'Trie' for you to use in tests. However, there is an alternative approach to testing data structures defined in terms of their operations: Generating a random sequence of operations and comparing the results with a reference implementation. Write a generator for such sequences (@ActionSeq@) and at least the test comparing tries build using this sequence to a @Map@ build from this sequence. Furthermore, write your own tests for the rest of the functionality – all functions should be covered by tests, these test should be written is such a way that it is likely that errors will be discovered in simplest possible instances. Furthermore, from the test failures it should be clear what operation failed and what were the inputs. These tests will be a part of your evaluation. You should name all tests with the @prop_@ prefix. You can then execute them using the 'runTests' function we have defined for you. = Assignent Summary * Implement specified operations on the @Trie@ data structure (5 points). * Implement 'Arbitrary' instance for 'Action' (2 points). * BONUS: Implement advanced instance for 'ActionSeq' instead of the provided one (see comment on the provied instance) (2 points). * Implement your test utilities ('replayMap', 'replayTrie'), the 'prop_compare_with_map' test, and your own tests (3 points). = Modules and packages You can use any modules from the package, as well as the , , and packages. If you wish, you can also use Unicode syntax from . No other packages are allowed. -} -- ------------------------------------------------------------------------------------------- -- Name: -- UCO: -- ------------------------------------------------------------------------------------------- module HW02 ( Trie ( Trie, value, children ) -- * Inserting values , insertWith , insert -- * Queries , empty , find , valid , size -- * Removal , delete -- * Tests , Action (..) , ActionSeq (..) , replayTrie , replayMap , prop_compare_with_map , runTests ) where -- note: it is a good idea to write all imported functions explicitly for clarity and collision avoidance import Data.Default.Class ( Default, def ) -- package data-default-class import Data.Maybe ( mapMaybe ) import Data.List ( nubBy ) import Data.Map ( Map ) import Data.Function ( on ) import Test.QuickCheck ( Args ( maxSuccess ), quickCheckWithResult, stdArgs , Arbitrary ( arbitrary, shrink ), CoArbitrary, Function, Fun, sized, Gen , choose, vectorOf, frequency , forAllProperties, Property, (===), (.&&.), property, counterexample , applyFun2 ) -- | A trie which associates values of type @[k]@ with @a@, you are not allowed -- to change this definition. data Trie k a = Trie { value :: Maybe a -- ^ value assosiated with current key , children :: [(k, Trie k a)] -- ^ must not contain duplicites } deriving (Show, Read, Eq) -- | Creates an empty trie instance Default (Trie k a) where def = undefined -- | Associate a given value with a given key. If some value is associated with -- the key, the final value is produced from the original and new value using a -- merge function (new value is first argument to the merge function, old is -- second argument). -- -- @insertWith f k v t@ produces a trie which: -- -- * if t contains @v0@ assosicated with @k@: associates @merge v v0@ with @k@ -- * otherwise associates @v@ with @k@ insertWith :: Eq k => (a -> a -> a) -> [k] -> a -> Trie k a -> Trie k a insertWith = undefined -- | Insers a value or relaces current associated value. insert :: Eq k => [k] -> a -> Trie k a -> Trie k a insert = undefined -- | Is trie empty? empty :: Trie k a -> Bool empty = undefined -- | Removes value associated with given key. Must not leave subtrie with no -- associated value (i.e. there must be no nodes which would have no value and -- no children). delete :: Eq k => [k] -> Trie k a -> Trie k a delete = undefined -- | Find a value corresponding to the given key. find :: Eq k => [k] -> Trie k a -> Maybe a find = undefined -- | Calculate size (number of values) of given trie. size :: Trie k a -> Int size = undefined -- | Check if trie is valid: all leaves have to have values (unless the entrie -- trie is empty, in which case the root is a leaf without a value) valid :: Trie k v -> Bool valid = undefined -- QuickCheck test ------------------------------------------------------------ -- Anything prefixed with @prop_@ will be picked and executed by 'runTests' -- some very basic tests prop_empty :: Bool prop_empty = empty (def :: Trie Int Int) prop_insert_delete_def :: [Int] -> Int -> Bool prop_insert_delete_def k v = empty . delete k $ insert k v def prop_def_size :: Property prop_def_size = size (def :: Trie Int Int) === 0 -- | Here we give you an instance of 'Arbitrary' for 'Trie' -- it is quite a -- complex instance as it is necessery to generate tries of reasonable size instance (Eq k, Arbitrary k, Arbitrary v) => Arbitrary (Trie k v) where arbitrary = sized (arbitraryTrie True) shrink trie@Trie { value = Just _ } = revalidate <$> trie { value = Nothing } : shrinkChildren trie shrink trie = revalidate <$> shrinkChildren trie -- Generate an arbitrary *valid* 'Trie'. Validity is ensured with the help of -- the first argument – an empty trie can be generated only if it is 'True' -- (which is only in root) arbitraryTrie :: (Eq k, Arbitrary k, Arbitrary v) => Bool -> Int -> Gen (Trie k v) arbitraryTrie True 0 = pure def arbitraryTrie False 0 = arbitrarySingleton arbitraryTrie _ n = do b <- choose (1, 5) v <- arbitrary let base = def { value = v } setChildren cs = base { children = nubBy ((==) `on` fst) cs } frequency [ (1, arbitrarySingleton) , (3, setChildren <$> vectorOf b ((,) <$> arbitrary <*> arbitraryTrie False ((n - 1) `div` b))) ] -- Generate a root with a value arbitrarySingleton :: (Arbitrary k, Arbitrary a) => Gen (Trie k a) arbitrarySingleton = fmap (\v -> def { value = Just v }) arbitrary shrinkChildren :: (Arbitrary k, Arbitrary a) => Eq k => Trie k a -> [Trie k a] shrinkChildren trie = map snd (children trie) ++ map (\cs -> trie { children = cs }) (shrink $ children trie) -- you are not allowed to use this function in you implementation, it is for -- testing only (it is way too expensive) revalidate :: Trie k a -> Trie k a revalidate trie@Trie { children = cs } = trie { children = mapMaybe rv cs } where rv (k, t) | Just _ <- value t = Just (k, revalidate t) -- shortcut | size t == 0 = Nothing | otherwise = Just (k, revalidate t) -- test that our generator generates valid tries prop_arbitrary_valid :: Trie Int Int -> Bool prop_arbitrary_valid = valid -- test that shrink preserves validity prop_shrink_valid :: Trie Int Int -> Property prop_shrink_valid = foldl (\r t -> r .&&. valid' t) (property True) . shrink where valid' t = counterexample (show t) (valid t) -- | This data type describes actions over 'Trie' in such a way that these -- actions can be generated by @QuickCheck@. Note that 'Fun' is a function -- which can be generated and shown – in our case a binary function. Such a -- binary function can be converted to normal (currified) binary function using -- 'applyFun2' (from @Test.QuickCheck@). data Action k a = InsertWith (Fun (a, a) a) [k] a | Insert [k] a | Delete [k] deriving Show -- | Write an instance for generation of 'Trie' actions. Keep in mind that -- 'shrink' should try to do one change in each step and must never generate -- the some value as is its argument (to prevent cycling). Arbitrary should be -- written in such a way that is generates slightly more inserts (in total) -- then erases. -- -- Note: 'CoArbitrary' and 'Function' are needed to generate 'Fun (a, a) a', -- but you can just use 'arbitrary' to generate the functions. instance (Eq k, Arbitrary k, Arbitrary a, CoArbitrary a, Function a) => Arbitrary (Action k a) where arbitrary = undefined shrink = undefined -- | A sequence of actions for Arbitrary instance. newtype ActionSeq k a = ActionSeq { actions :: [Action k a] } deriving Show -- | We give you a simple instance of 'Arbitrary' for 'ActionSeq' (which just -- uses implementation for list of 'Action's). -- -- BONUS: Write the 'arbitrary' function such that on average any 'Erase' in -- any sequence has 50 % chance of deleting an element which should be in the -- trie based on the previous actions. Do not use 'Trie' functions in the -- generator (as we will use it to test them). instance (Eq k, Arbitrary k, Arbitrary a, CoArbitrary a, Function a) => Arbitrary (ActionSeq k a) where arbitrary = ActionSeq <$> arbitrary shrink (ActionSeq as) = ActionSeq <$> shrink as -- | Produce a 'Trie' which corresponds to given sequence of actions. replayTrie :: Eq k => ActionSeq k a -> Trie k a replayTrie = undefined -- | Produce a 'Map' which corresponds to given sequence of actions. replayMap :: Ord k => ActionSeq k a -> Map [k] a replayMap = undefined -- write your own tests here -- | Write a property which produces a 'Trie' and a 'Map' from given sequence -- and compares them if they hold exactly the same data. Try to write this in -- such a way that it has nice error messages. prop_compare_with_map :: ActionSeq Int Int -> Property prop_compare_with_map = undefined -- QuickCheck TemplateHaskell magic follows: -- this makes sure GHC can find all our test, see -- -- if you want return [] -- | Run all our @prop_*@ tests using QuickCheck, with 1000 tests for each property. -- -- The @$@ is a TemplateHaskell special symbol which means the following -- expression (@forAllProperties@ in our case) is evaluated at compile-time. runTests :: IO Bool runTests = $forAllProperties (quickCheckWithResult stdArgs { maxSuccess = 1000 })