110 lines
2.4 KiB
Haskell
110 lines
2.4 KiB
Haskell
|
import qualified Prelude
|
||
|
|
|
||
|
|
-- Paare
|
||
|
|
fst :: (a, b) -> a
|
||
|
|
fst (x, _) = x
|
||
|
|
|
||
|
|
snd :: (a, b) -> b
|
||
|
|
snd (_, y) = y
|
||
|
|
|
||
|
|
-- Funktionskomposition
|
||
|
|
(.) :: (b -> c) -> (a -> b) -> a -> c
|
||
|
|
(f . g) x = f (g x)
|
||
|
|
|
||
|
|
-- Identitätsfunktion
|
||
|
|
id :: a -> a
|
||
|
|
id x = x
|
||
|
|
|
||
|
|
data Bool = True | False deriving (Prelude.Show, Prelude.Eq)
|
||
|
|
|
||
|
|
foldb :: a -> a -> Bool -> a
|
||
|
|
foldb a b True = a
|
||
|
|
foldb a b False = b
|
||
|
|
|
||
|
|
data Nat = Zero | Succ Nat deriving (Prelude.Eq)
|
||
|
|
|
||
|
|
foldn :: a -> (a -> a) -> Nat -> a
|
||
|
|
foldn c g Zero = c
|
||
|
|
foldn c g (Succ n) = g (foldn c g n)
|
||
|
|
|
||
|
|
zero = Zero
|
||
|
|
one = Succ Zero
|
||
|
|
two = Succ one
|
||
|
|
three = Succ two
|
||
|
|
four = Succ three
|
||
|
|
|
||
|
|
add :: Nat -> Nat -> Nat
|
||
|
|
add m = foldn m Succ
|
||
|
|
|
||
|
|
mult :: Nat -> Nat -> Nat
|
||
|
|
mult m = foldn Zero (add m)
|
||
|
|
|
||
|
|
exp :: Nat -> Nat -> Nat
|
||
|
|
exp m = foldn (Succ Zero) (mult m)
|
||
|
|
|
||
|
|
data List a = Nil | Cons a (List a) deriving (Prelude.Show, Prelude.Eq)
|
||
|
|
|
||
|
|
-- fold für Listen
|
||
|
|
foldL :: b -> (a -> b -> b) -> List a -> b
|
||
|
|
foldL c g Nil = c
|
||
|
|
foldL c g (Cons x xs) = g x (foldL c g xs)
|
||
|
|
|
||
|
|
-- scan für Listen
|
||
|
|
scanL :: b -> (a -> b -> b) -> List a -> List b
|
||
|
|
scanL c g Nil = Cons c Nil
|
||
|
|
scanL c g (Cons x xs) = Cons (g x y) ys
|
||
|
|
where ys@(Cons y _) = scanL c g xs
|
||
|
|
|
||
|
|
-- alternativ ohne @-Syntax:
|
||
|
|
scanL' :: b -> (a -> b -> b) -> List a -> List b
|
||
|
|
scanL' c g xs = snd (scanLHelper c g xs)
|
||
|
|
where
|
||
|
|
scanLHelper c g Nil = (c, Cons c Nil)
|
||
|
|
scanLHelper c g (Cons x xs) = (z, Cons z (snd ys))
|
||
|
|
where
|
||
|
|
ys = scanLHelper c g xs
|
||
|
|
z = g x (fst ys)
|
||
|
|
|
||
|
|
length :: List a -> Nat
|
||
|
|
length l = foldL Zero (\x -> Succ) l
|
||
|
|
|
||
|
|
snoc :: a -> List a -> List a
|
||
|
|
snoc a l = foldL (Cons a Nil) Cons l
|
||
|
|
|
||
|
|
reverse :: List a -> List a
|
||
|
|
reverse l = foldL Nil snoc l
|
||
|
|
|
||
|
|
|
||
|
|
-- cat ohne foldr
|
||
|
|
concat :: List a -> List a -> List a
|
||
|
|
concat Nil = id
|
||
|
|
concat (Cons x xs) = \ys -> Cons x (concat xs ys)
|
||
|
|
|
||
|
|
-- cat mit foldr
|
||
|
|
cat' :: List a -> List a -> List a
|
||
|
|
cat' xs ys = foldL ys Cons xs
|
||
|
|
|
||
|
|
data Tree a = Leaf a | Node (Tree a) (Tree a) deriving (Prelude.Show, Prelude.Eq)
|
||
|
|
|
||
|
|
-- fold für Bäume
|
||
|
|
foldt :: (a -> b) -> (b -> b -> b) -> Tree a -> b
|
||
|
|
foldt c g (Leaf x) = c x
|
||
|
|
foldt c g (Node x y) = g (foldt c g x) (foldt c g y)
|
||
|
|
|
||
|
|
-- front ohne foldt
|
||
|
|
front :: Tree a -> List a
|
||
|
|
front (Leaf x) = Cons x Nil
|
||
|
|
front (Node x y) = concat (front x) (front y)
|
||
|
|
|
||
|
|
-- front mit foldt
|
||
|
|
front' :: Tree a -> List a
|
||
|
|
front' = foldt (\x -> Cons x Nil) concat
|
||
|
|
|
||
|
|
-- Fakultätsfunktion aus der Vorlesung
|
||
|
|
fact :: Nat -> Nat
|
||
|
|
fact = f . foldn c h
|
||
|
|
where
|
||
|
|
f = snd
|
||
|
|
c = (Zero, one)
|
||
|
|
h = (\(x,y) -> (Succ x, mult (Succ x) y))
|