h99.hs

import System.Random
import Data.List

-- | https://wiki.haskell.org/99_questions/1_to_10

-- Problem 1
-- (*) Find the last element of a list.

-- (Note that the Lisp transcription of this problem is incorrect.)

-- Example in Haskell:

-- λ> myLast [1,2,3,4]
-- 4
-- λ> myLast ['x','y','z']
-- 'z'
myLast :: [a] -> a
myLast [] = error "error!"
myLast [x] = x
myLast (_:xs) = myLast xs

myLast' :: [a] -> a
myLast' [] = error "error!"
myLast' x = (head . reverse) x


-- Problem 2
-- (*) Find the last but one element of a list.
myButLast :: [a] -> a
myButLast []  = error "error!"
myButLast [q] = error "error!"
myButLast x   = (last . init) x

myButLast' :: [a] -> a
myButLast' []  = error "error!"
myButLast' [q] = error "error!"
myButLast' x   = (head. reverse . init) x

-- Problem 3
-- (*) Find the K'th element of a list. The first element in the list is number 1.

-- Example:

-- * (element-at '(a b c d e) 3)
-- c
-- Example in Haskell:

-- λ> elementAt [1,2,3] 2
-- 2
-- λ> elementAt "haskell" 5
-- 'e'
elementAt :: [a] -> Int -> a
elementAt as i = fst $ last $ zip as [1..i]
-- last $ take 5 "haskell"
-- 'e'

-- Problem 4
-- (*) Find the number of elements of a list.

-- Example in Haskell:

-- λ> myLength [123, 456, 789]
-- 3
-- λ> myLength "Hello, world!"
-- 13
-- -----
-- *Main> sum $ map (\_ -> 1) "haskell"
-- 7
-- *Main> sum $ map (\_ -> 1) [123, 456, 789]
-- 3
-- *Main> sum $ map (\_ -> 1) "Hello, world!"

-- Problem 5
-- (*) Reverse a list.

-- Example in Haskell:

-- λ> myReverse "A man, a plan, a canal, panama!"
-- "!amanap ,lanac a ,nalp a ,nam A"
-- λ> myReverse [1,2,3,4]
-- [4,3,2,1]
-- ----
-- scala> (1 to 10).toList.foldRight(List[Int]())((a,b) => b:+a)
-- res4: List[Int] = List(10, 9, 8, 7, 6, 5, 4, 3, 2, 1)

-- scala> (1 to 10).toList.foldLeft(List[Int]())((a,b) => b::a)
-- res5: List[Int] = List(10, 9, 8, 7, 6, 5, 4, 3, 2, 1)

-- foldl (\a b -> b:a) [] [1..10]
-- [10,9,8,7,6,5,4,3,2,1]

-- Problem 6
-- (*) Find out whether a list is a palindrome. A palindrome can be read forward or backward; e.g. (x a m a x).

-- Example in Haskell:

-- λ> isPalindrome [1,2,3]
-- False
-- λ> isPalindrome "madamimadam"
-- True
-- λ> isPalindrome [1,2,4,8,16,8,4,2,1]
-- True
-- ---------
-- *Main Data.Tuple> let isPalindrome = \xs -> if xs == reverse xs then True else False
-- *Main Data.Tuple> isPalindrome [1,2,3]
-- False
-- *Main Data.Tuple> isPalindrome "madamimadam"
-- True
-- *Main Data.Tuple> isPalindrome [1,2,4,8,16,8,4,2,1]
-- True


-- Problem 7
-- (**) Flatten a nested list structure.

-- Transform a list, possibly holding lists as elements into a `flat' list by replacing each list with its elements (recursively).

-- Example:

-- * (my-flatten '(a (b (c d) e)))
-- (A B C D E)
-- Example in Haskell:

-- We have to define a new data type, because lists in Haskell are homogeneous.

--  data NestedList a = Elem a | List [NestedList a]
-- λ> flatten (Elem 5)
-- [5]
-- λ> flatten (List [Elem 1, List [Elem 2, List [Elem 3, Elem 4], Elem 5]])
-- [1,2,3,4,5]
-- λ> flatten (List [])
-- []

data NestedList a = Elem a | List [NestedList a]
flatten :: NestedList a -> [a]
flatten (List [])     = []
flatten (Elem l) = [l]
flatten (List (l:ls)) = flatten l ++ flatten (List ls)

-- Problem 8
-- (**) Eliminate consecutive duplicates of list elements.

-- If a list contains repeated elements they should be replaced with a single copy of the element. The order of the elements should not be changed.

-- Example:

-- * (compress '(a a a a b c c a a d e e e e))
-- (A B C A D E)
-- Example in Haskell:

-- λ> compress "aaaabccaadeeee"
-- "abcade"
compress :: Eq a => [a] -> [a]
compress x = reverse $ foldl (\a b -> if (head a) == b then a else b:a) [head x] x

-- Problem 9
-- (**) Pack consecutive duplicates of list elements into sublists. If a list contains repeated elements they should be placed in separate sublists.

-- Example:

-- * (pack '(a a a a b c c a a d e e e e))
-- ((A A A A) (B) (C C) (A A) (D) (E E E E))
-- Example in Haskell:

-- λ> pack ['a', 'a', 'a', 'a', 'b', 'c', 'c', 'a', 
--              'a', 'd', 'e', 'e', 'e', 'e']
-- ["aaaa","b","cc","aa","d","eeee"]
pack :: Eq a => [a] -> [[a]]
pack [] = []
-- pack x = takeWhile (\e -> e == (head x)) x : (pack $ dropWhile (\e -> e == (head x)) x)
pack x = takeWhile cond x : (pack $ dropWhile cond x)
    -- where cond = (\e -> e == (head x))
    where cond = (== (head x))


-- Problem 10
-- (*) Run-length encoding of a list. Use the result of problem P09 to implement the so-called run-length encoding data compression method. Consecutive duplicates of elements are encoded as lists (N E) where N is the number of duplicates of the element E.

-- Example:

-- * (encode '(a a a a b c c a a d e e e e))
-- ((4 A) (1 B) (2 C) (2 A) (1 D)(4 E))
-- Example in Haskell:

-- λ> encode "aaaabccaadeeee"
-- [(4,'a'),(1,'b'),(2,'c'),(2,'a'),(1,'d'),(4,'e')]
encode :: Eq a => [a] -> [(Int, a)]
encode x = map (\p -> ((length p), (head p))) (pack x)

-- | https://wiki.haskell.org/99_questions/11_to_20

-- Problem 11
-- (*) Modified run-length encoding.

-- Modify the result of problem 10 in such a way that if an element has no duplicates it is simply copied into the result list. Only elements with duplicates are transferred as (N E) lists.

-- Example:

-- * (encode-modified '(a a a a b c c a a d e e e e))
-- ((4 A) B (2 C) (2 A) D (4 E))
-- Example in Haskell:

-- λ> encodeModified "aaaabccaadeeee"
-- [Multiple 4 'a',Single 'b',Multiple 2 'c', Multiple 2 'a',Single 'd',Multiple 4 'e']
data EncodeModified a = Multiple Int a | Single a deriving Show
encodeModified :: Eq a => [a] -> [EncodeModified a]
encodeModified x = map (func) (encode x)
    where func t = if fst t == 1 then Single (snd t) else Multiple (fst t) (snd t)

-- Problem 12
-- (**) Decode a run-length encoded list.

-- Given a run-length code list generated as specified in problem 11.
-- Construct its uncompressed version.

-- Example in Haskell:

-- λ> decodeModified 
--        [Multiple 4 'a',Single 'b',Multiple 2 'c', Multiple 2 'a',Single 'd',Multiple 4 'e']
-- "aaaabccaadeeee"
decodeModified :: Eq a => [EncodeModified a] -> [a]
decodeModified []        = []
decodeModified ((Single x):xs)     = x : (decodeModified xs)
decodeModified ((Multiple i x):xs) = (replicate i x) ++ (decodeModified xs)

-- Problem 13
-- (**) Run-length encoding of a list (direct solution).

-- Implement the so-called run-length encoding data compression method directly. 
-- I.e. don't explicitly create the sublists containing the duplicates,
-- as in problem 9, but only count them.
-- As in problem P11, simplify the result list by replacing the singleton lists (1 X) by X.

-- Example:

-- * (encode-direct '(a a a a b c c a a d e e e e))
-- ((4 A) B (2 C) (2 A) D (4 E))
-- Example in Haskell:

-- λ> encodeDirect "aaaabccaadeeee"
-- [Multiple 4 'a',Single 'b',Multiple 2 'c', Multiple 2 'a',Single 'd',Multiple 4 'e']
-- λ> encodeModified "aaaabccaadeeee"
-- [Multiple 4 'a',Single 'b',Multiple 2 'c', Multiple 2 'a',Single 'd',Multiple 4 'e']
----------------------------------------------------
-- Problem 14
-- (*) Duplicate the elements of a list.

-- Example:

-- * (dupli '(a b c c d))
-- (A A B B C C C C D D)
-- Example in Haskell:

-- λ> dupli [1, 2, 3]
-- [1,1,2,2,3,3]
dupli :: [a] -> [a]
dupli xs = foldr (\a b -> a : a : b) [] xs

dupli' :: [a] -> [a]
dupli' xs = reverse $ foldl (\b a -> a : a : b) [] xs

dupli'' :: Enum a => [a] -> [a]
dupli'' xs = xs >>= (\x -> take 2 [x,x..])

-- Problem 15
-- (**) Replicate the elements of a list a given number of times.

-- Example:

-- * (repli '(a b c) 3)
-- (A A A B B B C C C)
-- Example in Haskell:

-- λ> repli "abc" 3
-- "aaabbbccc"
repli :: Enum a => [a] -> Int -> [a]
repli xs i = foldr (\a b -> take i [a,a..] ++ b) [] xs

repli' :: Enum a => [a] -> Int -> [a]
repli' xs i = xs >>= (\a -> take i [a,a..])

-- Problem 16
-- (**) Drop every N'th element from a list.

-- Example:

-- * (drop '(a b c d e f g h i k) 3)
-- (A B D E G H K)
-- Example in Haskell:

-- λ> dropEvery "abcdefghik" 3
-- "abdeghk"
dropEvery :: [a] -> Int -> [a]
-- dropEvery xs i = map (fst) (filter (\e -> snd e /= i) (zip xs $ cycle [1..i]))
dropEvery xs i = map (fst) (filter ((/= i) . snd) (zip xs $ cycle [1..i]))

-- Problem 17
-- (*) Split a list into two parts; the length of the first part is given.

-- Do not use any predefined predicates.

-- Example:

-- * (split '(a b c d e f g h i k) 3)
-- ( (A B C) (D E F G H I K))
-- Example in Haskell:

-- λ> split "abcdefghik" 3
-- ("abc", "defghik")
split :: [a] -> Int -> ([a], [a])
split xs i = (take i xs, drop i xs)

-- Problem 18
-- (**) Extract a slice from a list.

-- Given two indices, i and k,
-- the slice is the list containing the elements between the i'th and k'th element of
-- the original list (both limits included).
-- Start counting the elements with 1.

-- Example:

-- * (slice '(a b c d e f g h i k) 3 7)
-- (C D E F G)
-- Example in Haskell:

-- λ> slice ['a','b','c','d','e','f','g','h','i','k'] 3 7
-- "cdefg"
slice :: [a] -> Int -> Int -> [a]
slice xs i k = map (fst) $ filter (\x -> snd x >= i && snd x <= k) $ zip xs [1 ..]

-- Problem 19
-- (**) Rotate a list N places to the left.
-- Hint: Use the predefined functions length and (++).

-- Examples:
-- * (rotate '(a b c d e f g h) 3)
-- (D E F G H A B C)

-- * (rotate '(a b c d e f g h) -2)
-- (G H A B C D E F)
-- Examples in Haskell:

-- λ> rotate ['a','b','c','d','e','f','g','h'] 3
-- "defghabc"

-- λ> rotate ['a','b','c','d','e','f','g','h'] (-2)
-- "ghabcdef"
rotate :: [a] -> Int -> [a]
rotate xs i
    | i > 0 = (drop i xs) ++ (take i xs)
    | i < 0 = (drop (y+i) xs) ++ (take (y+i) xs)
    | i == 0 = xs
    where y = length xs

-- Problem 20
-- (*) Remove the K'th element from a list.
-- Example in Prolog:
-- ?- remove_at(X,[a,b,c,d],2,R).
-- X = b
-- R = [a,c,d]
-- Example in Lisp:

-- * (remove-at '(a b c d) 2)
-- (A C D)
-- (Note that this only returns the residue list,
-- while the Prolog version also returns the deleted element.)

-- Example in Haskell:
-- λ> removeAt 2 "abcd"
-- ('b',"acd")
removeAt :: Int -> [a] -> (a, [a])
-- removeAt i xs = (head $ map (fst) $ filter (\t -> snd t == i) (zip xs [1..]),
--                         map (fst) $ filter (\t -> snd t /= i) (zip xs [1..]))
removeAt i xs = (head $ func (\t -> snd t == i), func (\t -> snd t /= i))
    where func f = map (fst) $ filter (f) (zip xs [1..])                    

-- Problem 21
-- Insert an element at a given position into a list.

-- Example:

-- * (insert-at 'alfa '(a b c d) 2)
-- (A ALFA B C D)
-- Example in Haskell:

-- λ> insertAt 'X' "abcd" 2
-- "aXbcd"
insertAt :: a -> [a] -> Int -> [a]
insertAt e xs i = (take (i - 1) xs) ++ e : (drop (i - 1) xs)

-- Problem 22
-- Create a list containing all integers within a given range.

-- Example:

-- * (range 4 9)
-- (4 5 6 7 8 9)
-- Example in Haskell:

-- λ> range 4 9
-- [4,5,6,7,8,9]
range :: Int -> Int -> [Int]
range = enumFromTo

-- Problem 23
-- Extract a given number of randomly selected elements from a list.

-- Example:

-- * (rnd-select '(a b c d e f g h) 3)
-- (E D A)
-- Example in Haskell:

-- λ> rndSelect "abcdefgh" 3 >>= putStrLn
-- eda
rndSelect :: [a] -> Int -> [a]
rndSelect xs i = map (\f -> xs !! (f - 1)) func
    where func = take i $ nub $ take 10000 $ randomRs (1,length xs) (mkStdGen 100) :: [Int]

-- Problem 24
-- Lotto: Draw N different random numbers from the set 1..M.

-- Example:

-- * (rnd-select 6 49)
-- (23 1 17 33 21 37)
-- Example in Haskell:

-- λ> diffSelect 6 49
-- [23,1,17,33,21,37]
diffSelect :: Int -> Int -> [Int]
diffSelect n m = take n $ randomRs (1, m) (mkStdGen 100) :: [Int]

-- Problem 25
-- Generate a random permutation of the elements of a list.

-- Example:

-- * (rnd-permu '(a b c d e f))
-- (B A D C E F)
-- Example in Haskell:

-- λ> rndPermu "abcdef"
-- "badcef"
rndPermu :: [a] -> [a]
rndPermu xs = map (\f -> xs !! (f - 1)) func
    where func = take len $ nub $ take 10000 $ randomRs (1,len) (mkStdGen 100) :: [Int]
          len  = length xs

--   Problem 26
--   (**) Generate the combinations of K distinct objects chosen from the N elements of a list
    
--   In how many ways can a committee of 3 be chosen from a group of 12 people?
--  We all know that there are C(12,3) = 220 possibilities (C(N,K) denotes the well-known binomial coefficients).
--  For pure mathematicians, this result may be great.
--  But we want to really generate all the possibilities in a list.
    
--   Example:
--   * (combinations 3 '(a b c d e f))
--   ((A B C) (A B D) (A B E) ... )
--   Example in Haskell:
    
--   λ> combinations 3 "abcdef"
--   ["abc","abd","abe",...]
-- combinations :: Int -> [a] -> [[a]]
-- product [1 .. n] `div` (product [1 .. k] * product [1 .. (n - k)])
-- ["ad","ae","af","bd","be","bf","cd","ce","cf"]
-- *Main System.Random Data.List> let a = [ x:y:z:[] | x <- "ab", y <- "cd", z <- "ef"]
-- *Main System.Random Data.List> let b = [ reverse (x:y:z:[]) | x <- "ab", y <- "cd", z <- "ef"]
-- *Main System.Random Data.List> let c = "abc" : "abd" : "abe": "abf" : a ++ b
-- *Main System.Random Data.List> c
-- ["abc","abd","abe","abf","ace","acf","ade","adf","bce","bcf","bde","bdf","eca","fca","eda","fda","ecb","fcb","edb","fdb"]
-- *Main System.Random Data.List> length $ nub $ c
-- 20
-- *Main System.Random Data.List> n
-- 6
-- *Main System.Random Data.List> k
-- 3
-- *Main System.Random Data.List> product [1 .. n] `div` (product [1 .. k] * product [1 .. (n - k)])
-- 20
----------------------------------------------------
-- Problem 27
-- Group the elements of a set into disjoint subsets.

-- a) 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.

-- Example:

-- * (group3 '(aldo beat carla david evi flip gary hugo ida))
-- ( ( (ALDO BEAT) (CARLA DAVID EVI) (FLIP GARY HUGO IDA) )
-- ... )
-- b) Generalize the above predicate in a way that we can specify a list of group sizes and the predicate will return a list of groups.

-- Example:

-- * (group '(aldo beat carla david evi flip gary hugo ida) '(2 2 5))
-- ( ( (ALDO BEAT) (CARLA DAVID) (EVI FLIP GARY HUGO IDA) )
-- ... )
-- Note that we do not want permutations of the group members; i.e. ((ALDO BEAT) ...) is the same solution as ((BEAT ALDO) ...). However, we make a difference between ((ALDO BEAT) (CARLA DAVID) ...) and ((CARLA DAVID) (ALDO BEAT) ...).

-- You may find more about this combinatorial problem in a good book on discrete mathematics under the term "multinomial coefficients".

-- Example in Haskell:

-- λ> group [2,3,4] ["aldo","beat","carla","david","evi","flip","gary","hugo","ida"]
-- [[["aldo","beat"],["carla","david","evi"],["flip","gary","hugo","ida"]],...]
-- (altogether 1260 solutions)

-- λ> group [2,2,5] ["aldo","beat","carla","david","evi","flip","gary","hugo","ida"]
-- [[["aldo","beat"],["carla","david"],["evi","flip","gary","hugo","ida"]],...]
-- (altogether 756 solutions)
----------------------------------------------------
-- Problem 28
-- Sorting a list of lists according to length of sublists

-- a) We suppose that a list contains elements that are lists themselves.
-- The objective is to sort the elements of this list according to their length. 
-- E.g. short lists first, longer lists later, or vice versa.

-- Example:

-- * (lsort '((a b c) (d e) (f g h) (d e) (i j k l) (m n) (o)))
-- ((O) (D E) (D E) (M N) (A B C) (F G H) (I J K L))
-- Example in Haskell:

-- λ> lsort ["abc","de","fgh","de","ijkl","mn","o"]
-- ["o","de","de","mn","abc","fgh","ijkl"]
-- 
-- b) Again, we suppose that a list contains elements that are lists themselves.
-- But this time the objective is to sort the elements of this list according to their length frequency;
-- i.e., in the default, where sorting is done ascendingly, lists with rare lengths are placed first,
--  others with a more frequent length come later.

-- Example:

-- * (lfsort '((a b c) (d e) (f g h) (d e) (i j k l) (m n) (o)))
-- ((i j k l) (o) (a b c) (f g h) (d e) (d e) (m n))
-- Example in Haskell:

-- λ> lfsort ["abc", "de", "fgh", "de", "ijkl", "mn", "o"]
-- ["ijkl","o","abc","fgh","de","de","mn"]
lsort :: [[a]] -> [[a]]
lsort xxs = map (fst) $ sortBy (sortTuple) $ map (\xs -> (xs, length xs)) xxs
    where sortTuple (a1, b1) (a2, b2)
            | b1  > b2 = GT
            | b1  < b2 = LT
            | b1 == b2 = EQ

lsort' xxs = sortBy (sortFun) xxs
    where sortFun a1 a2
            | (length a1)  > (length a2) = GT
            | (length a1)  < (length a2) = LT
            | (length a1) == (length a2) = EQ

-- lfsort :: [[a]] -> [[a]]

-- | ===== 99 questions/31 to 41 =====
-- Problem 31
-- (**) Determine whether a given integer number is prime.

-- Example:

-- * (is-prime 7)
-- T
-- Example in Haskell:

-- λ> isPrime 7
-- True

isPrime :: Int -> Bool
isPrime n
    | n <= 1                   = False
    | n /= 2 && n `mod` 2 == 0 = False
    | n /= 3 && n `mod` 3 == 0 = False
    | n /= 5 && n `mod` 5 == 0 = False
    | n /= 7 && n `mod` 7 == 0 = False
    | n /= 11 && n `mod` 11 ==  0 = False
    | otherwise = True
-- filter (isPrime) [-100..199]
-- [2,3,5,7,11,13,17,19,23,29,31,37,41,43,47,53,59,61,67,71,73,79,83,89,97,101,103,107,109,113,127,131,137,139,149,151,157,163,167,169,173,179,181,191,193,197,199]
-- > isPrime 3049
-- True
-- > isPrime 3137
-- True
-- > isPrime 3461
-- True

-- Problem 32
-- (**) Determine the greatest common divisor of two positive integer numbers. Use Euclid's algorithm.

-- Example:

-- * (gcd 36 63)
-- 9
-- Example in Haskell:

-- λ> [myGCD 36 63, myGCD (-3) (-6), myGCD (-3) 6]
-- [9,3,3]
myGCD :: Int -> Int -> Int 
myGCD a b
    | b == 0    = a
    | otherwise = myGCD b (a `mod` b)

-- Problem 33
-- (*) Determine whether two positive integer numbers are coprime.
-- Two numbers are coprime if their greatest common divisor equals 1.

-- Example:

-- * (coprime 35 64)
-- T
-- Example in Haskell:

-- λ> coprime 35 64
-- True
coprime :: Int -> Int -> Bool
coprime a b
    | myGCD a b == 1 = True
    | otherwise      = False

-- Problem 34
-- (**) Calculate Euler's totient function phi(m).

-- Euler's so-called totient function phi(m) is defined as
--  the number of positive integers r (1 <= r < m) that are coprime to m.

-- Example: m = 10: r = 1,3,7,9; thus phi(m) = 4.
-- Note the special case: phi(1) = 1.

-- Example:

-- * (totient-phi 10)
-- 4
-- Example in Haskell:

-- λ> totient 10
-- 4
totient :: Int -> Int
totient m = length $ filter (coprime m) [1 .. m]

-- Problem 35
-- (**) Determine the prime factors of a given positive integer.
-- Construct a flat list containing the prime factors in ascending order.

-- Example:

-- * (prime-factors 315)
-- (3 3 5 7)
-- Example in Haskell:

-- λ> primeFactors 315
-- [3, 3, 5, 7]
primeFactors :: Int -> [Int]
primeFactors x
    | x == 1    = []
    | otherwise = divisor : primeFactors (x `div` divisor)   
    where divisor = head $ dropWhile (\a -> x `mod` a /= 0) [2..]

-- Problem 36
-- (**) Determine the prime factors of a given positive integer.

-- Construct a list containing the prime factors and their multiplicity.

-- Example:

-- * (prime-factors-mult 315)
-- ((3 2) (5 1) (7 1))
-- Example in Haskell:

-- λ> primeFactorsMult 315
-- [(3,2),(5,1),(7,1)]
primeFactorsMult :: Int -> [(Int, Int)]
primeFactorsMult x = map (\f -> (head f, length f)) $ groupBy (==) (primeFactors x)

-- Problem 37
-- (**) Calculate Euler's totient function phi(m) (improved).

-- See problem 34 for the definition of Euler's totient function.

-- If the list of the prime factors of a number m is known
-- in the form of problem 36 then the function phi(m) can be efficiently calculated
-- as follows: Let ((p1 m1) (p2 m2) (p3 m3) ...) be the list of prime factors
-- (and their multiplicities) of a given number m.
-- Then phi(m) can be calculated with the following formula:

-- phi(m) = (p1 - 1) * p1 ** (m1 - 1) * 
--          (p2 - 1) * p2 ** (m2 - 1) * 
--          (p3 - 1) * p3 ** (m3 - 1) * ...
-- Note that a ** b stands for the b'th power of a.
phi :: Int -> Int
phi m = foldl (\b a -> (fst a - 1) * (fst a) ^  (((snd a) - 1) * b)) 1 (primeFactorsMult m)

-- Problem 38
-- (*) Compare the two methods of calculating Euler's totient function.

-- Use the solutions of problems 34 and 37 to compare the algorithms. Take the number of reductions as a measure for efficiency. Try to calculate phi(10090) as an example.

-- > phi 10090
-- 1008

-- (no solution required)

-- > map (\x -> totient x == phi x) [1..100]
-- [True,True,True,True,True,True,True,True,True,True,True,False,True,True,False,True,True,True,True,False,False,True,True,False,True,True,True,False,True,False,True,True,False,True,False,False,True,True,False,False,True,False,True,False,False,True,True,False,True,True,False,False,True,True,False,False,False,True,True,False,True,True,False,True,False,False,True,False,False,False,True,False,True,True,False,False,False,False,True,False,True,True,True,False,False,True,False,False,True,False,False,False,False,True,False,False,True,True,False,False]
-- TODO: all these False values might indicate there's a bug some

-- totient 1009
-- 1008

-- Problem 39
-- (*) A list of prime numbers.

-- Given a range of integers by its lower and upper limit, construct a list of all prime numbers in that range.

-- Example in Haskell:

-- λ> primesR 10 20
-- [11,13,17,19]
primesR :: Int -> Int -> [Int]
primesR l u = filter (isPrime) [l .. u]

-- Problem 40
-- (**) Goldbach's conjecture.

-- Goldbach's conjecture says that every positive even number greater than 2 is
--  the sum of two prime numbers. Example: 28 = 5 + 23.
--  It is one of the most famous facts in number theory that has not been proved
--  to be correct in the general case.
--  It has been numerically confirmed up to very large numbers
--  (much larger than we can go with our Prolog system).
--  Write a predicate to find the two prime numbers that sum up to a given even integer.

-- Example:

-- * (goldbach 28)
-- (5 23)
-- Example in Haskell:

-- λ> goldbach 28
-- (5, 23)
goldbach :: Int -> (Int, Int)
goldbach x = (smaPrime, bigPrime)
    where list     = primesR 1 x
          bigPrime = last $ list 
          smaPrime = x - bigPrime

-- Problem 41
-- (**) Given a range of integers by its lower and upper limit,
-- print a list of all even numbers and their Goldbach composition.

-- In most cases, if an even number is written as the sum of two prime numbers,
-- one of them is very small. Very rarely, the primes are both bigger than say 50.
-- Try to find out how many such cases there are in the range 2..3000.

-- Example:
-- * (goldbach-list 9 20)
-- 10 = 3 + 7
-- 12 = 5 + 7
-- 14 = 3 + 11
-- 16 = 3 + 13
-- 18 = 5 + 13
-- 20 = 3 + 17
-- * (goldbach-list 1 2000 50)
-- 992 = 73 + 919
-- 1382 = 61 + 1321
-- 1856 = 67 + 1789
-- 1928 = 61 + 1867
-- Example in Haskell:

-- λ> goldbachList 9 20
-- [(3,7),(5,7),(3,11),(3,13),(5,13),(3,17)]
-- λ> goldbachList' 4 2000 50
-- [(73,919),(61,1321),(67,1789),(61,1867)]
goldbachList :: Int -> Int -> [(Int, Int)]
goldbachList l u = map (goldbach) $ filter (even) [l .. u]

-- | Logic and Codes

-- Problem 46
-- (**) Define predicates and/2, or/2, nand/2, nor/2, xor/2, impl/2 and equ/2 (for logical equivalence)
--  which succeed or fail according to the result of their respective operations;
--   e.g. and(A,B) will succeed, if and only if both A and B succeed.

-- A logical expression in two variables can then be written as in the following example: and(or(A,B),nand(A,B)).

-- Now, write a predicate table/3 which prints the truth table of a given logical expression in two variables.

-- Example:

-- (table A B (and A (or A B)))
-- true true true
-- true fail true
-- fail true fail
-- fail fail fail
-- Example in Haskell:

-- λ> table (\a b -> (and' a (or' a b)))
-- True True True
-- True False True
-- False True False
-- False False False
and' :: Bool -> Bool -> Bool
and' a b
    | (a, b) == (True, True) = True
    | otherwise              = False

or' :: Bool -> Bool -> Bool
or' a b
    | (a, b) == (False, False) = False
    | otherwise                = True    

not' :: Bool -> Bool
not' a
    | a == False = True
    | a == True  = False

nand' :: Bool -> Bool -> Bool
nand' = and' . not'

nor' :: Bool -> Bool -> Bool
nor' = or' . not'

xor' :: Bool -> Bool -> Bool
xor' a b
    | a == b    = False
    | otherwise = True

impl' :: Bool -> Bool -> Bool
impl' p q = or' (not' p) q

equ' :: Bool -> Bool -> Bool
equ' a b
    | a == b    = True
    | otherwise = False

table :: (Bool -> Bool -> Bool) -> [[Bool]]
table f = map (\x -> (fst x) : (snd x) : f (fst x) (snd x) : []) inputs
    where inputs = [(True, True), (True, False), (False, True), (False, False)]
-- > table (\a b -> (and' a (or' a b)))
-- [[True,True,True],[True,False,True],[False,True,False],[False,False,False]]

-- Problem 47
-- (*) Truth tables for logical expressions (2).

-- Continue problem P46 by defining and/2, or/2, etc as being operators.
-- This allows to write the logical expression in the more natural way, as in the example: A and (A or not B).
-- Define operator precedence as usual; i.e. as in Java.

-- Example:

-- * (table A B (A and (A or not B)))
-- true true true
-- true fail true
-- fail true fail
-- fail fail fail
-- Example in Haskell:

-- λ> table2 (\a b -> a `and'` (a `or'` not b))
-- True True True
-- True False True
-- False True False
-- False False False

-- table (\a b -> a `and'` (a `or'` not b))
-- [[True,True,True],[True,False,True],[False,True,False],[False,False,False]]
-- TODO: I think there's no impl needed here?
-------------------------------

-- Problem 48
-- (**) Truth tables for logical expressions (3).

-- Generalize problem P47 in such a way that the logical expression may contain any number of logical variables.
-- Define table/2 in a way that table(List,Expr) prints the truth table for the expression Expr,
-- which contains the logical variables enumerated in List.

-- Example:

-- * (table (A,B,C) (A and (B or C) equ A and B or A and C))
-- true true true true
-- true true fail true
-- true fail true true
-- true fail fail true
-- fail true true true
-- fail true fail true
-- fail fail true true
-- fail fail fail true
-- Example in Haskell:

-- λ> tablen 3 (\[a,b,c] -> a `and'` (b `or'` c) `equ'` a `and'` b `or'` a `and'` c)
-- -- infixl 3 `equ'`
-- True  True  True  True
-- True  True  False True
-- True  False True  True
-- True  False False True
-- False True  True  True
-- False True  False True
-- False False True  True
-- False False False True

-- -- infixl 7 `equ'`
-- True  True  True  True
-- True  True  False True
-- True  False True  True
-- True  False False False
-- False True  True  False
-- False True  False False
-- False False True  False
-- False False False False

tablen :: Integral b => b -> ([Bool] -> Bool) -> [[Bool]]
tablen n f = map (\i -> i ++ [f i]) inputs
    where colums = [1 .. n]
          bools  = \x -> replicate ((2 ^ x) `div` 2)
          trues  = \x -> bools x True
          falses = \x -> bools x False
        --   inputs = transpose (map (\xs -> take (2 ^ n) (cycle xs)) (map (\x -> trues x ++ falses x) $ reverse colums))
          inputs = transpose (map (\x -> take (2 ^ n) (cycle (trues x ++ falses x))) $ reverse colums)

-- *Main> tablen 3 (\[a,b,c] -> a `and'` (b `or'` c)) -- these set of results seems to be the second bit of the example above
-- [[True,True,True,True],
-- [True,True,False,True],
-- [True,False,True,True],
-- [True,False,False,False],
-- [False,True,True,False],
-- [False,True,False,False],
-- [False,False,True,False],
-- [False,False,False,False]
-- ]
-- *Main> tablen 3 (\[a,b,c] -> a `and'` b `or'` a `and'` c)
-- [[True,True,True,True],
-- [True,True,False,False],
-- [True,False,True,True],
-- [True,False,False,False],
-- [False,True,True,False],
-- [False,True,False,False],
-- [False,False,True,False],
-- [False,False,False,False]
-- ]
          
-- > tablen 3 (\[a,b,c] -> a `and'` (b `or'` c) `equ'` a `and'` b `or'` a `and'` c)
-- [
    -- [True,True,True,True],
    -- [True,True,False,False],
    -- [True,False,True,True],
    -- [True,False,False,False],
    -- [False,True,True,True],
    -- [False,True,False,False],
    -- [False,False,True,False],
    -- [False,False,False,False]
    -- ]
-- TODO: I think the `equ` impl is buggy, as the results have discrepancies 
-- what follows is what helped my "reasoning"
-- *Main> map (\x -> replicate ((2 ^ x) `div` 2) True ++ replicate ((2 ^ x) `div` 2) False) $ reverse colums
-- [[True,True,True,True,False,False,False,False],[True,True,False,False],[True,False]]
-- *Main> map (\xs -> take (2 ^ n) (cycle xs)) [[True,True,True,True,False,False,False,False],[True,True,False,False],[True,False]]
-- [[True,True,True,True,False,False,False,False],[True,True,False,False,True,True,False,False],[True,False,True,False,True,False,True,False]]
-- *Main> transpose [[True,True,True,True,False,False,False,False],[True,True,False,False,True,True,False,False],[True,False,True,False,True,False,True,False]]
-- [[True,True,True],[True,True,False],[True,False,True],[True,False,False],[False,True,True],[False,True,False],[False,False,True],[False,False,False]]
-------------------------------
-- Problem 49
-- (**) Gray codes.

-- An n-bit Gray code is a sequence of n-bit strings constructed according to certain rules. For example,

-- n = 1: C(1) = ['0','1'].
-- n = 2: C(2) = ['00','01','11','10'].
-- n = 3: C(3) = ['000','001','011','010',´110´,´111´,´101´,´100´].
-- Find out the construction rules and write a predicate with the following specification:

-- % gray(N,C) :- C is the N-bit Gray code
-- Can you apply the method of "result caching" in order to make the predicate more efficient, when it is to be used repeatedly?

-- Example in Haskell:

-- λ> gray 3
-- ["000","001","011","010","110","111","101","100"]
gray :: Integral b => b -> [[Char]]
gray n = reverse $ transpose (map (\x -> take (2 ^ n) (cycle (trues x ++ falses x))) $ reverse colums)
    where colums = [1 .. n]
          bools  = \x -> replicate ((2 ^ x) `div` 2)
          trues  = \x -> bools x '1'
          falses = \x -> bools x '0'

-- Problem 50
-- (***) Huffman codes.

-- We suppose a set of symbols with their frequencies, given as a list of fr(S,F) terms.
-- Example: [fr(a,45),fr(b,13),fr(c,12),fr(d,16),fr(e,9),fr(f,5)].
-- Our objective is to construct a list hc(S,C) terms, where C is the Huffman code word for the symbol S.
-- In our example, the result could be Hs = [hc(a,'0'), hc(b,'101'), hc(c,'100'), hc(d,'111'), hc(e,'1101'), hc(f,'1100')] [hc(a,'01'),...etc.].
-- The task shall be performed by the predicate huffman/2 defined as follows:

-- % huffman(Fs,Hs) :- Hs is the Huffman code table for the frequency table Fs
-- Example in Haskell:

-- λ> huffman [('a',45),('b',13),('c',12),('d',16),('e',9),('f',5)]
-- [('a',"0"),('b',"101"),('c',"100"),('d',"111"),('e',"1101"),('f',"1100")]

-- TODO: below is what I have so far
-- *Main GHC.Integer.Logarithms> map ((/ 100) . snd) [('a',45),('b',13),('c',12),('d',16),('e',9),('f',5)]
-- [0.45,0.13,0.12,0.16,9.0e-2,5.0e-2]
-- *Main GHC.Integer.Logarithms> sum $ map ((/ 100) . snd) [('a',45),('b',13),('c',12),('d',16),('e',9),('f',5)]
-- 1.0

----------------------------------------
-- | https://wiki.haskell.org/99_questions/54A_to_60

-- |A binary tree is either empty or it is composed of a root element and two successors,
-- which are binary trees themselves.
data Tree a = Empty | Branch a (Tree a) (Tree a)
              deriving (Show, Eq)

-- This says that a Tree of type a
-- consists of either an Empty node,
-- or a Branch containing one value of type a with exactly two subtrees of type a.
-- Given this definition, the tree in the diagram above would be represented as:
tree1 = Branch 'a' (Branch 'b' (Branch 'd' Empty Empty)
                               (Branch 'e' Empty Empty))
                   (Branch 'c' Empty
                               (Branch 'f' (Branch 'g' Empty Empty)
                                           Empty))

-- Since a "leaf" node is a branch with two empty subtrees, it can be useful to define a shorthand function:
leaf x = Branch x Empty Empty

-- Then the tree diagram above could be expressed more simply as:
tree1' = Branch 'a' (Branch 'b' (leaf 'd')
                                (leaf 'e'))
                    (Branch 'c' Empty
                                (Branch 'f' (leaf 'g')
                                            Empty))

