139 lines
3.2 KiB
Haskell
139 lines
3.2 KiB
Haskell
--------------------
|
|
-- Exercise 1
|
|
--------------------
|
|
prim c g 0 x = c x
|
|
prim c g n x = g (f (n - 1) x) (n - 1) x
|
|
where
|
|
f = prim c g
|
|
|
|
m2 :: Integer -> () -> Integer
|
|
m2 n x = prim (\_ -> 0) (\a -> \n -> \x -> a + 2) n x
|
|
|
|
-- >>> print (m2 8 ())
|
|
-- 16
|
|
--
|
|
|
|
e2 :: Integer -> () -> Integer
|
|
e2 n x = prim (\_ -> 1) (\a -> \n -> \x -> a * 2) n x
|
|
-- >>> print (e2 4 ())
|
|
-- 16
|
|
--
|
|
|
|
exp :: Integer -> Integer -> Integer
|
|
exp x n = prim (\_ -> 1) (\a -> \n -> \x -> a * x) n x
|
|
-- >>> print (Main.exp 2 3)
|
|
-- 8
|
|
--
|
|
|
|
fact :: Integer -> () -> Integer
|
|
fact n x = prim (\_ -> 1) (\a -> \n -> \x -> a * (n + 1)) n x
|
|
-- >>> print (fact 3 ())
|
|
-- 6
|
|
--
|
|
|
|
--------------------
|
|
-- Exercise 2
|
|
--------------------
|
|
f g x
|
|
| x == 0 = g x
|
|
| otherwise = g $ f g (x - 1)
|
|
-- Nicht endrekursiv
|
|
|
|
length xs = case xs of
|
|
[] -> 0
|
|
x : xs -> (+1) $ Main.length xs
|
|
-- ist endrekursiv
|
|
|
|
length' ls = aux
|
|
$ map ( const 1)
|
|
$ ls
|
|
where
|
|
aux ys = case ys of
|
|
[] -> 0
|
|
[x] -> x
|
|
x : xs -> aux $ map (\y -> (+1) x ) xs
|
|
-- length' und aux sind nicht endrekursiv
|
|
|
|
--------------------
|
|
-- Exercise 3
|
|
--------------------
|
|
-- sieve :: ( a -> a -> Bool ) -> [ a ] -> [ a ]
|
|
-- sieve pred xs = case xs of
|
|
-- [] -> []
|
|
-- x : xs -> x :( sieve pred $ filter ( pred x ) xs )
|
|
sieve :: (a -> a -> Bool) -> [a] -> [a]
|
|
sieve pred xs = realSieve [] xs
|
|
where
|
|
realSieve acc [] = acc
|
|
realSieve acc (x : xs) = realSieve (acc ++ [x]) (filter (pred x) xs)
|
|
|
|
-- >>> sieve (\ x -> \ y -> y > x) [1, 2, 3, 1, 2, 9, 7]
|
|
-- [1,2,3,9]
|
|
--
|
|
--------------------
|
|
-- Exercise 3 b) 1.
|
|
--------------------
|
|
-- >>> (\ n -> sieve (\ x -> \ y -> (y `mod` x) > 0) [2..n]) 100
|
|
-- [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]
|
|
--
|
|
|
|
sieveC :: (a -> a -> Bool) -> [a] -> [a]
|
|
sieveC pred xs = realSieve id xs
|
|
where
|
|
realSieve f [] = f []
|
|
realSieve f (x : xs) = realSieve (\ items -> filter (pred x) (f items)) xs
|
|
|
|
-- >>> sieve (\ x -> \ y -> y > x) [6, 2, 3, 1, 2, 9, 7]
|
|
-- [6,9]
|
|
--
|
|
--------------------
|
|
-- Exercise 3 b) 2.
|
|
--------------------
|
|
-- >>> (\ n -> sieve (\ x -> \ y -> (y `mod` x) > 0) [2..n]) 100
|
|
-- [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]
|
|
--
|
|
|
|
--------------------
|
|
-- Exercise 4
|
|
--------------------
|
|
data Tree a = Tree a [Tree a]
|
|
depth :: Tree a -> Integer
|
|
|
|
-- depth (Tree _ subtrees) =
|
|
-- 1 + (maximum $ 0 : (map depth subtrees))
|
|
depth tree = realDepth [tree] 0
|
|
where
|
|
realDepth [] x = x
|
|
realDepth trees x = realDepth (concatMap (\ (Tree _ subtrees) -> subtrees) trees) (x + 1)
|
|
|
|
-- >>> depth (Tree 1 [Tree 1 []])
|
|
-- 2
|
|
--
|
|
|
|
-- Notes
|
|
-- realDepth [(Tree 1 [Tree 1 []])] 0
|
|
-- realDepth (concatMap (\ (Tree _ subtrees) -> subtrees) [Tree 1 [Tree 1 []]]) (0 + 1)
|
|
-- realDepth [Tree 1 []] 1
|
|
-- realDepth (concatMap (\ (Tree _ subtrees) -> subtrees) [Tree 1 []]) ((0 + 1) + 1)
|
|
-- realDepth [] 2
|
|
-- 2
|
|
|
|
fibonacci :: Integer -> Integer
|
|
fibonacci = fib 0 1
|
|
where
|
|
fib acc b 0 = acc
|
|
fib acc b x = fib b (acc + b) (x - 1)
|
|
|
|
-- >>> fibonacci 6
|
|
-- 8
|
|
--
|
|
|
|
tribonacci :: Integer -> Integer
|
|
tribonacci = trib 0 0 1
|
|
where
|
|
trib acc b c 0 = acc
|
|
trib acc b c x = trib b c (acc + b + c) (x - 1)
|
|
|
|
-- >>> tribonacci 7
|
|
-- 13
|
|
--
|