From 84b527524716d06973982f05665247ca9e755d84 Mon Sep 17 00:00:00 2001 From: Abhijit Sarkar Date: Mon, 1 Jan 2024 23:44:37 -0800 Subject: [PATCH] Add missing questions --- README.md | 10 +- ninety-nine-haskell.cabal | 2 + src/Arithmetic.hs | 73 ++++++++++++++ src/BinaryTrees2.hs | 22 ++--- src/Lists2.hs | 2 +- src/Lists3.hs | 70 ++++++++++++-- src/Logic.hs | 118 ++++++++++++++++++----- src/Monads.hs | 194 ++++++++++++++++++++++++++++++++++++++ test/ArithmeticSpec.hs | 6 ++ test/Lists3Spec.hs | 8 ++ test/MonadsSpec.hs | 78 +++++++++++++++ 11 files changed, 535 insertions(+), 48 deletions(-) create mode 100644 src/Monads.hs create mode 100644 test/MonadsSpec.hs diff --git a/README.md b/README.md index c0f7d28..7d41a03 100644 --- a/README.md +++ b/README.md @@ -8,11 +8,11 @@ * Questions 11 to 20: [Lists, continued](src/Lists2.hs) -* Questions 21 to 28: [Lists again](src/Lists3.hs) +* Questions 21 to 30: [Lists again](src/Lists3.hs) -* Questions 31 to 41: [Arithmetic](src/Arithmetic.hs) +* Questions 31 to 45: [Arithmetic](src/Arithmetic.hs) -* Questions 46 to 50: [Logic and codes](src/Logic.hs) +* Questions 46 to 53: [Logic and codes](src/Logic.hs) * Questions 54A to 60: [Binary trees](src/BinaryTrees.hs) @@ -20,14 +20,14 @@ * Questions 70B to 73: [Multiway trees](src/MultiwayTrees.hs) +* Questions 74 to 79: [Monads](src/Monads.hs) + * Questions 80 to 89: [Graphs](src/Graphs.hs) * Questions 90 to 94: [Miscellaneous problems](src/Misc.hs) * Questions 95 to 99: [Miscellaneous problems, continued](src/Misc2.hs) -(Though the problems number from 1 to 99, there are some gaps and some additions marked with letters. There are actually only 88 problems.) - ## Running tests ``` diff --git a/ninety-nine-haskell.cabal b/ninety-nine-haskell.cabal index f7184d2..89dee03 100644 --- a/ninety-nine-haskell.cabal +++ b/ninety-nine-haskell.cabal @@ -37,6 +37,7 @@ library Logic Misc Misc2 + Monads MultiwayTrees Parser other-modules: @@ -74,6 +75,7 @@ test-suite ninety-nine-test LogicSpec Misc2Spec MiscSpec + MonadsSpec MultiwayTreesSpec SpecHook Paths_ninety_nine_haskell diff --git a/src/Arithmetic.hs b/src/Arithmetic.hs index c8ef86b..a9c0e6d 100644 --- a/src/Arithmetic.hs +++ b/src/Arithmetic.hs @@ -162,3 +162,76 @@ print a list of all even numbers and their Goldbach composition. -} goldbachList :: Int -> Int -> [(Int, Int)] goldbachList lo hi = [goldbach x | x <- [lo .. hi], even x] + +{- +Problem 42: (**) Modular multiplicative inverse. + +In modular arithmetic, integers a and b being congruent modulo an integer n, +means that a - b = k * n, for some integer k. +Many of the usual rules for addition, subtraction, and multiplication in +ordinary arithmetic also hold for modular arithmetic. + +A multiplicative inverse of an integer a modulo n is an integer x such that +ax is congruent to 1 with respect to n. It exists if and only if a and n +are coprime. + +Write a function to compute the multiplicative inverse x of a given integer a +and modulus n lying in the range 0 <= x < n. +Use the extended Euclidean algorithm. + +https://brilliant.org/wiki/extended-euclidean-algorithm/ +-} +multiplicativeInverse :: (Integral a) => a -> a -> Maybe a +multiplicativeInverse a n + | a >= n = multiplicativeInverse (a `mod` n) n + | r == 1 = Just $ x `mod` n + | otherwise = Nothing + where + (r, x, _) = reduce (n, a) (0, 1) (1, 0) + +reduce :: (Integral a) => (a, a) -> (a, a) -> (a, a) -> (a, a, a) +reduce (0, r') (_, x') (_, y') = (r', x', y') +reduce (r, r') (x, x') (y, y') = reduce (r' - q * r, r) (x' - q * x, x) (y' - q * y, y) + where + q = r' `div` r + +{- +Problem 43: (*) Gaussian integer divisibility. + +A Gaussian integer is a complex number where both the real and imaginary parts are integers. +If x and y are Gaussian integers where y /= 0, then x is said to be divisible by y if there +is a Guassian integer x such that x = yz. + +Determine whether a Gaussian integer is divisible by another. + +ANSWER: TODO. +-} + +{- +Problem 44: (**) Gaussian primes. + +A Gaussian integer x is said to be a Gaussian prime when it has no divisors except for the +units and associates of x. The units are 1, i - 1, and -i. The associates are defined by the +numbers obtained when x is multiplied by each unit. + +Determine whether a Gaussian integer is a Gaussian prime. + +ANSWER: TODO. +-} + +{- +Problem 45: (*) Gaussian primes using the two-square theorem. + +Using Fermat's two-square theorem, it can be shown that a Gaussian integer a + bi +is prime if and only if it falls into one of the following categories: + +\|a| is prime and |𝑎| ≡ 3 mod 4, if 𝑏=0 + +\|b| is prime and |𝑏| ≡ 3 mod 4, if 𝑎=0 + +a^2 + b^2 is prime, if a /= 0 and b /= 0 + +Use this property to determine whether a Gaussian integer is a Gaussian prime. + +ANSWER: TODO. +-} diff --git a/src/BinaryTrees2.hs b/src/BinaryTrees2.hs index 7372986..33418b8 100644 --- a/src/BinaryTrees2.hs +++ b/src/BinaryTrees2.hs @@ -9,14 +9,14 @@ import qualified Data.List.Split as LS import Parser (Parser (..)) import qualified Parser as P --- Problem 61: Count the leaves of a binary tree. +-- Problem 61: (*) Count the leaves of a binary tree. countLeaves :: Tree a -> Int countLeaves Empty = 0 countLeaves (Branch _ l r) = case (l, r) of (Empty, Empty) -> 1 _ -> countLeaves l + countLeaves r --- Problem 61A: Collect the leaves of a binary tree in a list. +-- Problem 61A: (*) Collect the leaves of a binary tree in a list. leaves :: Tree a -> [a] leaves = go [] where @@ -25,7 +25,7 @@ leaves = go [] (Empty, Empty) -> x : acc _ -> go (go acc r) l --- Problem 62: Collect the internal nodes of a binary tree in a list. +-- Problem 62: (*) Collect the internal nodes of a binary tree in a list. internals :: Tree a -> [a] internals = go [] where @@ -34,7 +34,7 @@ internals = go [] (Empty, Empty) -> acc _ -> x : go (go acc r) l --- Problem 62B: Collect the nodes at a given level in a list. +-- Problem 62B: (*) Collect the nodes at a given level in a list. atLevel :: Tree a -> Int -> [a] atLevel = go [] where @@ -43,7 +43,7 @@ atLevel = go [] | level == 1 = x : acc | otherwise = go (go acc r (level - 1)) l (level - 1) --- Problem 63: Construct a complete binary tree. +-- Problem 63: (**) Construct a complete binary tree. {- ANSWER: Considering the height H of the tree as the number of edges on @@ -85,7 +85,7 @@ type Pos = (Int, Int) type AnnotatedTree a = Tree (a, Pos) {- -Problem 64: Layout algorithm for displaying trees. +Problem 64: (**) Layout algorithm for displaying trees. In this layout strategy, the position of a node v is obtained by the following two rules: - x(v) is equal to the position of the node v in the inorder sequence @@ -112,7 +112,7 @@ height Empty = -1 height (Branch _ l r) = 1 + max (height l) (height r) {- -Problem 65: Layout algorithm for displaying trees (part 2). +Problem 65: (**) Layout algorithm for displaying trees (part 2). ANSWER: In this problem, no two nodes share the same Y-coordinate. Thus, the X-coordinate of a node is determined by the maximum @@ -147,7 +147,7 @@ layout2 = fst . (go 1 1 =<< (2 *) . height) node = Branch (x, (pos', depth)) left right {- -Problem 66: Layout algorithm for displaying trees (part 3). +Problem 66: (***) Layout algorithm for displaying trees (part 3). The method yields a very compact layout while maintaining a certain symmetry in every node. Find out the rules and write @@ -164,7 +164,7 @@ TODO. -} {- -Problem 67A: A string representation of binary trees. +Problem 67A: (**) A string representation of binary trees. Write a predicate which generates this string representation. Then write a predicate which does this inverse; i.e. given the string representation, construct the tree in the usual form. @@ -210,7 +210,7 @@ treeToString = D.toList . go D.empty D.++ D.singleton ')' {- -Problem 68: Preorder and inorder sequences of binary trees. +Problem 68: (**) Preorder and inorder sequences of binary trees. a) Write predicates preorder and inorder that construct the preorder and inorder sequence of a given binary tree, @@ -258,7 +258,7 @@ preInTree pre = fst . build pre (right, zs) = build ys io'' {- -Problem 69: Dotstring representation of binary trees. +Problem 69: (**) Dotstring representation of binary trees. First, try to establish a syntax (BNF or syntax diagrams) and then write a predicate tree_dotstring which does the diff --git a/src/Lists2.hs b/src/Lists2.hs index 14c9bff..0aafb7a 100644 --- a/src/Lists2.hs +++ b/src/Lists2.hs @@ -44,7 +44,7 @@ Implement the so-called run-length encoding data compression method directly. -} --- Problem 14: Duplicate the elements of a list. +-- Problem 14: (*) Duplicate the elements of a list. dupli :: [a] -> [a] dupli xs = repli xs 2 -- (take 2 . repeat =<<) diff --git a/src/Lists3.hs b/src/Lists3.hs index dfb7e30..9185120 100644 --- a/src/Lists3.hs +++ b/src/Lists3.hs @@ -10,7 +10,7 @@ import Data.List ((\\)) import qualified Data.List as L import qualified System.Random as R --- Problem 21: Insert an element at a given position into a list. +-- Problem 21: (*) Insert an element at a given position into a list. insertAt :: a -> [a] -> Int -> [a] insertAt x xs n | n > 0 = left ++ [x] ++ right @@ -18,7 +18,7 @@ insertAt x xs n where (left, right) = L.splitAt (n - 1) xs --- Problem 22: Create a list containing all integers within a given range. +-- Problem 22: (*) Create a list containing all integers within a given range. range :: Int -> Int -> [Int] range start end | start <= end = [start .. end] @@ -33,7 +33,7 @@ randomElems n m xs let (left, x : right) = L.splitAt (k - 1) xs (x :) <$> randomElems (n - 1) (m - 1) (left ++ right) --- Problem 23: Extract a given number of randomly selected elements from a list. +-- Problem 23: (**) Extract a given number of randomly selected elements from a list. -- Note: This implementation chooses with replacement. rndSelect :: [a] -> Int -> IO [a] rndSelect xs n @@ -48,18 +48,18 @@ randomElem xs = i <&> (xs !!) n = length xs i = R.randomRIO (0, n - 1) --- Problem 24: Draw N different random numbers from the set 1..M. +-- Problem 24: (*) Draw N different random numbers from the set 1..M. -- Note: The selected elements are unique. diffSelect :: Int -> Int -> IO [Int] diffSelect n m = randomElems n m [1 .. m] --- Problem 25: Generate a random permutation of the elements of a list. +-- Problem 25: (*) Generate a random permutation of the elements of a list. rndPerm' :: [a] -> IO [a] rndPerm' xs = randomElems n n xs where n = length xs --- Problem 25: Generate a random permutation of the elements of a list. +-- Problem 25: (*) Generate a random permutation of the elements of a list. {- ANSWER: Alternative imperative solution. @@ -98,7 +98,7 @@ combinations n xs = do return (y : zs) {- -Problem 27a: In how many ways can a group of 9 people +Problem 27a: (**) In how many ways can a group of 9 people work in 3 disjoint subgroups of 2, 3 and 4 persons? Write a function that generates all the possibilities and returns them in a list. @@ -107,7 +107,7 @@ group3 :: (Eq a) => [a] -> [[[a]]] group3 = group [2 .. 4] {- -Problem 27b: In how many ways can a group of 9 people +Problem 27b: (**) In how many ways can a group of 9 people work in disjoint subgroups of the given sizes? Write a function that generates all the possibilities and returns them in a list. @@ -120,12 +120,12 @@ group (i : is) xs = do xxs <- group is (xs \\ ys) return (ys : xxs) --- Problem 28a: Sort the elements of this list according to their length; +-- Problem 28a: (**) Sort the elements of this list according to their length; -- i.e short lists first, longer lists later. lsort :: [[a]] -> [[a]] lsort = L.sortOn length --- Problem 28b: Sort the elements of this list according to their length frequency; +-- Problem 28b: (**) Sort the elements of this list according to their length frequency; -- i.e., lists with rare lengths are placed first, others with a more frequent length come later. lfsort :: [[a]] -> [[a]] lfsort xxs = L.sortOn lenFreq xxs @@ -133,3 +133,53 @@ lfsort xxs = L.sortOn lenFreq xxs ls = map length xxs count x = (length . filter (== x)) ls lenFreq xs = count (length xs) + +{- +Problem 29: (*) Write a function to compute the nth Fibonacci number. +-} +fibonacci :: Int -> Int +fibonacci = go 0 1 + where + go x _ 1 = x + go x y n = go y (x + y) (n - 1) + +-- https://rosettacode.org/wiki/Matrix_multiplication#Haskell +-- Not the most efficient though. +mmult :: (Num a) => [[a]] -> [[a]] -> [[a]] +mmult a b = [[sum $ zipWith (*) ar bc | bc <- L.transpose b] | ar <- a] + +{- +Problem 30: (**) Write a function to compute the nth Fibonacci number. + +Consider the following matrix equation, where F(n) is the nth Fibonacci number: + +\|x2| = |1 1| |F(n+1)| +\|x1| = |1 0| x |F(n) | + +When written out as linear equations, this is equivalent to: + +x2 = F(n+1) + F(n) +x1 = F(n+1) + +So x2 = F(n+2) and x1 = F(n+1). +Together with the associativity of matrix multiplication, this means: + +\|F(n+2)| |1 1| |F(n+1)| |1 1| |1 1| |F(n) | |1 1|^n |F(2)| +\|F(n+1)| = |1 0| x |F(n) | = |1 0| x |1 0| x |F(n-1)| = ... = |1 0| x |F(1)| + +Take advantage of this to write a function which computes the nth Fibonacci number +with O(log n) multiplications. +Compare with the solution for Problems.P29. +-} +fibonacci' :: Int -> Int +fibonacci' n + | n <= 2 = n - 1 + | otherwise = head $ head $ go (n - 2) + where + go i + | i == 1 = xs + | even i = mmult ys ys + | otherwise = mmult xs $ mmult ys ys + where + xs = [[1, 1], [1, 0]] + ys = go (i `div` 2) diff --git a/src/Logic.hs b/src/Logic.hs index 14a7839..969811c 100644 --- a/src/Logic.hs +++ b/src/Logic.hs @@ -85,19 +85,16 @@ Gray code is given by the XOR of the i-th and the (i - 1)th bits of the binary representation of i, where 0 <= i < 2^n. For the example above, n = 2, the corresponding Gray codes are: -0 ^ 0 = 0, 1 ^ 0 = 1, 2 ^ 1 = 3 and, 3 ^ 1 = 2 +0 ^ 0 = 0 (00), 1 ^ 0 = 1 (01), 2 ^ 1 = 3 (11) and, 3 ^ 1 = 2 (10) -} gray :: Int -> [String] -gray n = [P.printf "%0*b" n (y i) | i <- [0 .. x - 1]] +gray n = [P.printf "%0*b" n (g i) | i <- [0 .. x - 1]] where x = 1 `B.shiftL` n :: Int -- 2 ^ n - 1 - y i = i `B.xor` (i `B.shiftR` 1) -- i xor (i `div` 2) - -data Tree = Branch Tree Tree | Leaf Char - deriving stock (Eq, Show) + g i = i `B.xor` (i `B.shiftR` 1) -- i xor (i `div` 2) {- -Problem 50: Given a list of characters and their number of occurrences, +Problem 50: (***) Given a list of characters and their number of occurrences, construct a list of the characters and their Huffman encoding. ANSWER: @@ -115,14 +112,18 @@ removes the original subtrees/symbols from the list, and then adds the new subtr its combined probability to the list. This repeats until there is one tree and all elements have been added. -} -type PQ = HashPSQ String Int Tree + +data HTree = Branch HTree HTree | Leaf Char + deriving stock (Eq, Show) + +type PQ = HashPSQ String Int HTree huffman :: [(Char, Int)] -> [(Char, String)] huffman freq = treeToList $ go $ Q.fromList initial where initial = map (\(c, n) -> ([c], n, Leaf c)) freq - minN :: Int -> PQ -> ([(String, Int, Tree)], PQ) + minN :: Int -> PQ -> ([(String, Int, HTree)], PQ) minN 0 q = ([], q) minN n q = case Q.minView q of Nothing -> ([], q) @@ -130,17 +131,17 @@ huffman freq = treeToList $ go $ Q.fromList initial let (xs, q'') = minN (n - 1) q' in ((k, p, v) : xs, q'') - go :: PQ -> Tree - go q - | Q.null q = error "empty heap" - | Q.size q == 1 = let ((_, _, tree) : _, _) = minN 1 q in tree - | otherwise = do - let ((k1, p1, v1) : (k2, p2, v2) : _, q') = minN 2 q - let node = - if p1 < p2 - then Branch v1 v2 - else Branch v2 v1 - go $ Q.insert (k1 ++ k2) (p1 + p2) node q' + go :: PQ -> HTree + go q = case Q.size q of + 0 -> error "empty heap" + 1 -> let ((_, _, tree) : _, _) = minN 1 q in tree + _ -> do + let ((k1, p1, v1) : (k2, p2, v2) : _, q') = minN 2 q + let node = + if p1 < p2 + then Branch v1 v2 + else Branch v2 v1 + go $ Q.insert (k1 ++ k2) (p1 + p2) node q' {- Although Huffman coding doesn't specify which of the @@ -148,9 +149,84 @@ huffman freq = treeToList $ go $ Q.fromList initial the examples put the smaller value on the left. Also, the examples encode the left branch as 0. -} - treeToList :: Tree -> [(Char, String)] + treeToList :: HTree -> [(Char, String)] treeToList (Leaf x) = [(x, "")] treeToList (Branch l r) = left ++ right where left = map (Bf.second ('0' :)) $ treeToList l right = map (Bf.second ('1' :)) $ treeToList r + +{- +Problem 51: (*) Error correction codes. + +corrupt :: RandomGen g => g -> Int -> [Bool] -> [Bool] + +Flip a given number of boolean values in the boolean list randomly. + +Examples: + >>> corrupt (mkStdGen 111) 2 [False, True, True, False, True] + [False,False,True,True,False] + +errorCorrectingEncode :: [Bool] -> [Bool] + +Construct an error-correcting encoding of the given Boolean list. + +The encoding must be able to correct at least one error. +Consider using a repetition code of length 3. + +errorCorrectingDecode :: [Bool] -> [Bool] + +The inverse of errorCorrectingEncode. Recover the original Boolean list from its encoding. +There could be a single error in the encoding. + +Examples: + + >>> errorCorrectingDecode . errorCorrectingEncode $ [False, False, True, False] + [False,False,True,False] + --- + >>> let e = errorCorrectingEncode [True, False, False, True, False] + >>> let e' = corrupt (mkStdGen 111) 1 e + >>> errorCorrectingDecode e' + [True,False,False,True,False] + +ANSWER: TODO. +-} + +{- +Problem 52: (***) Conjunctive normal form. + +It is known that any boolean function can be represented in conjunctive normal form. +These are conjunctions of disjunctions of literals, where literals are one of boolean +values, variables, or the complement of values or variables. + +Return the conjunctive normal form of a boolean formula. The value returned should +always be a conjunction of disjunctions. + +data Formula + Constructors: + + Value Bool: A constant value. + + Variable String: A variable with given name. + + Complement Formula: Logical complement. I.e., it is true only if its clause is false. + + Disjoin [Formula]: Disjunction. I.e., it is true if any of its clauses are true. + + Conjoin [Formula]: toConjunctiveNormalForm :: Formula -> Formula + +Examples: + >>> toConjunctiveNormalForm $ Value True + Conjoin [Disjoin [Value True]] + + >>> toConjunctiveNormalForm $ Complement $ Disjoin [Variable "X", Variable "Y"] + Conjoin [Disjoin [Complement (Variable "X")],Disjoin [Complement (Variable "Y")]] + +ANSWER: TODO. +-} + +{- +Problem 53: (***) Resolution rule. + +The problem description is a page long, don't even bother. +-} diff --git a/src/Monads.hs b/src/Monads.hs new file mode 100644 index 0000000..b3a20a4 --- /dev/null +++ b/src/Monads.hs @@ -0,0 +1,194 @@ +{-# LANGUAGE DerivingStrategies #-} + +module Monads where + +import qualified Control.Monad as M +import qualified Control.Monad.Identity as Id +import Control.Monad.State (StateT) +import qualified Control.Monad.State as S +import Control.Monad.Writer (Writer) +import qualified Control.Monad.Writer as W +import qualified Data.Maybe as Mb +import Data.Monoid (Sum (..)) +import qualified Data.Monoid as Md + +-- import Control.Monad.Trans.Maybe (MaybeT) + +{- +Problem 74: (**) Monads without do notation. + +We would like to implement a function which reads an even number from standard input, +finds two prime numbers which add up to the number (see Problem 40), and prints out the +equation to standard output. + +Implement the function without do notation. In other words, use >>= or >> directly, +instead of using them implicitly through do notation. +Try to use these functions with prefix style instead of infix style. +-} + +{- +Problem 75: (*) Maybe monad. + +In Problem 74, askGoldbach could not output an error if the input was not a number +or it was not an even number greater than 2. We could implement a function which +returned Nothing when the input is not valid. + +However, the implementation of maybeGoldbach above is a chain of conditional expressions. +It is not problematic in this particular case, but can make things awkward when there are +many conditions and successful operations that need to happen for a function to return a +Maybe value. + +Take advantage of the fact that Maybe is a monad and rewrite maybeGoldbach more succintly +using do notation. The guard function, which in the Maybe monad returns Just () when its +argument is true and Nothing when its argument is false, would be useful for making it +even more succinct. +-} + +{- +Problem 76: (*) Either monad. + +In Problem 75, maybeGoldbach returned Nothing when there is an error. However, this revealed +nothing about why there is an error. + +Rewrite maybeGoldbach to return an Either value, +-} + +{- +Problem 77: (*) List monad. + +Using the list monad, implement a function which returns all the one-dimensional random walk +paths with n steps. Starting from position 0, each step can change positions by -1, 0, or 1. +Each path will be a list of positions starting from 0. + +ANSWER: +ReplicateM creates the cross-product of the given list n times. + +Example: + n=2, [[-1,-1], [-1,0], [-1,1], [0,-1], [0,0], [0,1], [1,-1], [1,0], [1,1]]. + Each of these represents the next step taken, so [-1,-1] means 2 steps from 0, + 0, -1 and -1. The position at each step is given by the sum of itself with + the previous position, i.e. the cumulative sum. + So, 0, -1 and -1 ==> 0, -1, -2. +-} + +randomWalkPaths :: Int -> [[Int]] +randomWalkPaths 0 = [[0]] +randomWalkPaths n = map (scanl (+) 0) $ M.replicateM n [-1, 0, 1] + +{- +Problem 78: (*) Collatz conjecture. + +Starting from a positive integer n, we can have a sequence of numbers such that at each step, +the next number is 3n + 1 if n is odd, or n/2 if n is even. The Collatz conjecture states +that this sequence will always end at 1 after a finite number of steps. + +Using the Writer monad, count the number of these steps for a given positive integer n. +-} + +collatz :: Int -> Int +collatz = Md.getSum . W.execWriter . go + where + -- Writer w a, where there exists + -- a Monoid instance for w. + go :: Int -> Writer (Sum Int) () + go 1 = return () + go n = do + W.tell 1 + if even n + then go (n `div` 2) + else go (3 * n + 1) + +{- +Problem 79: (**) Postfix notation. + +Postfix notation, also known as reverse Polish notation, has operators come after their operands +in mathematical expressions. It has no need for operator precedence or parentheses to specify +evaluation order. + +Evaluation is typically done using a stack. Numbers are pushed onto the stack, and operators pop +out numbers and pushes back the result. The State monad would be useful for maintaining such a stack. + +There may be errors with some expressions. For example, an expression may be ill-formed, or there +may be a division by zero. It would be useful to use the Maybe monad so that we can return Nothing +if there is an error. + +Finally for this problem, we would like to keep track of changes to the stack and which operators +are applied to which numbers. The function should also return a list, with each entry showing the +state of the stack after an operand has been pushed or an operator has been applied. +Logging each entry can be done with the Writer monad. + +Unfortunately, it would be very cumbersome to use these monads directly together. Monad transformers +are a way to make it substantially easier to use more than one monad at the same time. +Use monad transformers to compose the State, Maybe, and Writer monads into a single monad to +implement a function which evaluates an expression in postfix notation. It should also return the +history of the calculation. +-} + +-- Encodes an operator for a mathematical expression. +data Operator + = -- Encodes negation. Equivalent to an unary minus. Unary operator. + Negate + | -- Encodes duplication. Makes another copy of its operand. Unary operator. + Add + | -- Encodes subtraction. Binary operator. + Subtract + | -- Encodes multiplication. Binary operator. + Multiply + | -- Encodes division. Equivalent to 'div'. Binary operator. + Divide + | -- Encodes a modulo operator. Equivalent to 'mod'. Binary operator. + Modulo + deriving stock (Show, Eq) + +-- A single element within a mathematical expression. +-- A list of these elements comprises an expression in postfix notation. +data Element = Operator Operator | Operand Integer deriving stock (Show, Eq) + +type Stack = [Integer] + +type Logger = Writer [(Stack, Maybe Operator)] + +type Result = Maybe Integer + +calculatePostfix :: [Element] -> (Result, [(Stack, Maybe Operator)]) +calculatePostfix xs = (result, calculations) + where + ((result, _), calculations) = Id.runIdentity $ W.runWriterT $ S.runStateT (calc xs) [] + +calc :: [Element] -> StateT Stack Logger Result +calc [] = S.gets extract +calc (Operand n : xs) = S.get >>= loop xs Nothing . (n :) +calc (Operator op : xs) = + S.get >>= Mb.maybe (return Nothing) (loop xs (Just op)) . calc' op + +extract :: [Integer] -> Maybe Integer +extract [x] = Just x +extract _ = Nothing + +loop :: [Element] -> Maybe Operator -> Stack -> StateT Stack Logger Result +loop xs op s = do + W.tell [(s, op)] + S.put s + calc xs + +calc' :: Operator -> Stack -> Maybe Stack +calc' el s = case el of + Negate -> unaryOp s + op -> binaryOp op s + +unaryOp :: Stack -> Maybe Stack +unaryOp [] = Nothing +unaryOp (x : xs) = Just (-x : xs) + +binaryOp :: Operator -> Stack -> Maybe Stack +binaryOp op (y : x : xs) = + (: xs) <$> case op of + Add -> Just $ x + y + Subtract -> Just $ x - y + Multiply -> Just $ x * y + Divide | y == 0 -> Nothing + Divide -> Just $ x `div` y + Modulo | y == 0 -> Nothing + Modulo -> return $ x `mod` y + _ -> Nothing +binaryOp _ _ = Nothing diff --git a/test/ArithmeticSpec.hs b/test/ArithmeticSpec.hs index 2d945cf..d2cbd59 100644 --- a/test/ArithmeticSpec.hs +++ b/test/ArithmeticSpec.hs @@ -66,3 +66,9 @@ spec = do describe "goldbachList" $ do it "finds Goldbach composition of all erven numbers within a given range" $ do goldbachList 9 20 `shouldMatchList` [(3, 7), (5, 7), (3, 11), (3, 13), (5, 13), (3, 17)] + + describe "multiplicativeInverse" $ do + it "the multiplicative inverse of a given integer a and modulus b" $ do + let xs = [(3 :: Int, 5, Just 2), (48, 127, Just 45), (824, 93, Just 50), (48, 93, Nothing)] + M.forM_ xs $ \(a, b, mmi) -> + multiplicativeInverse a b `shouldBe` mmi diff --git a/test/Lists3Spec.hs b/test/Lists3Spec.hs index 15f74e9..c8d5d67 100644 --- a/test/Lists3Spec.hs +++ b/test/Lists3Spec.hs @@ -111,3 +111,11 @@ spec = do it "sorts a list of lists according to their length frequency" $ do lfsort ["abc", "de", "fgh", "de", "ijkl", "mn", "o"] `shouldBe` ["ijkl", "o", "abc", "fgh", "de", "de", "mn"] + + describe "fibonacci" $ do + it "generates the nth Fibonacci number" $ do + map fibonacci [1 .. 8] `shouldBe` [0, 1, 1, 2, 3, 5, 8, 13] + + describe "fibonacci'" $ do + it "generates the nth Fibonacci number" $ do + map fibonacci' [1 .. 8] `shouldBe` [0, 1, 1, 2, 3, 5, 8, 13] diff --git a/test/MonadsSpec.hs b/test/MonadsSpec.hs new file mode 100644 index 0000000..329f6eb --- /dev/null +++ b/test/MonadsSpec.hs @@ -0,0 +1,78 @@ +module MonadsSpec (spec) where + +-- import Debug.Trace + +import qualified Control.Monad as M +import qualified Data.Char as C +import Monads +import Test.Hspec + +parsePostfix :: String -> [Element] +parsePostfix = map parseToken . words + +parseToken :: String -> Element +parseToken x + | C.isDigit (head x) = Operand (read x) + | x == "negate" = Operator Negate + | x == "+" = Operator Add + | x == "-" = Operator Subtract + | x == "*" = Operator Multiply + | x == "/" = Operator Divide + | x == "%" = Operator Modulo + | otherwise = error $ "unknown token: " ++ x + +spec :: Spec +spec = do + describe "randomWalkPaths" $ do + it "returns all 1D random walk paths with n steps" $ do + randomWalkPaths 0 `shouldBe` [[0]] + randomWalkPaths 2 + `shouldMatchList` [ [0, -1, -2], + [0, -1, -1], + [0, -1, 0], + [0, 0, -1], + [0, 0, 0], + [0, 0, 1], + [0, 1, 0], + [0, 1, 1], + [0, 1, 2] + ] + describe "collatz" $ do + it "counts the number of steps in the Collatz sequence" $ do + collatz 1 `shouldBe` 0 + collatz 2 `shouldBe` 1 + collatz 31 `shouldBe` 106 + + describe "calculatePostfix" $ do + it "evaluates an expression in postfix notation" $ do + let expr = parsePostfix "8 5 4 10 + - 3 * negate +" + let result = calculatePostfix expr + fst result `shouldBe` Just 35 + snd result + `shouldBe` [ ([8], Nothing), + ([5, 8], Nothing), + ([4, 5, 8], Nothing), + ([10, 4, 5, 8], Nothing), + ([14, 5, 8], Just Add), + ([-9, 8], Just Subtract), + ([3, -9, 8], Nothing), + ([-27, 8], Just Multiply), + ([27, 8], Just Negate), + ([35], Just Add) + ] + + let xs = [("8 5 -", Just 3), ("8 6", Nothing), ("8 negate", Just (-8)), ("8 +", Nothing)] + + M.forM_ xs $ \(ex, res) -> do + let expr' = parsePostfix ex + let result' = calculatePostfix expr' + fst result' `shouldBe` res + + let expr2 = parsePostfix "1 2 * +" + let result2 = calculatePostfix expr2 + fst result2 `shouldBe` Nothing + snd result2 + `shouldBe` [ ([1], Nothing), + ([2, 1], Nothing), + ([2], Just Multiply) + ]