-- Other examples of binary trees:
-- A binary tree consisting of a root node only
tree2 = Branch 'a' Empty Empty

-- An empty binary tree
tree3 = Empty

-- A tree of integers
tree4 = Branch 1 (Branch 2 Empty (Branch 4 Empty Empty))
                 (Branch 2 Empty Empty)

-- Problem 54A
-- (*) Check whether a given term represents a binary tree
-- In Prolog or Lisp, one writes a predicate to do this.
-- Example in Lisp:
-- * (istree (a (b nil nil) nil))
-- T
-- * (istree (a (b nil nil)))
-- NIL

-- Non-solution:
-- Haskell's type system ensures that all terms of type Tree a are binary trees:
-- it is just not possible to construct an invalid tree with this type.
-- Hence, it is redundant to introduce a predicate to check this property:
-- it would always return True.

-- Problem 55
-- (**) Construct completely balanced binary trees

-- In a completely balanced binary tree,
-- the following property holds for every node:
-- The number of nodes in its left subtree and the number of nodes in its
-- right subtree are almost equal,
-- which means their difference is not greater than one.

-- Write a function cbal-tree to construct completely balanced binary trees for
-- a given number of nodes.
-- The predicate should generate all solutions via backtracking.
-- Put the letter 'x' as information into all nodes of the tree.

