SSVT Exam 2017

exam.hs

module Exam2018 where

import           Data.List
import           Test.QuickCheck


-- Exercise 5

jos :: Int -> Int -> Int -> Int
jos n k 0 = rem (k-1) n
jos n k i = rem (k + jos (n-1) k (i-1)) n

josPerm :: Int -> Int -> [Int]
josPerm n k = [jos n k i | i <- [0..(n-1)]]

{-
  Properties:
  1) The amount of counted out elements is equal to the inital amount of elements
  2) (Pre: n > k) The first element that's removed is equal to (k - 1)
-}

prop_LengthOfPermEqualsN :: Positive Int -> Positive Int -> Bool
prop_LengthOfPermEqualsN (Positive n) (Positive k) = (length (josPerm n k)) == n

prop_FirstRemovedElementIsKMinusOne :: Positive Int -> Positive Int -> Property
prop_FirstRemovedElementIsKMinusOne (Positive n) (Positive k) = n > k ==> (head (josPerm n k)) == (k - 1)

{-
  If i >= n, it returns an empty string since more kids would be counted out
  than there were kids in the first place.
-}
meeny :: Int -> Int -> [String] -> String
meeny k i kids | i >= n    = ""
               | otherwise = kids !! ((josPerm n k) !! (i - 1))
               where
                 n = length kids


-- Exercise 6

data Tree a = T a [Tree a]
              deriving (Eq,Ord,Show)

grow :: (node -> [node]) -> node -> Tree node
grow step seed = T seed (map (grow step) (step seed))

tree1 n = grow (step1 n) (1,1)
step1 n = \ (x,y) -> if x+y <= n then [(x+y,x),(x,x+y)] else [] -- step function

tree2 n = grow (step2 n) (1,1)
step2 n = \ (x,y) -> if x+y <= n then [(x+y,y),(x,x+y)] else [] -- step function

fGcd :: Integer -> Integer -> Integer
fGcd a b = if b == 0 then a else fGcd b (rem a b)

coprime :: Integer -> Integer -> Bool
coprime n m = fGcd n m == 1

allowedPairs :: Integer -> [(Integer, Integer)]
allowedPairs n = [(x,y) | x <- [1..n], y <- [1..n], coprime x y]

treePairs :: Tree a -> [a]
treePairs (T a []) = [a]
treePairs (T a ns) = [a] ++ concat (map (\ n -> treePairs n) ns)

prop_AllowedPairs :: Positive Integer -> Bool
prop_AllowedPairs (Positive n) = (and (map (\ p -> p `elem` allowed) pairs)) && length allowed == length pairs
  where
    allowed = allowedPairs n
    pairs = treePairs (tree1 n)

prop_AlsoHoldsForTree2 :: Positive Integer -> Bool
prop_AlsoHoldsForTree2 (Positive n) = (sort . treePairs $ (tree1 n)) == (sort . treePairs $ (tree2 n))

{-
  a) `tree1 n` holds as shown with `quickCheck prop_AllowedPairs`

  b) `tree2 n` does hold as well since the pairs in `tree1 n` and `tree2 n`
      are the same proven by: `quickCheck prop_AlsoHoldsForTree2`
-}