Solutions to exercises from Chapter 1 of "Discrete Mathematics with a Computer"

DiscreteMathComputer01.hs

 {- Discrete Mathematics with a Computer
   Chapter 01: Introduction
-}
module Introduction where
import Data.Maybe

--------------------------------------------------------------------------------
-- Ex 1 are the following true or false

ex11 = True && False  -- False
ex12 = True || False  -- True
ex13 = not False -- True
ex14 = 3 <= 5 && 5 <= 10 -- True
ex15 = 3 <= 20 && 20 <= 10 -- False
ex16 = False == True -- False
ex17 = 1 == 1 -- True
ex18 = 1 /= 2 -- True
ex19 = 1 /= 1 -- False

--------------------------------------------------------------------------------
-- Ex 2 understanding list comprehensions

ex21 = [x | x <- [1,2,3], False] -- [] because False means all tests fail

ex22 = [not (x && y) | x <- [False, True], y <- [False, True]]
-- [True, True, True, False]
-- we consider the following tuples: (False, False), (False, True), (True, False),
-- (True, True)
-- the operation we're doing is NAND

ex23 = [x || y | x <- [False, True], y <- [False, True], x /= y]
-- tuples considered: (False, True), (True, False)
-- we do the Or of these so [True, True]

ex24 = [(x,y,z) | x <- [1..50], y <- [1..50], z <- [1..50], x ** 2 + y ** 2 == z ** 2]
-- Pythagorean Triples that are less than 50
-- generated in a very naive manner.

ex24faster = [(x,y,z) | z <- [1..50], y <- [1.. z], x <- [1..y], x ** 2 + y ** 2 == z ** 2]
        
ex24l limit = [(x,y,z) | x <- [1..limit], y <- [1..limit], z <- [1..limit], x ** 2 + y ** 2 == z ** 2]

ex24fl limit = [(x,y,z) | z <- [1..limit], y <- [1.. z], x <- [1..y], x ** 2 + y ** 2 == z ** 2]

-- For limit = 100, ex24l takes 5.85 seconds while ex24fl takes 1.10 seconds
-- ex24faster doesn't generate all permutations but would that really affect the runtime?

ex24allperms limit = concat [[(a,b,c),(b,a,c)] | (a,b,c) <- ex24fl limit]

-- takes about .05 seconds more to do the concatenation on 100.

--------------------------------------------------------------------------------
-- Ex 3: write a function that takes a character and returns true if the character is 'a'
-- and false otherwise

isA, isApatmatch, isAH :: Char -> Bool
isA = (== 'a')

isApatmatch 'a' = True
isApatmatch _ = False

-- higher-level, although it's doing exactly what isA was doing
isChar :: Char -> (Char -> Bool)
isChar x = (== x)

isAH = isChar 'a'

--------------------------------------------------------------------------------
-- Ex 4: write a function that takes a string and returns true if the string is "hello"

isHello :: String -> Bool
isHello = (== "Hello")

isHelloP "Hello" = True
isHelloP _ = False

-- higher level although it's doing exactly what isHello was doing
isWord :: String -> (String -> Bool)
isWord w = (== w)

isHelloH = (isWord "Hello")

--------------------------------------------------------------------------------
-- Ex 5: Write a function that takes a string and removes a leading space if it exists

removeLeading :: String -> String
removeLeading (' ':rest) = rest
removeLeading x = x

removeAllLeading :: String -> String
removeAllLeading (' ':rest) = removeAllLeading rest
removeAllLeading x = x

--------------------------------------------------------------------------------
-- Ex 6: You've read in a list of Ints where is supposed to mean False, 1 means True
--       any other number is invalid input

readBools :: [Int] -> [Bool]
readBools = map int2bool
  where int2bool :: Int -> Bool
        int2bool 0 = False
        int2bool 1 = True
        int2bool _ = error "Invalid Input"

--------------------------------------------------------------------------------
-- Ex 7 : return true if atleast one of the chars is '0'

-- good ol'fashioned recursive style
member0 :: String -> Bool
member0 [] = False
member0 ('0':_) = True
member0 (_:xs) = member0 xs

-- using filter
member0f  = (> 0) . length . filter (== '0')

-- using fold
member0fold = foldr (\ a b -> (a == '0') || b) False 

-- using Haskell library functions
member0has = elem '0'

--------------------------------------------------------------------------------
{- Folds

foldr = fold from the right . i.e. values are built from the left
e.g. foldr (+) 0 [1,2,3]
     1 + (2 + (3 + 0))

foldl = fold from the left. 
e.g. foldl (+) 0 [1,2,3]
     (((0 + 1) + 2) + 3)

-}

concatFold :: [[a]] -> [a]
concatFold = foldr (++) []

myAnd :: [Bool] -> Bool
myAnd = foldr (&&) True