-- Example:

-- * cbal-tree(4,T).
-- T = t(x, t(x, nil, nil), t(x, nil, t(x, nil, nil))) ;
-- T = t(x, t(x, nil, nil), t(x, t(x, nil, nil), nil)) ;
-- etc......No
-- Example in Haskell, whitespace and "comment diagrams" added for clarity and exposition:

-- -- λ> cbalTree 4
-- [
-- -- permutation 1
-- --     x
-- --    / \
-- --   x   x
-- --        \
-- --         x
-- Branch 'x' (Branch 'x' Empty Empty) 
--            (Branch 'x' Empty 
--                        (Branch 'x' Empty Empty)),

-- -- permutation 2
-- --     x
-- --    / \
-- --   x   x
-- --      /
-- --     x
-- Branch 'x' (Branch 'x' Empty Empty) 
--            (Branch 'x' (Branch 'x' Empty Empty) 
--                        Empty),

-- -- permutation 3
-- --     x
-- --    / \
-- --   x   x
-- --    \
-- --     x
-- Branch 'x' (Branch 'x' Empty 
--                        (Branch 'x' Empty Empty)) 
--            (Branch 'x' Empty Empty),

-- -- permutation 4
-- --     x
-- --    / \
-- --   x   x
-- --  /
-- -- x
-- Branch 'x' (Branch 'x' (Branch 'x' Empty Empty) 
--                        Empty) 
--            (Branch 'x' Empty Empty)
-- ]

