Fold in Haskell aus Übung

fold.tex

@@ -0,0 +1,77 @@
+% !TeX encoding = UTF-8
+\documentclass[a4paper]{scrartcl}
+
+\usepackage[ngerman]{babel}
+\usepackage[utf8]{inputenc}
+\usepackage{lmodern}
+\usepackage[T1]{fontenc}
+\usepackage{microtype}
+\usepackage{amsmath}
+\usepackage{amssymb}
+\usepackage{amsfonts}
+\usepackage{enumitem}
+ \usepackage{listings}
+\usepackage{xcolor}
+\usepackage{tikz}
+\usepackage{ziffer}
+\usepackage{lscape}
+ \lstset{
+ 	breaklines=true,
+     postbreak=\mbox{\textcolor{red}{$\hookrightarrow$}\space}
+ }
+
+\usepackage{mathrsfs}
+\usepackage{multicol}
+\usepackage{datetime}
+\usepackage[left=1.5cm, right=1.5cm, top=1.5cm, bottom=2.5cm]{geometry}
+
+\newcommand{\RM}[1]{\MakeUppercase{\romannumeral #1}}
+\usepackage[autostyle=true,german=quotes]{csquotes}
+
+\KOMAoptions{parskip=half, fontsize=12pt}
+\setkomafont{disposition}{\normalcolor\bfseries}
+
+\definecolor{fau}{RGB}{26, 71, 115} % FAU Blau
+\definecolor{natfak}{RGB}{56, 132, 105} % NatFak Grün
+\definecolor{wiso}{RGB}{131, 34, 44} % WISO Rot
+\definecolor{philfak}{RGB}{156, 109, 39} % PhilFak Gelb
+
+% \lstset{frame=tb,
+% 	aboveskip=3mm,
+% 	belowskip=3mm,
+% 	showstringspaces=false,
+% 	columns=flexible,
+% 	basicstyle={\small \ttfamily},
+% 	flexiblecolumns=false,
+% 	keywordstyle=\color{fau_blau}\bfseries,
+% 	commentstyle=\color{fau_tf_grau},
+% 	stringstyle=\color{dkgreen},
+% 	breaklines=true,
+% 	breakatwhitespace=true,
+% 	tabsize=4
+% }
+\usepackage[newfloat,cache=false]{minted}
+
+% Line numbers not flowing out of the margin
+\setminted{numbersep=5pt, xleftmargin=5pt}
+
+
+%\usemintedstyle{bw} %black and white style
+%\usemintedstyle{vs} %visual studio
+%\usemintedstyle{friendlygrayscale} % custom style - submitted as pull request https://bitbucket.org/birkenfeld/pygments-main/pull-requests/748/add-style-friendly-grayscale/diff
+\usemintedstyle{friendly}
+%\usemintedstyle{eclipse} %http://www.jevon.org/wiki/Eclipse_Pygments_Style
+%\usemintedstyle{autumn}
+%\usemintedstyle{rrt}
+%\usemintedstyle{borland}
+
+\input glyphtounicode
+\pdfgentounicode=1
+
+
+\title{ThProg --- Fold in Haskell}
+
+\begin{document}
+\maketitle
+\inputminted[linenos=true,tabsize=2, obeytabs,breaklines]{haskell}{folds.hs}
+\end{document}

folds.hs

@@ -0,0 +1,109 @@
+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))