Links und Funktionen
Sprachumschaltung

Navigationspfad
Sie sind hier: Startseite / Lehre / SS 2018 / Programmierung und Modellierung / ProMo Material / Code 23.05.18


Inhaltsbereich

Code 23.05.18

NEU: preorder, inorder, postorder, instance Foldable Tree, instance Semigroup MySum, instance Monoid MySum, Beweis der Assoziativität von (++)

Haskell source code icon baum2.hs — Haskell source code, 4 KB (5010 bytes)

Dateiinhalt

import Data.Semigroup

-- Code aus Kapitel 4:
--
data Baum = Blatt | Ast Baum Char Baum
 deriving (Show, Eq)

myBaum :: Baum
myBaum = Ast (Ast Blatt 'a' Blatt)
        'T'  (Ast (Ast Blatt 'z' Blatt)
              'n' (Ast Blatt '!' Blatt))

dfCollect :: Baum -> String
dfCollect Blatt  = []
dfCollect (Ast links c rechts)
          = c : dfCollect links ++ dfCollect rechts


-- Ende Code aus Kapitel 4

data Tree a = Empty -- | Node a (Tree a) (Tree a)
            | Node { label::a,  left,right::Tree a }
  --        | Leaf { label::a}
 deriving (Eq)

leaf :: a -> Tree a
leaf a = Node a Empty Empty

t' :: Tree Int
t' = Node 6 (Node 3 (leaf 2) (Node 8 (leaf 5) Empty))
           (Node 8 Empty (leaf 4))

t :: Tree Int
t = Node 6 (Node 3 (leaf 2) (Node 8 (leaf 5) Empty))
           (Node 8 (leaf 4) Empty)

newtype IntTree = IntTree (Tree Int)
instance Show IntTree where
  -- show :: IntTree -> String
  show (IntTree (Empty))      = "Leer"
  show (IntTree (Node x l r)) = "Knoten " ++ (show x) -- TODO finish this


-- instance Show a => Show (Tree a) where
--   -- show :: (Tree a) -> String
--   show (Empty)      = "Empty"
--   show (Node x l r) = "Node "   ++ show x          -- keine Rekursion, sondern Aufruf show für Typ (a)
--                         ++ " (" ++ show l ++ ") "  -- Rekursion, Aufruf show für Typ (Tree a)
--                         ++  "(" ++ show r ++ ")"
--
instance Show a => Show (Tree a) where
  -- show :: (Tree a) -> String
  show (Empty)              = "ε"
  show (Node x Empty Empty) = "<"++ show x ++ ">"
  show (Node x l     r)     = "("    ++ show x        -- keine Rekursion, sondern Aufruf show für Typ (a)
                              ++ "," ++ show l        -- Rekursion, Aufruf show für Typ (Tree a)
                              ++ "," ++ show r ++ ")"

height :: Tree a -> Int
height (Empty)      = 0
height (Node _ l r) = let h_r = height r -- rekursiver Aufruf!!!
                          h_l = height l -- rekursiver Aufruf!!!
                      in 1 + max h_r h_l


-- mapTree :: (a -> b) -> Tree a -> Tree b
-- mapTree _ (Empty) = Empty
-- mapTree f (Node x l r) = Node (f x) (mapTree f l) (mapTree f r)

-- mapList :: (a -> b) -> List a -> List b

-- class Mapper d where
--   mapper :: (a -> b) -> d a -> d b
--
-- instance Mapper Tree where
--   mapper = mapTree
--
-- instance Mapper [] where
--   mapper = map

instance Functor Tree where
  -- fmap :: (a -> b) -> Tree a -> Tree b
  fmap _ (Empty) = Empty
  fmap f (Node x l r) = Node (f x) (f <$> l) (f <$> r)

-- Code 23.05.18
preorder :: Tree a -> [a]
preorder (Empty)      = []
preorder (Node x l r) = [x] ++ preorder l ++ preorder r
-- preorder (Leaf x    ) = [x]

inorder :: Tree a -> [a]
inorder (Empty)      = []
inorder (Node x l r) = inorder l ++ [x] ++ inorder r

postorder :: Tree a -> [a]
postorder (Empty)      = []
postorder (Node x l r) = postorder l ++ postorder r ++ [x]


instance Foldable Tree where
  -- foldMap :: Monoid m => (a -> m) -> Tree a -> m
  foldMap _ Empty        = mempty
  foldMap f (Node x l r) = (foldMap f l) `mappend` (f x) `mappend` (foldMap f r) -- inorder

{-
> sum t
36
> product t
46080
> length t
7
-}

-- Mit Record-Syntax:
-- newtype Sum a     = Sum { getSum :: a }
-- newtype Product a = Product { getProduct :: a }
--
-- Nochmal äquivalent ohne Record-Syntax:
-- newtype Sum a     = Sum a
-- getSum :: Sum a -> a
-- getSum (Sum x) = x
--
-- newtype Product a = Product a
-- getProduct :: Product a -> a
-- getProduct (Product x) = x

newtype MySum a = MySum a
getMySum :: MySum a -> a
getMySum (MySum a) = a

instance Num a => Semigroup (MySum a) where
  MySum x <> MySum y = MySum $ x + y
instance Num a => Monoid (MySum a) where
  mempty  = MySum 0
  mappend = (<>)

-- > getMySum $ foldMap MySum t
-- 36


{-

-- Zur Erinnerung:
(++) :: [a] -> [a] -> [a]
[]   ++ l = l
l    ++[] = l
(h:t)++ l = h:(t++l)

---------------------------------------------------------------------
Beweis von (x++y)++z == x++(y++z) mit Induktion über die Länge von x.
---------------------------------------------------------------------

1. Fall: Sei |x|=0.
Dann gilt x=[] und ([]++y)++z == y++z == []++(y++z) (jeweils mit erster Gleichung von (++), zuerst mit l=y, dann l=(y++z).

2. Fall: Sei |x|=n+1 mit n∈ℕ beliebig.
Dann muss x=(v:w) gelten mit |w|=n, d.h. per Induktion dürfen wir
jetzt (w++y)++z == w++(y++z) annehmen und müssen damit (x++y)++z == x++(y++z) beweisen.
Wir beweisen:
((v:w)++y)++z == (v:(w++y))++z == v:((w++y)++z) == v:(w++(y++z)) == (v:w)++(y++z), wobei
die erste  Gleichung aus der dritten Gleichung von (++) folgt mit h=v, t=w, l=y;
die zweite Gleichung aus der dritten Gleichung von (++) folgt mit h=v, t=(w++y), l=z;
die dritte Gleichung nach der Induktionsannahme gilt, da |w|=n<n+1;
die vierte Gleichung aus der dritten Gleichung von (++) folgt mit h=v, t=w, l=(y++z).
(An der Tafel wurde nicht zwischen v und h unterschieden, was auch nicht notwendig ist, aber vielleicht dem Verständnis hilfreich sein könnte.)

-}


Artikelaktionen


Funktionsleiste