-- Branch 'x' (Branch 'x' Empty Empty) (Branch 'x' Empty (Branch 'x' Empty Empty)),
-- Branch 'x' (Branch 'x' Empty Empty) (Branch 'x' (Branch 'x' Empty Empty) Empty),
-- Branch 'x' (Branch 'x' Empty (Branch 'x' Empty Empty)) (Branch 'x' Empty Empty),
-- Branch 'x' (Branch 'x' (Branch 'x' Empty Empty) Empty) (Branch 'x' Empty Empty)


cbalTree :: Int -> [Tree Char]
cbalTree i
    | i == 1 = [one]
    | i == 2 = [two, two'] -- given a one, generate [two, two'] that is append to either Empty side
    | i == 3 = [three]
    | i == 4 = four
    | i == 7 = [branch three three]
    | otherwise = undefined
    where branch = Branch 'x'
          one   = branch Empty Empty
          two   = branch one Empty -- add to the left
          two'  = branch Empty one -- add to the right
          three = branch one one
          four  = [branch one two, branch two one, branch one two', branch two' one]

-- Problem 56
-- (**) Symmetric binary trees

-- Let us call a binary tree symmetric if
-- you can draw a vertical line through the root node and then
-- the right subtree is the mirror image of the left subtree.

-- Write a predicate symmetric/1 to check whether a given binary tree is symmetric.
-- Hint: Write a predicate mirror/2 first to check whether one tree is the mirror image of another.
-- We are only interested in the structure, not in the contents of the nodes.