{- myAnd [True, False, True]
  = True && (False && (True && False))
  = (False && (True && False))
  = False

  False && undefined => False proves that it is lazy with second argument
-}
-- myAnd was initially defined incorrectly. Thanks to norriscm pointing out the mistake.

myMax1 :: (Ord a) => [a] -> a
myMax1 = foldr1 max 

--------------------------------------------------------------------------------
-- Ex 8: Expand the following application

{- foldr max 0 [1,5,3]
   = max 1 (max 5 (max 3 0))
   = max 1 (max 5 3)
   = max 1 5
   = 5
-}

--------------------------------------------------------------------------------
-- Ex 9: Write a function that takes in two lists of type [Maybe Int] and examines
--       the pair of list heads before lookinga t rest of the lists.
-- It returns a list in which the Ints of each pair have been added if both are of
-- the form Just n, preserving any Just n value otherwise.

justAdd :: (Num a) => Maybe a -> Maybe a -> Maybe a
justAdd Nothing Nothing = Nothing
justAdd (Just x) (Just y) = Just (x + y)
justAdd x Nothing = x
justAdd Nothing y = y

addJust :: [Maybe Int] -> [Maybe Int] -> [Maybe Int]
addJust = zipWith justAdd

-- book's test
-- addJust [Just 2, Nothing, Just 3] [Nothing, Nothing, Just 5]
-- [Just 2,Nothing,Just 8]

--------------------------------------------------------------------------------
-- Ex 10: Define a data type that represents six different metals
--        and automatically creates versions of (==) and show

data Metals = Lithium
            | Sodium
            | Potassium
            | Rubidium
            | Cesium
            | Francium
            deriving (Eq, Show)
                     
--------------------------------------------------------------------------------
-- Ex 11: Suppose coins have been sorted into piles, each of which contains only
--        one type of coin. Define a data type to represent piles of coins.

data Coin = Penny Integer
          | Dime Integer
          | Nickel Integer
          | Quarter Integer
          | Dollar Integer
          deriving (Eq, Show)

--------------------------------------------------------------------------------
-- Ex 12: Define a universal type that contains Booleans, characters and integers

data Universal = BOOL Bool
               | INT Integer
               | CHAR Char
               deriving (Eq, Show)

--------------------------------------------------------------------------------
-- Ex 13: Define a type that contains tuples of upto four elements

data Tup4 a b c d = Tuple0
                  | Tuple1 a
                  | Tuple2 a b
                  | Tuple3 a b c
                  | Tuple4 a b c d
                  deriving (Eq, Show)

--------------------------------------------------------------------------------
-- Ex 14: Function that finds real solution sof quadratic equation and reports failure

discriminant :: (Floating a) => a -> a -> a -> a 
discriminant a b c = b ^ 2 - 4 * a * c

realSqrt :: (Ord a, Floating a) => a -> a -> a -> Maybe (a,a)
realSqrt a b c = case (compare disc) 0 of
  LT -> Nothing
  EQ -> Just (prefix, prefix)
  GT -> Just (prefix + sqdisc, prefix - sqdisc)
  where disc = discriminant a b c
        sqdisc = sqrt disc / (2 * a)
        prefix = - b / (2 * a)
  
-- ==============================================================================
-- Review Exercises Begin here
-- Ex 15: showMaybe
        
showMaybe :: (Show a) => Maybe a -> String
showMaybe Nothing = "Nothing"
showMaybe (Just x) = show x

{- Note that saying showMaybe Nothing = show Nothing is a compiler error
   because:

<kanakola> roelvandijk: So you're saying since Nothing is a part of any type,
	   "showMaybe Nothing" is still ambiguous? because the Nothing could
	   be of any Maybe type right? like it could be a nothing from Maybe
	   Int or it could be a nothing from Maybe Char. And that's where the
	   ambiguity comes from?

thanks to the people on the haskell channel :)
-}

--------------------------------------------------------------------------------
-- Ex 16: Bit = integer that is either 0 or 1
--- 

data Bit = Zero
         | One
         deriving (Show, Eq, Enum, Ord, Bounded)
-- deriving Enum gives me a fromEnum:: Bit -> Int so fromEnum Zero is 0
-- deriving Ord gives me Zero < One, One > Zero
-- deriving Eq gives me Zero == Zero and One == One
-- deriving Bounded tells me that (minBound :: Bit) = Zero
--                           and  (maxBound :: Bit) = One
-- Show lets me print things

type Word = [Bit] -- [1,0] means 2

bitOr :: Bit -> Bit -> Bit
bitOr Zero Zero = Zero
bitOr _ _ = One

bitAnd :: Bit -> Bit -> Bit
bitAnd One One = One
bitAnd _ _ = Zero

{- bitwiseAnd [1,0,0] [1,0,1] => [bitAnd 1 1, bitAnd 0 0, bitAnd 0 1] = [1,0,0]
-}

