{-# LANGUAGE TemplateHaskell #-} {- | Second assignment for IB016, semester spring 2019. = Task overview Your task is to implement an extended rope data structure and tests for it. Rope data structure is used to efficiently store and manipulate very long strings. For example, a text editor may use a rope to represent the text. A rope provides efficient insertion, deletion and random access. Manipulation with long strings in an ordinary list is not always the most effective way. For example, if you want to insert a substring into the string, the time complexity is linear with regards to the length of the string. The rope data structure allows us to do this more efficiently on average. In ropes, substrings of long string are saved in leaf nodes. Each leaf node holds the length of a substring too. Each non-leaf node holds sum of the lengths of all the leaves in its left subtree ("weight" of node). For example: <> This is a rope, which stores the string "Hello_World!". Your task is to implement basic operations on the extended rope data structure (insertion, deletion, searching) as well as some tests for it. The extended rope data structure stores any list of any type. You are given the definition of the data structure itself (you are not allowed to change it!). You can find descriptions of the required operations below. As for the tests, writing an instance of 'Arbitrary' for 'Rope' is quite tedious, as it requires generating all sorts of valid ropes. Therefore we have written an instance of 'Arbitrary' for 'Rope' for you to use in the tests. However, there is an alternative approach to testing a data structure 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 ropes built using this sequence with a list 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 the 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. = Assignment summary * Implement specified operations on the @Rope@ data structure (5 points). * Implement 'Arbitrary' instance for 'Action' (2 points). * Implement your test utilities ('replayRope', 'replayList'), the 'prop_compare_with_list' test, and your own tests (3 points). = Modules and packages You can use any modules from the package, as well as the , and the packages. If you wish, you can also use Unicode syntax from . If you want to use any other module or package, please ask in the discussion forum before use. = General Notes & Tips * Please be sure that you calculate weights correctly. * Don't forget to check that every tree leaf is 'Leaf' (every 'Node' node has to have at least one descendant). * Test all functions and their combinations. * Keep in mind that rope should have fast modification times, therefore you should either make minimal changes to its structure in insert/delete, or balance it and keep the amortized complexity in mind -} -- ------------------------------------------------------------------------------------------- -- Name: -- UCO: -- ------------------------------------------------------------------------------------------- module HW02 ( Rope ( Node, weight, left, right, Leaf, value ) , index , empty , size , valid , validWithRate , insert , delete , fromList , fromListWithRate , toList -- * Tests , Action (..) , ActionSeq (..) , replayRope , replayList , prop_compare_with_list , 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 Test.QuickCheck ( Args ( maxSuccess ), quickCheckWithResult, stdArgs , Arbitrary ( arbitrary, shrink ), sized, Gen, choose, frequency , forAllProperties, Property, (===) ) import Data.Maybe ( catMaybes ) import Data.List ( splitAt ) import Data.Bifunctor ( bimap ) -- | A rope structure, which stores a list of values of type @a@. -- You are not allowed to change this definition. data Rope a = Node { weight :: Int -- ^ node weight , left :: Maybe (Rope a) -- ^ left subtree , right :: Maybe (Rope a) -- ^ right subtree } | Leaf { weight :: Int -- ^ length of sublist , value :: [a] -- ^ sublist } deriving (Show, Read) -- | Creates an empty rope (stores an empty list). instance Default (Rope a) where def = undefined -- | Return the value at the position @i@. index :: Int -> Rope a -> Maybe a index = undefined -- | Is the stored list empty? empty :: Rope a -> Bool empty = undefined -- | Get the size (length of the stored list) of the given rope. size :: Rope a -> Int size = undefined -- | Check if the given rope is valid: weights are calculated correctly and -- every 'Node' has at least one descendant. valid :: Rope a -> Bool valid = undefined -- | Check if the rope is valid and if the weight of each leaf node is at most the given -- value (rate). validWithRate :: Int -> Rope a -> Bool validWithRate = undefined -- | Inserts a list into a rope at the given position. -- If the given position is invalid (out of range), then the given rope doesn't change. -- -- For example: @'insert' 3 [10, 11, 42] ('fromList' [0, 1, 2, 3, 4, 5])@ -- represents the same sequence as @'fromList' [0, 1, 2, 10, 11, 42, 3, 4, 5]@. insert :: Int -- ^ position -> [a] -- ^ given list to insert -> Rope a -- ^ given rope -> Rope a -- ^ result insert = undefined -- | Removes a sublist. -- If the given position is invalid (out of range), then the given rope doesn't change. -- If the position is valid, but the range ends after the end of the rope, -- removes all elements from the position to the end. delete :: Int -- ^ beginning position to remove -> Int -- ^ length of the substring to remove -> Rope a -- ^ given rope -> Rope a -- ^ result delete = undefined -- | Create a rope that stores the given list. fromList :: [a] -> Rope a fromList = undefined -- | Create a rope that stores the given list and the weight of each leaf node is at -- most the given value (rate). The rope should be balanced. fromListWithRate :: Int -> [a] -> Rope a fromListWithRate = undefined -- | Get the list that is stored in the given rope. toList :: Rope a -> [a] toList = 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 :: Rope Char) prop_insert_delete_def :: String -> Bool prop_insert_delete_def s = empty . delete 0 (length s) $ insert 0 s def prop_def_size :: Property prop_def_size = size (def :: Rope Int) === 0 -- | Here we give you an instance of 'Arbitrary' for 'Rope' instance (Arbitrary a) => Arbitrary (Rope a) where -- | Generate an arbitrary *valid* 'Rope' (calculate weights correctly). arbitrary = arbitrary >>= createChild shrink Leaf { value = v } = map (\list -> Leaf { weight = length list, value = list }) $ shrink v shrink Node { left = l, right = r } = catMaybes [ l, r ] -- | Generate a node of 'Rope' based on the given list. createChild :: [a] -> Gen (Rope a) createChild [] = pure def createChild list = do index <- choose (0, length list) -- bimap applies the first function to the first element of the pair and the second to the second let (gl, gr) = bimap createChild createChild (splitAt index list) together = createChild list frequency [ (2, pure $ def { weight = length list, value = list }) , (1, fmap (\a -> Node { weight = length list, left = Just a, right = Nothing }) together) , (1, fmap (\a -> Node { weight = 0, left = Nothing, right = Just a }) together) , (5, gl >>= \l -> gr >>= \r -> pure Node { weight = index, left = Just l, right = Just r }) ] -- test that our generator generates valid ropes prop_arbitrary_valid :: Rope Char -> Bool prop_arbitrary_valid = valid -- | This data type describes actions over 'Rope' in such a way that these -- actions can be generated by @QuickCheck@. data Action a = Insert Int [a] | Delete Int Int deriving Show -- | Write an instance for generation of 'Rope' actions. Keep in mind that -- 'shrink' should try to do one change in each step and must never generate -- the same value as its argument (to prevent cycling). Arbitrary should be -- written in such a way that it generates slightly more inserts (in total) -- then erases. instance (Arbitrary a) => Arbitrary (Action a) where arbitrary = undefined shrink = undefined -- | A sequence of actions for 'Arbitrary' instance. newtype ActionSeq a = ActionSeq { actions :: [Action a] } deriving Show -- | We give you a simple instance of 'Arbitrary' for 'ActionSeq' (which just -- uses the implementation for a list of 'Action's). instance (Arbitrary a) => Arbitrary (ActionSeq a) where arbitrary = ActionSeq <$> arbitrary shrink (ActionSeq as) = ActionSeq <$> shrink as -- | Produce a 'Rope' that corresponds to the given sequence of actions. replayRope :: ActionSeq a -> Rope a replayRope = undefined -- | Produce a list that corresponds to the given sequence of actions. -- -- You are not allowed to use the functions that you implemented for the 'Rope' -- structure here, because you want to test your function against a trustworthy -- implementation. replayList :: ActionSeq a -> [a] replayList = undefined -- write your own tests here -- | Write a property that produces a 'Rope' and a list from the 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_list :: ActionSeq Char -> Property prop_compare_with_list = 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 })