-- Example in Haskell:
-- λ> symmetric (Branch 'x' (Branch 'x' Empty Empty) Empty)
-- False
-- λ> symmetric (Branch 'x' (Branch 'x' Empty Empty) (Branch 'x' Empty Empty))
-- True 
mirror :: Tree a -> Tree a -> Bool
mirror Empty Empty = True
mirror _ Empty = False
mirror Empty _ = False
mirror (Branch x leftx rightx) (Branch y lefty righty) = (mirror leftx righty) && (mirror lefty rightx)

symmetric :: Tree a -> Bool
symmetric Empty = True
symmetric (Branch x left right) = mirror left right

-- Problem 57
-- (**) Binary search trees (dictionaries)

-- Use the predicate add/3, developed in chapter 4 of the course, 
-- to write a predicate to construct a binary search tree from a list of integer numbers.

-- Example:

-- * construct([3,2,5,7,1],T).
-- T = t(3, t(2, t(1, nil, nil), nil), t(5, nil, t(7, nil, nil)))
-- Then use this predicate to test the solution of the problem P56.

-- Example:

-- * test-symmetric([5,3,18,1,4,12,21]).
-- Yes
-- * test-symmetric([3,2,5,7,4]).
-- No
-- Example in Haskell:

-- λ> construct [3, 2, 5, 7, 1]
-- Branch 3 (Branch 2 (Branch 1 Empty Empty) Empty) (Branch 5 Empty (Branch 7 Empty Empty))
-- λ> symmetric . construct $ [5, 3, 18, 1, 4, 12, 21]
-- True
-- λ> symmetric . construct $ [3, 2, 5, 7, 1]
-- True
--      3
--    2   5 
-- 1        7
singleton :: a -> Tree a
singleton x = Branch x Empty Empty