bitwiseAnd = zipWith bitAnd 
bitwiseOr = zipWith bitOr

{- Extra credit: converting a word to the integer it represents
[1,0,0] = 1 * 2 ^ 2 + 0 * 2 ^ 1 + 0 * 2^ 0
-}
fromWord :: Word -> Int
fromWord  = foldl (\ acc new -> 2 * acc + fromEnum new) 0

--------------------------------------------------------------------------------
-- Ex 17: Fix type errors

{- [1, False] lists are homogeneous
   '2' ++ 'a' : append is for lists
   [(3, True), (False, 9)] should be [(3, True), (9, False)]

   2 == False : == requires homogeneous types
   'a' > "b" : should be 'a' > 'b'
   [[1],[2],[[3]]] should be [[1],[2],[3]]
-}

--------------------------------------------------------------------------------
-- Ex 18

{- f :: Num a => (a, a) -> a
   f (x,y) = x + y

   f (True, 4) is an error because True is not a number
-}

-- alternate definition
f :: Num a => (a, a) -> a
f = uncurry (+)

--------------------------------------------------------------------------------
-- Ex 19

{- f :: Maybe a -> [a]
   f Nothing = []
   
f (Just 3) is an error because we didn't define a pattern for just

-}

--------------------------------------------------------------------------------
-- Ex 20
-- write a list comprehension that takes [Just 3, Nothing, Just 4] and produces
-- [3, 4]

fromJusts :: [Maybe a] -> [a]
fromJusts xs = [a | Just a <- xs]
        
--------------------------------------------------------------------------------
-- Monochrom's problem on the IRC
-- Using only add1, subtract1 and compare to zero, write a function that checks
-- if a number is odd or even

isEven :: (Integral a) => a -> Bool
isEven x = case compare x 0 of
             EQ -> True
             GT -> isEvenHelper (\ y -> y - 1) x
             LT -> isEvenHelper (+ 1) x
        where 
          isEvenHelper _ 0 = True
          isEvenHelper f n = not $ isEvenHelper f (f n)

-- Discussion on IRC: can we do this if only thing we can check is eq to 0 (not compare)
-- The solution is to have one "thread" keep decrementing, and another keep incrementing
-- return the answer of the one that terminates first
-- of course we don't need real threads, just something that simulates two computation lines

--------------------------------------------------------------------------------
-- Ex 21
-- using list comprehensions, write a function that takes a list of int values and an int value n and returns those that are greater than n
          
filterSmaller :: Integer -> [Integer] -> [Integer]
filterSmaller n xs = [x | x <- xs, x > n]
          
-- another way:
filterSmaller2 :: Ord a => a -> [a] -> [a]
filterSmaller2 n = filter (> n)

--------------------------------------------------------------------------------
-- Ex 22
-- Take in a list of Int values and an Int and return a list of indexes at which that int appears

-- actually why does input have to be Int? 

indices :: Eq a => [a] -> a -> [Int]
indices xs x = [b | (a, b) <- zip xs [1..], a == x]

--------------------------------------------------------------------------------
-- Ex 23
-- List comprehension that produces a list of all positive integers that are not squares in the range 1 to 20

notSquares :: [Integer]
notSquares = [e | e <- [1..20], null [x | x <- [1..e], x * x == e]]

--------------------------------------------------------------------------------
-- Ex 24
-- foldr to count the number of times a letter occurs in a string

countOccur, countOccur2 :: Char -> String -> Int
countOccur c = foldr (\ new acc -> (if new == c then 1 else 0) + acc) 0

countOccur2 c = length . filter (== c)

--------------------------------------------------------------------------------
-- Ex 25
-- "write a function using foldr that takes a list and removes each isntance of a given letter

-- doing what they want
removeChar :: Char -> String -> String
removeChar c = foldr (\ x acc -> if x == c then acc else x:acc) []

-- but if i can write filter...

filterF :: (a -> Bool) -> [a] -> [a]
filterF p = foldr (\ x acc -> if p x then x:acc else acc) []

removeChar' :: Char -> String -> String
removeChar' c = filterF (/= c)

--------------------------------------------------------------------------------
-- Ex 26
-- write reverse using foldl

rev :: [a] -> [a]
rev xs = foldl (\ acc elt -> elt:acc) [] xs

--------------------------------------------------------------------------------
-- Ex 27
-- using foldl, write a function MaybeLast that returns the last element if there is one
-- otherwise returns nothing

takeLast :: Maybe a -> a -> Maybe a
takeLast _ x = Just x

maybeLast :: [a] -> Maybe a
maybeLast = foldl takeLast Nothing

Your myAnd is incorrect; it always returns False. It should be myAnd = foldr (&&) True.

norriscm, thanks for pointing that out. I've fixed the problem.