Fold in Haskell aus Übung

This commit is contained in:
Marco Ammon 2018-10-08 16:57:32 +02:00
commit 3ef0cdbd35
3 changed files with 186 additions and 0 deletions

BIN
fold.pdf Normal file

Binary file not shown.

77
fold.tex Normal file
View File

@ -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}

109
folds.hs Normal file
View File

@ -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))