insert' :: Ord a => a -> Tree a -> Tree a
insert' x Empty = singleton x
insert' x (Branch b left right)
    | x == b = Branch b left right
    | x <  b = Branch b (insert' x left) right
    | x >  b = Branch b left (insert' x right)

construct :: [Int] -> Tree Int
construct xs = foldl (\b a -> insert' a b) Empty xs

-- Problem 58
-- (**) Generate-and-test paradigm

-- Apply the generate-and-test paradigm to construct all symmetric,
--  completely balanced binary trees with a given number of nodes.

-- Example:

-- * sym-cbal-trees(5,Ts).
-- Ts = [t(x, t(x, nil, t(x, nil, nil)), t(x, t(x, nil, nil), nil)), t(x, t(x, t(x, nil, nil), nil), t(x, nil, t(x, nil, nil)))] 
-- Example in Haskell:

-- λ> symCbalTrees 5
-- [Branch 'x' (Branch 'x' Empty (Branch 'x' Empty Empty)) (Branch 'x' (Branch 'x' Empty Empty) Empty),Branch 'x' (Branch 'x' (Branch 'x' Empty Empty) Empty) (Branch 'x' Empty (Branch 'x' Empty Empty))]
-----------------------------
-----------------------------
-- Problem 61
-- Count the leaves of a binary tree

-- A leaf is a node with no successors. Write a predicate count_leaves/2 to count them.

-- Example:

-- % count_leaves(T,N) :- the binary tree T has N leaves
-- Example in Haskell:

-- λ> countLeaves tree4
-- 2
countLeaves :: Tree a -> Int
countLeaves Empty = 0
countLeaves (Branch _ Empty Empty) = 1
countLeaves (Branch x left right)  = (countLeaves left) + (countLeaves right)

-- Problem 61A
-- Collect the leaves of a binary tree in a list

-- A leaf is a node with no successors. Write a predicate leaves/2 to collect them in a list.

-- Example:

-- % leaves(T,S) :- S is the list of all leaves of the binary tree T
-- Example in Haskell:

-- λ> leaves tree4
-- [4,2]
leaves :: Tree a -> [a]
leaves Empty = []
leaves (Branch x Empty Empty) = [x]
leaves (Branch x left right) = (leaves left) ++ (leaves right)

-- Problem 62
-- Collect the internal nodes of a binary tree in a list

-- An internal node of a binary tree has either one or two non-empty successors.
-- Write a predicate internals/2 to collect them in a list.

-- Example:

-- % internals(T,S) :- S is the list of internal nodes of the binary tree T.
-- Example in Haskell:

-- λ> internals tree4
-- [1,2]
internals :: Tree a -> [a]
internals Empty = []
internals (Branch x Empty Empty) = []
internals (Branch x left right) = x : ((internals left) ++ (internals right))

-- Problem 62B
-- Collect the nodes at a given level in a list

-- A node of a binary tree is at level N if the path from the root to the node has length N-1.
-- The root node is at level 1.
-- Write a predicate atlevel/3 to collect all nodes at a given level in a list.

-- Example:

-- % atlevel(T,L,S) :- S is the list of nodes of the binary tree T at level L
-- Example in Haskell:

-- λ> atLevel tree4 2
-- [2,2]
atLevel :: Tree a -> Int -> [a]
atLevel t l = go t l 1
    where go Empty _ _ = []
          go (Branch x Empty Empty) l curr = if l == curr then [x] else []
          go (Branch x left right) l curr =
            if l == curr
            then [x]
            else (go left l (curr + 1)) ++ (go right l (curr + 1))

-- Problem 63
-- Construct a complete binary tree

-- A complete binary tree with height H is defined as follows:

-- The levels 1,2,3,...,H-1 contain the maximum number of nodes (i.e 2**(i-1) at the level i)
-- In level H, which may contain less than the maximum possible number of nodes, all the nodes are "left-adjusted".
-- This means that in a levelorder tree traversal all internal nodes come first,
-- the leaves come second, and empty successors (the nil's which are not really nodes!) come last.
-- Particularly, complete binary trees are used as data structures (or addressing schemes) for heaps.

-- We can assign an address number to each node in a complete binary tree by enumerating the nodes in level-order,
-- starting at the root with number 1.
-- For every node X with address A the following property holds:
-- The address of X's left and right successors are 2*A and 2*A+1, respectively, if they exist.
-- This fact can be used to elegantly construct a complete binary tree structure.

-- Write a predicate complete_binary_tree/2.

-- Example:

-- % complete_binary_tree(N,T) :- T is a complete binary tree with N nodes.
-- Example in Haskell:

-- λ> completeBinaryTree 4
-- Branch 'x' (Branch 'x' (Branch 'x' Empty Empty) Empty) (Branch 'x' Empty Empty)

-- λ> isCompleteBinaryTree $ Branch 'x' (Branch 'x' Empty Empty) (Branch 'x' Empty Empty)
-- True
----------------------------------------------------------------
-- Problem 70B
-- (*) Check whether a given term represents a multiway tree.

-- In Prolog or Lisp, one writes a predicate to check this.

-- Example in Prolog:

-- ?- istree(t(a,[t(f,[t(g,[])]),t(c,[]),t(b,[t(d,[]),t(e,[])])])).
-- Yes
-- In Haskell, we define multiway trees as a datatype, as in the module Data.Tree:

data MTree a = Node a [MTree a] deriving (Eq, Show)
-- Some example trees:

mtree1 = Node 'a' []

mtree2 = Node 'a' [Node 'b' []]

mtree3 = Node 'a' [Node 'b' [Node 'c' []]]

mtree4 = Node 'b' [Node 'd' [], Node 'e' []]

mtree5 = Node 'a' [
                Node 'f' [Node 'g' []],
                Node 'c' [],
                Node 'b' [Node 'd' [], Node 'e' []]
                ]
-- The last is the tree illustrated above.

-- As in problem 54A, all members of this type are multiway trees; there is no use for a predicate to test them.
------------------

-- Problem 70C
-- (*) Count the nodes of a multiway tree.

-- Example in Haskell:

-- λ> nnodes tree2
-- 2
nnodes :: MTree a -> Int
nnodes (Node _ []) = 1
nnodes (Node _ (x:[])) = 1 + (nnodes x)
nnodes (Node _ (x:xs)) = 1 + (nnodes x) + sum (map nnodes xs)

-- Problem 70
-- (**) Tree construction from a node string.

-- We suppose that the nodes of a multiway tree contain single characters.
-- In the depth-first order sequence of its nodes, a special character ^ has been inserted whenever,
-- during the tree traversal, the move is a backtrack to the previous level.
-- By this rule, the tree below (tree5) is represented as: afg^^c^bd^e^^^

-- p70.gif
-- Define the syntax of the string and write a predicate tree(String,Tree) to construct the Tree when the String is given.
-- Make your predicate work in both directions.

-- Example in Haskell:

-- λ> stringToTree "afg^^c^bd^e^^^"
-- Node 'a' [Node 'f' [Node 'g' []],Node 'c' [],Node 'b' [Node 'd' [],Node 'e' []]]
stringToTree :: String -> MTree Char
stringToTree (c:cs)
    | c == '^'  = undefined
    | otherwise = undefined

-- λ> treeToString (Node 'a' [Node 'f' [Node 'g' []],Node 'c' [],Node 'b' [Node 'd' [],Node 'e' []]])
-- "afg^^c^bd^e^^^"
treeToString :: MTree Char -> String
treeToString (Node c []) = c : '^' : []
treeToString (Node c (x:[])) = c : (treeToString x) ++ ['^']
treeToString (Node c (x:xs)) = c : (treeToString x) ++ (xs >>= treeToString) ++ ['^']

----------------------------------------------------------------
-- Graphs
-- https://wiki.haskell.org/99_questions/80_to_89

data Graph a = Graph [a] [(a, a)] deriving Show
data Adjac a = Adjac [(a, [a])] deriving Show

--     b -- c     d
--     \    /
--      \  /         g --- h
--       f --- k
graph1 = Graph ['b','c','d','f','g','h','k'] [('b','c'),('b','f'),('c','f'),('f','k'),('g','h')]
adjac1 = Adjac [('b', "cf"), ('c', "bf"), ('d', ""), ('f', "bck"), ('g', "h"), ('h', "g"), ('k', "f")]

-- Problem 80
-- (***) Conversions

-- Write predicates to convert between the different graph representations.
-- With these predicates, all representations are equivalent;
-- i.e. for the following problems you can always pick freely the most convenient form.
-- The reason this problem is rated (***) is not because it's particularly difficult,
-- but because it's a lot of work to deal with all the special cases.

-- Example in Haskell:

-- λ> graphToAdj Graph ['b','c','d','f','g','h','k'] [('b','c'),('b','f'),('c','f'),('f','k'),('g','h')]
-- Adj [('b', "cf"), ('c', "bf"), ('d', ""), ('f', "bck"), ('g', "h"), ('h', "g"), ('k', "f")]
graphToAdj :: Eq a => Graph a -> Adjac a 
graphToAdj (Graph nodes edges) = Adjac (map (\n -> (n, (getEdges n))) nodes)
    where searchEdges n  = filter (\e -> fst e == n || snd  e == n) edges
          bothDirects es = foldr (\a b -> (fst a) : (snd a) : b) [] es
          format es   n  = filter (/= n) es
          getEdges    n  = format (bothDirects (searchEdges n)) n

-- Problem 81
-- (**) Path from one node to another one

-- Write a function that, given two nodes a and b in a graph, returns all the acyclic paths from a to b.
-- Example in Haskell:

--         /---------\    5 --- 6
--  1 --- 2 --- 3 --- 4
--   \_________/
-- λ> paths 1 4 [(1,2),(2,3),(1,3),(3,4),(4,2),(5,6)]
-- [[1,2,3,4],[1,3,4]]

-- λ> paths 2 6 [(1,2),(2,3),(1,3),(3,4),(4,2),(5,6)]
-- []
paths :: Eq a => Int -> Int -> Graph a -> [[a]]
paths t f (Graph ns es) = undefined --foldl (b a -> b) [[]] es
    where go  = undefined
          searchEdges n edges = filter (\e -> fst e == n) edges
          process edges = nub edges

-- *Main> let t = 1
-- *Main> let f = 4
-- *Main> let es = [(1,2),(2,3),(1,3),(3,4),(4,2),(5,6)]
-- *Main> let searchEdges n edges = filter (\e -> fst e == n) edges
-- *Main> searchEdges t es
-- [(1,2),(1,3)]
-- *Main> (searchEdges 2 es) ++ (searchEdges 2 es)
-- [(2,3),(2,3)]
-- *Main> nub ((searchEdges 2 es) ++ (searchEdges 2 es))
-- [(2,3)]
-- *Main> nub ((searchEdges 2 es) ++ (searchEdges 3 es))
-- [(2,3),(3,4)]
-- *Main> nub ((searchEdges 3 es) ++ (searchEdges 4 es))
-- [(3,4),(4,2)]
-- *Main> searchEdges 4 es
-- [(4,2)]

-- *Main> process (searchEdges t es)
-- [(1,2),(1,3)]
-- *Main> map (\e -> process (searchEdges (snd e) es)) [(1,2),(1,3)]
-- [[(2,3)],[(3,4)]]
-- map (\e -> process (searchEdges (snd e) es)) [(2,3)]
-- [[(3,4)]]

-- *Main> let t = 2
-- *Main> let f = 6
-- *Main> process (searchEdges t es)
-- [(2,3)]
-- *Main> map (\e -> process (searchEdges (snd e) es)) [(2,3)]
-- [[(3,4)]]
-- *Main> map (\e -> process (searchEdges (snd e) es)) [(3, 4)]
-- [[(4,2)]]
-- *Main> map (\e -> process (searchEdges (snd e) es)) [(4, 2)]
-- [[(2,3)]]