diff --git a/.DS_Store b/.DS_Store Binary files a/.DS_Store and b/.DS_Store differ diff --git a/Chapter15/.DS_Store b/Chapter15/.DS_Store Binary files a/Chapter15/.DS_Store and b/Chapter15/.DS_Store differ diff --git a/Chapter15/Solutions15.hs b/Chapter15/Solutions15.hs deleted file mode 100644 --- a/Chapter15/Solutions15.hs +++ /dev/null @@ -1,212 +0,0 @@ ------------------------------------------------------------------------------- --- --- Haskell: The Craft of Functional Programming --- Simon Thompson --- (c) Addison-Wesley, 2011. --- --- Solutions15 --- ------------------------------------------------------------------------------- - -module Solutions15 where - -import Types - --- --- Solution 15.1 --- - --- It is always possible to limit what is imported from a particular --- module through import controls, but that doesn't prevent a client of --- the imported module importing anything from the client, if no export --- controls are in place. - --- On the other hand, export controls are needed for re-export of imported --- definitions, which are not re-exported by default. - --- Export controls have an annoying limitation: it's not possible to hide --- particular bindings explicitly on export, rather have to have a whole export --- list which excludes the binding(s) in question, but which has to include --- everything else. - --- --- Solution 15.2 --- - --- It's the right default: can always re-export, but if everything re-exported a --- automatically it's harder to look at a module and see where the definitions it --- uses come from. As it stands, a definition will be in one of the modules included, --- or explicitly re-exported from one of those. - --- Also auto re-export would possibly pollute the name space with bindings we don't --- want to be aware of. - --- --- Solution 15.3 --- - --- More brevity. Why not? Could have to check consistency: what if we say "no Dog" --- but something imported from Dog is explicitly exported? - --- --- Solution 15.4 --- - --- LRLRRRRRLRR - --- --- Solution 15.5 --- - --- babbat - --- would expect that the shortest is with b coded by a single letter; using the --- tree in 15.4 get the coding LRLLLRLRR: 9 chars rather than 10. - --- --- Solutions 15.6-7 --- - --- Just walk through the definitions - --- --- Solution 15.8 --- - -mergeSort :: Ord a => [a] -> [a] - -mergeSort [] = [] - -mergeSort [x] = [x] - -mergeSort xs - = mergeOrd (mergeSort left) (mergeSort right) - where - (left,right) = splitAt (length xs `div` 2) xs - -mergeOrd :: Ord a => [a] -> [a] -> [a] - -mergeOrd [] ys = ys -mergeOrd xs [] = xs -mergeOrd (x:xs) (y:ys) - | x a -> Bool) -> [a] -> [a] - -mergeSort' _ [] = [] - -mergeSort' _ [x] = [x] - -mergeSort' f xs - = mergeOrd' f (mergeSort' f left) (mergeSort' f right) - where - (left,right) = splitAt (length xs `div` 2) xs - -mergeOrd' :: (a -> a -> Bool) -> [a] -> [a] -> [a] - -mergeOrd' _ [] ys = ys -mergeOrd' _ xs [] = xs -mergeOrd' f (x:xs) (y:ys) - | x `f` y = x : mergeOrd' f xs (y:ys) - | otherwise = y : mergeOrd' f (x:xs) ys - --- --- Solution 15.11 --- - --- already in MakeTree.hs - --- --- Solution 15.12 --- - --- Stadard calculation. - --- --- Solution 15.13 --- - --- showTable is a standard layout problem. - -showTree :: Tree -> String - -showTreeInd :: Int -> Tree -> String - -showTree = showTreeInd 0 - -showTreeInd n (Leaf ch int) = replicate n ' ' ++ show ch ++ ": " ++ show int ++"\n" -showTreeInd n (Node m t1 t2) = showTreeInd (n+4) t1 ++ - replicate n ' ' ++ show n ++ - showTreeInd (n+4) t2 - --- --- Solution 15.14 --- - --- Basic property to expect is that (decode.code) is the identity function, or --- decode (code string) = string --- But need the string to come from the elements in the code tree. Alternatively --- can just left the coding function drop anything unrecodgnised, and then compare --- the results of decode.code with the string with the unrecognised characters --- removed. This means don't have to write a special generator, but means that most --- of the tests are effectively on the empty list. - --- --- Solution 15.15 --- - -sorted :: [Int] -> Bool - -sorted [] = True -sorted [x] = True -sorted (x:y:zs) = x<=y && sorted (y:zs) - --- --- Solution 15.16 --- - --- Pretty open-ended. Note discussion for 15.14 above. Often different ways of --- solving the same problem. - --- --- Solution 15.17 --- - --- an example is given in 15.14. - --- --- Solution 15.18 --- - --- It's possible to write a property / test of whether a sequence of L's and R's is --- a valid code. For the abt tress above, would have LL as a valid code sequence but --- not LR, as this should be LRL or LRR. Any sequence is a valid initial segment, so --- can be extended to a valid code. Once that's done, then should expect that --- code.decode is also the identity (on that subset). - - - - - - - - - - diff --git a/Chapter15/Test.hs b/Chapter15/Test.hs deleted file mode 100644 --- a/Chapter15/Test.hs +++ /dev/null @@ -1,34 +0,0 @@ -------------------------------------------------------------------------- --- --- Test.hs --- --- The test module of the Huffman example --- --- (c) Addison-Wesley, 1996-2011. --- -------------------------------------------------------------------------- - -module Test where - --- The test module of the Huffman example - -import Main -import Test.QuickCheck -import Data.List ( nub ) - - --- QuickCheck testing - -checkInverse :: String -> Bool - -checkInverse string = - decodeMessage tree (codeMessage table string) == string - where - tree = codes string - table = codeTable tree - --- prop_Hufmann :: String -> Bool - -prop_Hufmann string = - (length (nub string) > 1) ==> checkInverse string - diff --git a/Chapter16/Solutions16.hs b/Chapter16/Solutions16.hs deleted file mode 100644 --- a/Chapter16/Solutions16.hs +++ /dev/null @@ -1,474 +0,0 @@ ------------------------------------------------------------------------------- --- --- Haskell: The Craft of Functional Programming --- Simon Thompson --- (c) Addison-Wesley, 2011. --- --- Solutions16 --- ------------------------------------------------------------------------------- - -module Solutions16 where - -import Tree -import UseTree - --- The type Var. - -type Var = Char - --- --- Solution 16.1 --- - --- The implementation here has names suffixed with "S" - -type StoreS = [(Var, Integer)] - -initialS :: StoreS - -initialS = [] - --- Note that in case the variable isn't bound, returns 0. - -valueS :: StoreS -> Var -> Integer - -valueS [] v = 0 - -valueS ((w,n):sto) v - | w Var -> Integer -> StoreS - -updateS [] v n = [(v,n)] - -updateS ((w,m):sto) v n - | w Var -> Maybe Integer - -valueS' [] _ = Nothing - -valueS' ((w,n):sto) v - | w Var -> Bool - -hasVal [] _ = False - -hasVal ((w,n):sto) v - | w Priority -> PriQ a -> PriQ a - -addPQ x p [] = [(p,[x])] -addPQ x p qs@((q,ys):rest) - | p>q = (p,[x]):qs - | p==q = (q,ys++[x]):rest - | p (Maybe a, PriQ a) - -remPQ q - | isEmptyPQ q = (Nothing, q) - | otherwise = (Nothing, []) - --- --- Solution 16.13 --- - --- Once accumulated the scores of each letter can put into a priority queue; this --- could help in tree building. - --- --- Solution 16.14 --- - --- Can define isNil from isNode, and vice versa - --- Can define isNil from minTree: it will return Nothing iff tree is Nil. - --- Given any (finite) tree value t where elements are in Ord a can define nil thus: - -{- -makeNil :: Ord a => Tree a -> Tree a -makeNil t - | res == Nothing = t - | otherwise = makeNil (delete min t) - where - res = minTree t - Just min = res --} - --- --- Solution 16.15 --- - --- Depends a bit on what the database is to do, but need lookups and updates, as --- well as initial value. Can define e.g. number of loans from the interface functions. - --- --- Solution 16.16 --- - --- Two sorts of interface here - --- Using an existing index: take word to page range. Take page to all entries, perhaps? - --- Building an index: take a text to an index. - --- --- Solution 16.17 --- - --- QueueState: --- can define queueEmpty from queueLength - --- ServerState: --- can define simulationStep using serverStep, shortestQueue and addToQueue --- is it enough to have simulationStep, serverStart and serverSize? certainly --- it is to actually run the simulation step by step. - --- --- Solution 16.18 --- - --- In the light of the previous answer, it would be enough to include --- simulationStep, serverStart and serverSize in an interface, and to have --- the "next queue" as an element of the state, but not directly accessible --- from the interface: - --- type NextState = Int --- newtype ServerState = SS ([QueueState],NextState) - --- Alternatively if more is to be exposed, then need a function to reveal --- the current value of the "next state - --- --- Solutions 16.19,20 --- - --- Standard calculations. - --- --- Solution 16.21 --- - --- QueueState: running the queue to completion on a list of n inputs --- should produce a list of n outputs, processed in order in which they --- arrived. In order to do this need to define a number of auxiliary --- functions, the major one being a funciton to run the queue to --- completion on an input list. - --- Need to take account here of the arrival times: can't expect to --- process something (at least) until it has arrived. Halt processing when --- there are no more input messages to process and the queue itself is --- empty. - --- --- Solution 16.22 --- - --- Need to know how many queues there are, and can't tell this from an --- arbitrary function of type (Int -> QueueState); need to pair this function --- with an Int telling you the number of queues. Once that's there, replace --- accessing a queue by list indexing and instead just use function application. --- e.g. in the definition of addToQueue don't have to split the list up, --- operate on one element and then form another list; instead simply change the --- value of the function on argument n. - --- --- Solution 16.23 --- - --- See solution 16.17 above. - --- --- Solutions 16.24-25 --- - --- See solution 16.18 above. - --- --- Solution 16.26 --- - --- A different version of the round robin implemetation --- will keep a, ordered list of (Int,Queue) pairs and ensure that --- the current/next queue is always at the head. - --- --- Solution 16.27,28 --- - --- There are two approaches here: could test the accessor, selector --- and discriminator functions, but we should be able to assume these --- are ok. Here we test for the top level properties of how elementhood --- interacts with insertion and deletion: - -prop_add_tree :: Int -> Int -> Tree Int -> Bool - -prop_add_tree n m t - = elemT n t == elemT n (insTree m t) || n==m - -prop_delete_tree :: Int -> Int -> Tree Int -> Bool - -prop_delete_tree n m t - = elemT n t == elemT n (delete m t) || n==m - --- Could also check that the minTree function indeed picks the minimum --- value in the tree by comparing it with the nth value in the tree: - -prop_min_tree :: Integer -> Tree Int -> Bool - -prop_min_tree i t - = let Just min = minTree t in - min <= indexT i t || isNil t -- || "i not valid" - --- would be easier for this to be defined if indexT returned a Maybe a --- indicating whether or not the index is in range: exercise. - --- --- Solution 16.29 --- - -{- -successor :: Ord a => a -> Tree a -> Maybe a - -successor v Nil = Nothing -successor v (Node x t1 t2) - | x<=v = successor v t2 - | otherwise = case maxT t1 of - Nothing -> x - Just y -> if y>v - then successor v t1 - else x - -maxT :: Ord a => Tree a -> Maybe a - -maxT Nil = Nothing -maxT (Node x _ Nil) = Just x -maxT (Node x _ t2) = maxT t2 --} - --- --- Solution 16.30 --- - --- Stree is defined on p398. - --- The paradigm for the solution is given on p398 --- where it is shown that the new field gives the value it --- should, while the other functions need to maintain that --- value. - --- --- Solution 16.31 --- - --- Built on the model of Stree: need to make sure that the --- functions manipulate the "cached" values appropriately. - --- This is not caching the size, incidentally. - -data MMtree a = NilMM | NodeMM a a a (MMtree a) (MMtree a) - -insTreeMM :: Ord a => a -> MMtree a -> MMtree a - -insTreeMM val NilMM = NodeMM val val val NilMM NilMM - -insTreeMM val (NodeMM x minV maxV t1 t2) - | val<=x = NodeMM x newMin maxV newT1 t2 - | val>x = NodeMM x minV newMax t1 newT2 - where - newMin = min val minV - newMax = max val maxV - newT1 = insTreeMM val t1 - newT2 = insTreeMM val t2 - --- Note that because of lazy evaluation (Chapter 17) in each --- case will only compute one of newMin / newMax and newT1 / newT2 --- according to the relation between val and x, the value at the --- root of the tree. - --- --- Solution 16.32 --- - --- The implentation type could remain the same, but it would be better to --- store an occurrence count with each element (with the assumption --- that no element occurs more than once). - --- If the implementation type remains the same, then need to scan for all --- occurrences of a particular element when looking for its occurrence --- count. - --- Should extend the interface with an element occurrence function, rather --- than simply checking elementhood. This effectively gives "bags" rather --- than "sets". - --- --- Solution 16.33 --- - --- Search trees keep the implementation ordered. This is a straightforward --- re-implementation of the application. - --- --- Solution 16.34 --- - --- This solution takes a different approach. Update the b value by passing in --- an update function, of type (b -> b), to the insertion. This is applied to, e.g. --- add an instance of a word to a list of instances, so might be (++[newOccurrence]) --- in that case. - -data GenTree a b = GenNil b - | GenNode a b (GenTree a b) (GenTree a b) - -insertGenTree :: Ord a => a -> (b -> b) -> GenTree a b -> GenTree a b - -insertGenTree x f (GenNil b) - = GenNode x (f b) (GenNil b) (GenNil b) - -insertGenTree x f (GenNode a b t1 t2) - | x==a = GenNode a (f b) t1 t2 - | xa = GenNode a b t1 (insertGenTree x f t2) - --- --- Solution 16.35 --- - --- One gives a total ordering, but of less value than a (partial) subset ordering. - --- --- Solutions 16.36 - 16.44 SEE SolutionsSet.hs --- - --- --- Solutions 16.45 - 16.50 SEE SolutionsRelation.hs --- - - diff --git a/Chapter16/Store.hs b/Chapter16/Store.hs deleted file mode 100644 --- a/Chapter16/Store.hs +++ /dev/null @@ -1,48 +0,0 @@ -------------------------------------------------------------------------- --- --- Store.hs --- --- An abstract data type of stores of integers, implemented as --- a list of pairs of variables and values. --- --- (c) Addison-Wesley, 1996-2011. --- -------------------------------------------------------------------------- - -module Store - ( Store, - initial, -- Store - value, -- Store -> Var -> Integer - update -- Store -> Var -> Integer -> Store - ) where - --- Var is the type of variables. - -type Var = Char - --- The implementation is given by a newtype declaration, with one --- constructor, taking an argument of type [ (Integer,Var) ]. - -data Store = Store [ (Integer,Var) ] - -instance Eq Store where - (Store sto1) == (Store sto2) = (sto1 == sto2) - -instance Show Store where - showsPrec n (Store sto) = showsPrec n sto --- -initial :: Store - -initial = Store [] - -value :: Store -> Var -> Integer - -value (Store []) v = 0 -value (Store ((n,w):sto)) v - | v==w = n - | otherwise = value (Store sto) v - -update :: Store -> Var -> Integer -> Store - -update (Store sto) v n = Store ((n,v):sto) - diff --git a/Chapter19/.DS_Store b/Chapter19/.DS_Store new file mode 100644 Binary files /dev/null and b/Chapter19/.DS_Store differ diff --git a/Chapter19/._.DS_Store b/Chapter19/._.DS_Store new file mode 100644 Binary files /dev/null and b/Chapter19/._.DS_Store differ diff --git a/Chapter19/ParseLib.hs b/Chapter19/ParseLib.hs new file mode 100644 --- /dev/null +++ b/Chapter19/ParseLib.hs @@ -0,0 +1,132 @@ +------------------------------------------------------------------------- +-- +-- Haskell: The Craft of Functional Programming, 3e +-- Simon Thompson +-- (c) Addison-Wesley, 1996-2011. +-- +-- ParseLib.hs +-- +-- Library functions for parsing +-- Note that this is not a monadic approach to parsing. +-- +--------------------------------------------------------------------------- + +module ParseLib where + +import Data.Char + +infixr 5 >*> +-- +-- The type of parsers. +-- +type Parse a b = [a] -> [(b,[a])] +-- +-- Some basic parsers +-- +-- +-- Fail on any input. +-- +none :: Parse a b +none inp = [] +-- +-- Succeed, returning the value supplied. +-- +succeed :: b -> Parse a b +succeed val inp = [(val,inp)] +-- +-- token t recognises t as the first value in the input. +-- +token :: Eq a => a -> Parse a a +token t (x:xs) + | t==x = [(t,xs)] + | otherwise = [] +token t [] = [] +-- +-- spot whether an element with a particular property is the +-- first element of input. +-- +spot :: (a -> Bool) -> Parse a a +spot p (x:xs) + | p x = [(x,xs)] + | otherwise = [] +spot p [] = [] +-- +-- Examples. +-- +bracket = token '(' +dig = spot isDigit + +-- Succeeds with value given when the input is empty. + +endOfInput :: b -> Parse a b +endOfInput x [] = [(x,[])] +endOfInput x _ = [] +-- +-- Combining parsers +-- +-- +-- alt p1 p2 recognises anything recogniseed by p1 or by p2. +-- +alt :: Parse a b -> Parse a b -> Parse a b +alt p1 p2 inp = p1 inp ++ p2 inp +exam1 = (bracket `alt` dig) "234" +-- +-- Apply one parser then the second to the result(s) of the first. +-- + +(>*>) :: Parse a b -> Parse a c -> Parse a (b,c) +-- +(>*>) p1 p2 inp + = [((y,z),rem2) | (y,rem1) <- p1 inp , (z,rem2) <- p2 rem1 ] +-- +-- Transform the results of the parses according to the function. +-- +build :: Parse a b -> (b -> c) -> Parse a c +build p f inp = [ (f x,rem) | (x,rem) <- p inp ] +-- +-- Recognise a list of objects. +-- +-- +list :: Parse a b -> Parse a [b] +list p = (succeed []) + `alt` + ((p >*> list p) `build` convert) + where + convert = uncurry (:) +-- +-- Some variants... + +-- A non-empty list of objects. +-- +neList :: Parse a b -> Parse a [b] +neList p = (p `build` (:[])) + `alt` + ((p >*> list p) `build` (uncurry (:))) + +-- Zero or one object. + +optional :: Parse a b -> Parse a [b] +optional p = (succeed []) + `alt` + (p `build` (:[])) + +-- A given number of objects. + +nTimes :: Int -> Parse a b -> Parse a [b] +nTimes 0 p = succeed [] +nTimes (n+1) p = (p >*> nTimes n p) `build` (uncurry (:)) +-- +-- Monadic parsing + +data SParse a b = SParse (Parse a b) + +instance Monad (SParse a) where + return x = SParse (succeed x) + (SParse pr) >>= f + = SParse (\st -> concat [ sparse (f a) rest | (a,rest) <- pr st ]) + +sparse :: SParse a b -> Parse a b + +sparse (SParse pr) = pr + + diff --git a/Chapter19/Solutions19.hs b/Chapter19/Solutions19.hs deleted file mode 100644 --- a/Chapter19/Solutions19.hs +++ /dev/null @@ -1,227 +0,0 @@ ------------------------------------------------------------------------------- --- --- Haskell: The Craft of Functional Programming --- Simon Thompson --- (c) Addison-Wesley, 2011. --- --- Solutions19 --- ------------------------------------------------------------------------------- - -module Solutions19 where - -import RegExp -import ParseLib -import Data.Char (isLower) -import Test.QuickCheck -import QC -import QCfuns - --- --- Solution 19.1 --- - -interp :: RE -> RegExp - -interp Eps = epsilon -interp (Ch ch) = char ch -interp (e1 :|: e2) = interp e1 ||| interp e2 -interp (e1 :*: e2) = interp e1 <*> interp e2 -interp (St e) = star (interp e) -interp (Plus e) = i <*> star i - where - i = interp e - --- --- Solution 19.2 --- - --- First pretty printing, which shows the grammar used. --- 'e' is the syntax for epsilon, here. - -prettyRE :: RE -> String - -prettyRE Eps = "e" -prettyRE (Ch ch) = [ch] -prettyRE (e1 :|: e2) = "("++ prettyRE e1 ++"|"++ prettyRE e2 ++ ")" -prettyRE (e1 :*: e2) = "("++ prettyRE e1 ++ prettyRE e2 ++ ")" -prettyRE (St e) = "("++ prettyRE e ++ ")*" -prettyRE (Plus e) = "("++ prettyRE e ++ ")+" - --- Little parsers - -epsP, charP :: Parse Char RE - -epsP = spot (=='e') `build` const Eps - -charP = spot isLowerNoE `build` Ch - -isLowerNoE ch = isLower ch && ch/='e' - -altP :: Parse Char RE -> Parse Char RE -> Parse Char RE - -altP p1 p2 - = (spot (=='(') >*> - p1 >*> - spot (=='|') >*> - p2 >*> - spot (==')')) - `build` - \ (_,(e1,(_,(e2,_)))) -> e1 :|: e2 - -seqP :: Parse Char RE -> Parse Char RE -> Parse Char RE - -seqP p1 p2 - = (spot (=='(') >*> - p1 >*> - p2 >*> - spot (==')')) - `build` - \ (_,(e1,(e2,_))) -> e1 :*: e2 - - -starP :: Parse Char RE -> Parse Char RE - -starP p - = (spot (=='(') >*> - p >*> - spot (==')') >*> - spot (=='*')) - `build` - \ (_,(e,(_,_))) -> St e - --- pulling them together - -reP :: Parse Char RE - -reP = epsP - `alt` - charP - `alt` - altP reP reP - `alt` - seqP reP reP - `alt` - starP reP - --- top-level function. - -parseRE :: String -> RE - -parseRE st - = e - where - [(e,"")] = reP st - --- Expected property: the two functions are inverses of each other, when applied to legal --- representations of strings. - --- To test in QuickCheck, note that it's difficult to generate legal strings directly, --- instead best to generarte REs and turn them into legal strings. - --- --- Solution 19.3 --- - -palin :: RE - -palin = (middle :|: (a :*: (palin :*: a))) :|: (b :*: (palin :*: b)) - -middle = (Eps :|: (a :|: b)) - --- --- Solution 19.4 --- - --- Just follow the pattern of recursion used in the definition of reP above. --- Works just like 19.3. - --- --- Solution 19.5 --- - --- I believe that "recursive regular expressions" = "context free grammars" and --- so this set of strings will therefore not be representable. - --- --- Solution 19.6 --- - --- What does extension mean? Add a construct to RE and then extend its --- interpretations into RegExp, enumeration, concrete syntax etc. - --- MatchN Int RE, interpreted by - -matchN :: Int -> RegExp -> RegExp - -matchN n re - | n<=0 = epsilon - | otherwise = re <*> matchN (n-1) re - ---- Ranges etc. are all pretty straightforward. - --- --- Solution 19.7 --- - ---- Actually not so difficult to implement ... - -matchBoth :: RegExp -> RegExp -> RegExp - -matchBoth re1 re2 st - = re1 st && re2 st - -matchNot :: RegExp -> RegExp - -matchNot re st - = not (re st) - --- --- Solutions 19.8-10 --- - --- See the module PositionedImages.hs - --- --- Solution 19.11 --- - --- This was discussed in Solutions12, question 12.19. - --- --- Solution 19.12 --- - -samplePretty :: IO () - -samplePretty - = do exprs <- sample' (arbitrary :: Gen Expr) - printLines (map ((++"\n").prettyE) exprs) - -printLines :: [String] -> IO () - -printLines strs - = if strs == [] - then return () - else do putStr (head strs) - printLines (tail strs) - --- --- Solution 19.13 --- - --- Generators standard. - --- Properties --- - should be able to round trip exp -> pretty -> exp --- - not so obvious how to test the fact that the evaluator gives --- the right result. --- - one idea is to build pairs of expression and their values, which --- are generated simultaneously ,,, of course, that is tantamount --- to defining a second evaluation function (albeit implicitly). - --- --- Solution 19.14 --- - --- Five finger exercise ... diff --git a/Craft3e.cabal b/Craft3e.cabal --- a/Craft3e.cabal +++ b/Craft3e.cabal @@ -1,6 +1,6 @@ name: Craft3e -version: 0.1.0.5 +version: 0.1.0.6 license: MIT license-file: LICENSE copyright: (c) Addison Wesley