commit 4e7d49fe0dd9158fa04c5879f83a4ad817ce6296 Author: Danila Fedorin Date: Sat Apr 17 02:40:32 2021 -0700 Add the first two homework assignments. diff --git a/Hasklet1.hs b/Hasklet1.hs new file mode 100644 index 0000000..d1cd521 --- /dev/null +++ b/Hasklet1.hs @@ -0,0 +1,143 @@ +module Hasklet1 where + + +-- | A generic binary tree with values at internal nodes. +data Tree a = Node a (Tree a) (Tree a) + | Leaf + deriving (Eq,Show) + + +-- | Build a balanced binary tree from a list of values. +tree :: [a] -> Tree a +tree [] = Leaf +tree (x:xs) = Node x (tree l) (tree r) + where (l,r) = splitAt (length xs `div` 2) xs + + +-- Some example trees containing integers. +t1, t2, t3, t4 :: Tree Int +t1 = Node 1 Leaf (Node 2 Leaf Leaf) +t2 = Node 3 (Node 4 Leaf Leaf) Leaf +t3 = Node 5 t1 t2 +t4 = tree (filter odd [1..100]) + +treeFold :: (a -> b -> b -> b) -> b -> Tree a -> b +treeFold _ b Leaf = b +treeFold f b (Node a t1 t2) = f a (treeFold f b t1) (treeFold f b t2) + +-- An example tree containing a secret message! +t5 :: Tree Char +t5 = tree " bstyoouu rd oerrvialentikne" + + +-- | Define a recursive function that sums the numbers in a tree. +-- +-- >>> sumTree Leaf +-- 0 +-- +-- >>> sumTree t3 +-- 15 +-- +-- >>> sumTree t4 +-- 2500 +-- +sumTree :: Num a => Tree a -> a +sumTree Leaf = 0 +sumTree (Node a t1 t2) = a + sumTree t1 + sumTree t2 + + +-- | Define a recursive function that checks whether a given element is +-- contained in a tree. +-- +-- >>> contains 57 t4 +-- True +-- +-- >>> contains 58 t4 +-- False +-- +-- >>> contains 'k' t5 +-- True +-- +-- >>> contains 'z' t5 +-- False +-- +contains :: Eq a => a -> Tree a -> Bool +contains _ Leaf = False +contains v (Node a t1 t2) = v == a || contains v t1 || contains v t2 + + +-- | Define a function for converting a binary tree of type 'Tree a' into +-- a value of type 'b' by folding an accumulator function over the tree. +-- You should start by writing a type definition for the function. +-- +-- Note there is more than one correct type for this function! Part of your +-- task is to figure out the type. For inspiration, think about the types of +-- the functions `foldl` and `foldr` for lists. +-- +foldTree :: (a -> b -> b -> b) -> b -> Tree a -> b +foldTree _ b Leaf = b +foldTree f b (Node a t1 t2) = f a (foldTree f b t1) (foldTree f b t2) + + +-- | Use 'foldTree' to define a new version of 'sumTree'. +-- +-- >>> sumTreeFold Leaf +-- 0 +-- +-- >>> sumTreeFold t3 +-- 15 +-- +-- >>> sumTreeFold t4 +-- 2500 +-- +sumTreeFold :: Num a => Tree a -> a +sumTreeFold = foldTree ((.(+)).(.).(+)) 0 + + +-- | Use 'foldTree' to define a new version of 'contains'. +-- +-- >>> containsFold 57 t4 +-- True +-- +-- >>> containsFold 58 t4 +-- False +-- +-- >>> containsFold 'v' t5 +-- True +-- +-- >>> containsFold 'q' t5 +-- False +-- +containsFold :: Eq a => a -> Tree a -> Bool +containsFold v = foldTree (\a b c -> a == v || b || c) False + + +-- | Implement a function that returns a list of values contained at each +-- level of the tree. That is, it should return a nested list where the +-- first list contains the value at the root, the second list contains the +-- values at its children, the third list contains the values at the next +-- level down the tree, and so on. +-- +-- Apply this function to 't5' to reveal the secret message! +-- +-- >>> levels Leaf +-- [] +-- +-- >>> levels t1 +-- [[1],[2]] +-- +-- >>> levels t2 +-- [[3],[4]] +-- +-- >>> levels t3 +-- [[5],[1,3],[2,4]] +-- +-- >>> levels (tree [1..10]) +-- [[1],[2,6],[3,4,7,9],[5,8,10]] +-- +levels :: Tree a -> [[a]] +levels = foldTree (\a b c -> [a] : padded b c) [] + where + padded [] xs = xs + padded xs [] = xs + padded (x:xs) (y:ys) = (x ++ y) : padded xs ys diff --git a/Hasklet1.md b/Hasklet1.md new file mode 100644 index 0000000..5943213 --- /dev/null +++ b/Hasklet1.md @@ -0,0 +1,144 @@ +# Ben +I was surprised to see how different our solutions were! Usually for "day 1" exercises, +most answers come out pretty similar, especially for people who feel pretty comfortable +with Haskell. But hey, more things to talk about! + +* In your `sumTree`, you used a `foldr`. To me, this is kind of weird - + I see your "or ..." comment, and I much prefer the version there which + uses a simple summation. Setting aside whatever magic optimiztions + GHC has in store for us, the version you have uncommneted + will create an intermediate list, and possibly also + an unevaluated "thunk" of the `foldr` application + (instead of just adding numbers). It seems like a lot of work, + and is, in my opinion, _less_ expresive than the "simple" version. +* In your `containsTree`, you have the following: `| x == y = True`. + This is reminiscent of a C-style `x ? true : false`. I would say this + is an antipattern - returning true of something is the case, and + trying another condition of it's not, is exactly the way that a short-circuiting + `(||)` operator behaves. I think a simple `||` would suffice. +* You defined a function `cx` for `contains x`. This is quite cool: it helps + save on a lot of repetition! In this case, I think it's less valuable: + there's a maxim that I heard, "if you need to write something twice, + cringe and write it twice. If you need to write something more than that, + abstract it". In this case, I think the `cx` abstraction is not worth the effort. + Haskell's effortless creation of closures is pretty cool, though: suppose + that it was the _leaves_ that contained data (such an example would be more convincing): + + ```Haskell + data Tree a = Leaf a | Node (Tree a) (Tree a) + ``` + + You could then define a `containsTree` function like this: + + ```Haskell + containsTree :: Eq a => a -> Tree a -> Bool + containsTree a = ct + where + ct (Leaf x) = a == x + ct (Node l r) = ct l || ct r + ``` + + Note that here we no longer need to pass around the `a` in recursive calls. + This would become especially good if `Tree` had more cases (which would all have recursive + calls). We used this in `Xtra` to implement the evaluation function for expressions - + instead of passing around the environment `env`, we captured it like we captured `a` in the above example. +* You defined your `foldTree` differently from the way I did it. As Eric said, there are multiple + approaches to doing this, so I wouldn't say either of us is wrong. Tradeoff wise, your solution + imposes an order on the elements of the tree: in effect, it converts them to a flat list: + you can _really_ see this if you do `foldTree (flip (:)) []`. This makes it easy to express + sequential computations, like for instance those for `sum` and `contains`. In fact, you can + even re-use list-based functions like so: + ```Haskell + toList = foldTree (flip (:)) [] + sumTree = sum . toList + containsTree a = contains a . toList + ``` + In short, your approach makes it really easy to express some computations. However, unlike + `fold` for lists, you cannot use `foldTree` to define any function on trees. Consider + the simple example of `depth`, and two trees: + * `Node 1 (Node 2 (Node 3 Leaf Leaf) Leaf) Leaf` + * `Node 1 (Node 2 Leaf Leaf) (Node 3 Leaf Leaf)` + + If you run them through `toList`, you'll notice that they produce the same result. Your + `b -> a -> b` function is seeing the exact same order of inputs. However, the trees obviously + have different depth: the first one has depth 2, and the second has depth 3. + + My approach is different: I aimed to define the most general function on trees. I think that + this is called a catamorphism. Were you there on the day we read the _Bananes, Lenses and Barbed + Wire_ paper in reading group? It's like that. This ends up with a different signature than + the `fold` for lists, but it makes it possible to define _any_ function for lists. For example, + here's that depth function I mentioned earlier: + ```Haskell + depth = foldTree (\_ l r -> 1 + max l r) 1 + ``` + And, of course, my `levels` function is also implemented using `foldTree`, though + I did need to define an auxillary function for zipping lists. This has the downside + of making some "linear" code (like summations and "contains") look a little + uglier. My function parameters were `(\a b c -> a + b + c)` and `(\a b c -> a == n || b || c)` + for sum and contains respectively, and that's a little less pretty than, say, `(+)`. + Don't mind that I wrote my `a + b + c` function as `((.(+)).(.).(+))`: I was + just playing around with point-free style. + + Interestingly, if you recall Church encoding from CS 581, you will notice that + the "type" of a Church encoded list is `(a -> b -> b) -> b -> b`, and + the type of a Church encoded tree as ours is `(a -> b -> b -> b) -> b -> b`. + There's a connection between the representation of our data structure and + the most general function on that data structure. +* I didn't think of your approach to `levels`! I have a question about it, + though: For a complete tree of depth `n`, doesn't your approach perform + `n` traversals of the tree, once for each depth? This would mean you + check `1 + (1 + 2) + (1 + 2 + 4) + ...` nodes while running this function, + doesn't it? + +# Ashish +Hey there! I've got some case-by-case thoughts about your submission. + +* In your `containsTree`, you write `if (n == m) then True else ...`. As I mentioned + to Ben, this is very similar to writing `n == m ? true : false` in C/C++: I'd + say it's a bit of an antipattern. Specifically, the short-circuiting `||` operator + will do exactly that; you can write `n == n || ...`, instead. +* There's a slight issue with your `foldTree` function, which is what caused + to have trouble with `containsFold`. Take a look at your signature: + ```Haskell + foldTree :: (a -> a -> a) -> a -> Tree a -> a + ``` + Note the very last part: `Tree a -> a`. This means that you can only + use your `treeFold` function to produce _the same type of values that + are in the tree_! This works for `sumTreeFold`, because numbers are closed + under addition; it doesn't, however, work for `containsTreeFold`, since + even if your tree contains numbers, you'd need to produce a boolean, + which is a different type! The simple solution is to introduce a type variable `b` + alongside `a`. This is strictly more general than using only `a` everywhere: + `b` can be equal to `a` (much like `x` and `y` can be equal in an equation), + but it can also be different. Thus, your `sumTreeFold` would still work, + but you'd be able to write `containsTreeFold` as well. I think Ben's + solution is exactly what you were going for, so it doesn't make sense for + me to re-derive it here. +* I'm really having trouble understanding your attempted solution for `levels`. + If you're strill trying to figure it out, here's how I'd do it. + + * For a leaf, there are no levels, so your solution would just be `[]`. + * For a node in the form `Node n lt rt`, your solution would + have the form `[n] : lowerLevels`. But how do you get `lowerLevels`? + Suppose that `lt` has the levels `[1,2], [3,4,5,6]` and `rt` has the levels + `[7, 8], [9, 10, 11, 12]`. You want to combine each corresponding level: + `[1,2]` with `[7,8]`, and `[3,4,5,6]` with `[9,10,11,12]`. This is + _almost_ like the function `zipWith` from the standard library in Haskell; + However, the problem is that `zipWith` stops recursing when the shorter list + runs out. We don't want that: even if the left side of the tree has no more levels, + if the right side does, we want to keep them. Thus, we define the following function: + ```Haskell + myZipWith :: [[a]] -> [[a]] -> [[a]] + myZipWith [] [] = [] -- two empty lists means we've run out of levels on both ends, so we're done. + myZipWith (l:ls) (m:ms) = (l ++ m) : myZipWith ls ms -- Combine the first levels from both lists, and recurse. + myZipWith [] ls = ls -- We ran out of levels on the left, so only the right levels occur from here on. + myZipWith ls [] = ls -- We ran out of levels on the right, so only the left levels occur from here on. + ``` + Our final function implementation is then: + ```Haskell + levels Leaf = [] + levels (Node m lt rt) = [m] : lowerLevels + where lowerLevels = myZipWith lt rt + ``` + I implemented mine using my custom `fold`, but in essense it works the same way. My `myZipWith` is + called `padded`, but the implementation is identical to what I showed here. diff --git a/Hasklet2.hs b/Hasklet2.hs new file mode 100644 index 0000000..b27c8d4 --- /dev/null +++ b/Hasklet2.hs @@ -0,0 +1,177 @@ +{-# LANGUAGE LambdaCase #-} +module Hasklet2 where +import Control.Applicative (liftA2) +import qualified Control.Applicative as CA +import Data.Bifunctor + +-- +-- * Parser type +-- + +-- | Given a string, a parser either fails or returns a parsed value and +-- the rest of the string to be parsed. +newtype Parser a = Parser { runParser :: String -> Maybe (a, String) } + +instance Functor Parser where + fmap f (Parser nf) = Parser $ (first f<$>) <$> nf + +instance Applicative Parser where + pure v = Parser $ Just . (,) v + pf <*> pa = Parser $ \s -> do + (f, s') <- runParser pf s + (v, s'') <- runParser pa s' + return (f v, s'') + +-- +-- * Single character parsers +-- + +-- | Match the end of the input string. +end :: Parser () +end = Parser $ \case + "" -> Just ((), "") + _ -> Nothing + +-- | Return the next character if it satisfies the given predicate. +nextIf :: (Char -> Bool) -> Parser Char +nextIf f = Parser $ \case + (c:s') | f c -> Just (c,s') + _ -> Nothing + +-- | Parse the given character. +char :: Char -> Parser Char +char c = nextIf (c ==) + +-- | Parse one of the given characters. +oneOf :: [Char] -> Parser Char +oneOf cs = nextIf (`elem` cs) + +-- | Parse a particular class of character. +lower, upper, digit, space :: Parser Char +lower = oneOf ['a'..'z'] +upper = oneOf ['A'..'Z'] +digit = oneOf ['0'..'9'] +space = oneOf " \t\n\r" + +-- | Parse a digit as an integer. +digitInt :: Parser Int +digitInt = flip (-) (fromEnum '0') . fromEnum <$> digit + +-- +-- * Alternative and repeating parsers +-- + +-- | Run the first parser. If it succeeds, return the result. Otherwise run +-- the second parser. +-- +-- >>> runParser (upper <|> digit) "Hi" +-- Just ('H',"i") +-- +-- >>> runParser (upper <|> digit) "42" +-- Just ('4',"2") +-- +-- >>> runParser (upper <|> digit) "w00t" +-- Nothing +-- +(<|>) :: Parser a -> Parser a -> Parser a +p1 <|> p2 = Parser $ \s -> runParser p1 s CA.<|> runParser p2 s + + +-- | Parse a sequence of one or more items, returning the results as a list. +-- Parses the longest possible sequence (i.e. until the given parser fails). +-- +-- >>> runParser (many1 lower) "abcDEF123" +-- Just ("abc","DEF123") +-- +-- >>> runParser (many1 lower) "ABCdef123" +-- Nothing +-- +-- >>> runParser (many1 (lower <|> upper)) "ABCdef123" +-- Just ("ABCdef","123") +-- +-- >>> runParser (many1 digitInt) "123abc" +-- Just ([1,2,3],"abc") +-- +many1 :: Parser a -> Parser [a] +many1 p = liftA2 (:) p (many p) + + +-- | Parse a sequence of zero or more items, returning the results as a list. +-- +-- >>> runParser (many lower) "abcDEF123" +-- Just ("abc","DEF123") +-- +-- >>> runParser (many lower) "ABCdef123" +-- Just ("","ABCdef123") +-- +-- >>> runParser (many (lower <|> upper)) "abcDEF123" +-- Just ("abcDEF","123") +-- +-- >>> runParser (many digitInt) "123abc" +-- Just ([1,2,3],"abc") +-- +-- >>> runParser (many digitInt) "abc123" +-- Just ([],"abc123") +-- +many :: Parser a -> Parser [a] +many p = liftA2 (:) p (many p) <|> pure [] + + +-- | Parse a natural number into a Haskell integer. +-- +-- >>> runParser nat "123abc" +-- Just (123,"abc") +-- +-- >>> runParser nat "abc" +-- Nothing +-- +nat :: Parser Int +nat = foldl ((+).(*10)) 0 <$> many1 digitInt + +parenth :: Parser a -> Parser b -> Parser (a, b) +parenth p1 p2 = liftA2 (,) (char '(' *> p1 <* char ',') (p2 <* char ')') + +-- +-- * Parsing structured data +-- + +-- | Parse a pair of natural numbers into a Haskell pair of integers. You can +-- assume there are no spaces within the substring encoding the pair, +-- although you're welcome to try to generalize it to handle whitespace too, +-- e.g. before/after parentheses and the comma. +-- +-- This may get a little bit hairy, but the ugliness here will motivate some +-- key abstractions later. :-) +-- +-- >>> runParser natPair "(123,45) 678" +-- Just ((123,45)," 678") +-- +-- >>> runParser natPair "(123,45" +-- Nothing +-- +-- >>> runParser natPair "(123,x) 678" +-- Nothing +-- +natPair = parenth nat nat + + +-- | A simple tree data structure, isomorphic to arbitrarily nested pairs with +-- integers at the leaves. +data Tree + = Leaf Int + | Node Tree Tree + deriving (Eq,Show) + + +-- | Parse a tree encoded as arbitrarily nested pairs. This is basically just +-- the 'natPair' parser, now with recursion. +-- +-- >>> runParser natTree "((1,2),3) abc" +-- Just (Node (Node (Leaf 1) (Leaf 2)) (Leaf 3)," abc") +-- +-- >>> runParser natTree "(1,((100,101),10))" +-- Just (Node (Leaf 1) (Node (Node (Leaf 100) (Leaf 101)) (Leaf 10)),"") +-- +natTree :: Parser Tree +natTree = (uncurry Node <$> parenth natTree natTree) <|> (Leaf <$> nat) + diff --git a/Hasklet2.md b/Hasklet2.md new file mode 100644 index 0000000..60ce087 --- /dev/null +++ b/Hasklet2.md @@ -0,0 +1,124 @@ +# Phillip +Hey man, long time no... read? Having seen your comment, I don't have anything exceptionally +eye-opening to contribute, but here goes: + +* At first glance, it seemed like it should be _easy_ to simplify all those 4-deep case statements + into a single line, but I don't think that's quite the case. I think that if you were to just + rewrite the `Maybe` code using Haskell's standard functions, you _would_ need to use `Maybe`'s + `Monad` instance, even though I didn't need it for my `Applicative` parser data type. The difference + is in the types. The result of a parser application is `Maybe (a, String)`, and that `String` + argument is used by the next parser. `Applicative`, on the other hand, does not support + making decisions based on the data inside the functor. The signatures for `fmap` and `<*>` + are `(a -> b) -> f a -> f b` and `m (a -> b) -> m a -> mb`: you have to have both the function + and its arguments _before_ you combine them. + + On the other hand, when turning Parser into its own data type, the `String` state-passing can be + hidden away, so instead of `Maybe (a, String)` you'll just have `Parser a`. At the type signature + level, you no longer rely on the "state" (leftover string) in your combinators, so you only need + `Applicative`. + + In short, with `Maybe`, I think the best you can do is something like the following: + + ```Haskell + do + (_, s1) <- char '(' s + (i, s2) <- nat s1 + ... + ``` + Perhaps this reminds you of the [implementation of the State monad](https://wiki.haskell.org/State_Monad#Implementation)? + My intuition is that a Parser is just a combination of the `State` and `Error` monads. + +* I think that your implementation of `natPair` and `natTree` could be refactored a little bit. + In particular, you can abstract the code for parsing "two things in parentheses separated by a comma", + perhaps into a function like `pair :: Parser a -> Parser b -> Parser (a, b)`. If you did that, + your 4-deep chain of case analysis would only occur in one place (in `pair`), and your other + two functions would just call out to it. Applying just this refactoring step, you'd get: + + ```Haskell + natPair = pair nat nat + natTree s = case pair natTree natTree s of + Just ((t1, t2), s') -> Just $ (Node t1 t2, s') + Nothing -> case nat s of + Just (n, s') -> Just $ (Leaf n, s') + Nothing -> Nothing + ``` + + This has all the usual benefits of abstraction which I won't bore you with :-) + +# Jack + +Hey, sorry to see you didn't have time to finish up `natTree`. I've got a few comments: + +* Your `(<|>)` implementation is actually nearly identical to `Maybe`'s implementation + of `Alternative`'s `(<|>)`. In particular, you're effectively (lazily) combining two + `Maybe` values, one from `p1` and one from `p2`. Thus, you can actually write that + whole function as `p1 (<|>) p2 = \s -> p1 s (<|>) p2 s`. Well, except that + then you have an ambiguous reference to `(<|>)`, so you have to qualify it, + like `Control.Applicative.(<|>)`. + +* You probably know this, but your helper functions `parseMap`, `ifTranP`, and `addP` + are specializations of the standard functions `fmap`, `(>>=)`, and `liftA2`. + In particular, `addP` is pretty much `liftA2 (:)`. This does, of course, rely + on the `Functor`, `Monad`, and `Applicative` instances being defined + for the `Parser` data type, which requires a bit of handywork given the starter + code. The advantage, though, is getting access to all these fancy combinators + from the standard library (like `*>` and `<*`). Similarly, your `\s -> Just ([], s)` + could be written as `return []`. + +* Our `nat` functions are practically identical! I went with pointfree style again + (I have a bit of a problem, pointfree is not very readable at all), but other than + that, it's scary how close our answers are! + +* The whole "early return" pattern (check for `Just`, compute next `Maybe`, check for `Just` again) + can at the very least be simplified as: + + ```Haskell + natPair s1 = do + (_, s2) <- char '(' s1 + (first, s3) <- nat s2 + (_, s4) <- char ',' s3 + (second, s5) -> case nat s4 + (_, s6) <- char ')' s5 + return $ ((first, second), s6) + ``` + + But wait a moment... we didn't actually do anything with the values of `first` and `second`! + This means that we can generalize this function just a little bit (replace `nat` but an + arbitrary input parser): + + ```Haskell + pair p1 p2 s1 = do + (_, s2) <- char '(' s1 + (first, s3) <- p1 s2 + (_, s4) <- char ',' s3 + (second, s5) -> case p2 s4 + (_, s6) <- char ')' s5 + return $ ((first, second), s6) + ``` + + Now, `natPair` can be written as `pair nat nat` (you can even verify this by some + straightforward equational reasoning). And now that you have that, you can also + define `natTree`. The first version: + + ```Haskell + natTree = pair natTree natTree + ``` + + Alas, this is of type `Parser (Tree, Tree)`, not `Parser Tree`. To combine + the two trees into one, we can use your `parseMap`: + + ```Haskell + natTree = parseMap (uncurry Node) (pair natTree natTree) + ``` + + Oh, but we're missing a base case! We can use the `(<|>)` operator we defined earlier + to define a "fallback" if we can't parse another level of the tree. + + ```Haskell + natTree = parseMap (uncurry Node) (pair natTree natTree) <|> parseMap Leaf nat + ``` + + Two birds with one stone, right? Both `natPair` and `natTree` knocked out + by a single `pair` function. It's true that defining `natPair` is quite + messy, and hard to expand into `natTree`, but stuffing all that complexity + into a helper function helps keep that messiness at bay :-)