Warning

This page is located in archive.
Go to the latest version of this course pages.
Go the latest version of this page.

The labs usually consist of two parts. In the first part, the teacher introduces new concepts from the last lecture and show students how to use them. In the second part, students are given tasks which they try to solve individually. The solutions to the given tasks will be available after the last lecture of the week.

The goal of this lab is to make the students familiar with the IDE we will use for Scheme and help them write first simple programs.

The IDE can be downloaded for free for Linux, Windows, MAC from: https://racket-lang.org/

Due to the pandemic situation, the labs will be online. Thus students are supposed to install DrRacket on their computers so that they can work on the tasks discussed in the labs.

Get familiar with the definition window and REPL in DrRacket. The documentation of implemented functions is accessible via Help Desk in the menu.

Explain the language (scheme variant) selection options via the #lang directive.

- #lang scheme (same as #lang racket)
- #lang r5rs (if you wish to follow the R5RS standard)

Start interaction in REPL. Scheme uses prefix notation for all functions. Let students compute simple formulas, e.g., 2+3/5.

**Exercise 1:** Write a recursive function `my-even?`

that decides whether a number is even using only functions +, -, = (without mutual recursion).

(define (my-even? n) (cond ([< n 0] (my-even? (- n))) ([= n 0] #t) ([= n 1] #f) (else (my-even? (- n 2))) ) )

**Exercise 2:** Using the function string-append, create a function `(copy-str n str)`

taking as arguments an integer `n`

, a string `str`

and returns a string consisting of `n`

-many copies of `str`

. For example `(copy-str 3 “abc”) ⇒ “abcabcabc”`

.

(define (copy-str n str) (if (<= n 0) "" (string-append str (copy-str (- n 1) str)) ) )

**Exercise 3:** Rewrite the function from Exercise 2 so that it uses tail recursion.

(define (copy-str n str [acc ""]) (if (<= n 0) acc (copy-str (- n 1) str (string-append acc str)) ) )

**Exercise 4:** Write a function `(consecutive-chars first last)`

which takes two characters and returns a string consisting of a sequence of consecutive characters starting with `first`

, ending with `last`

and following the order in ASCII table.
For example
`(consecutive-chars #\A #\D) ⇒ “ABCD”`

or `(consecutive-chars #\z #\u) ⇒ “zyxwvu”`

. For converting characters into positions in ASCII table use functions `char->integer`

and `integer->char`

.

(define (integer->string i) (string (integer->char i)) ) (define (consecutive-chars first last) (define first-index (char->integer first)) (define last-index (char->integer last)) (define step (if (< first-index last-index) 1 -1)) (define (iter k acc) (if (= k last-index) (string-append acc (integer->string k)) (iter (+ k step) (string-append acc (integer->string k))) ) ) (iter first-index "") )

Try to solve the following individual tasks.

**Task 1:** Write a function `num-of-digits`

which takes an integer `n`

and computes the number of digits `n`

has in the standard decimal representation. For example `(num-of-digits 123) ⇒ 3`

or `(num-of-digits -3456) ⇒ 4`

.

*Hint:* The number of digits can be computed by successive dividing the input number by 10. For the integer division, you can use the function `quotient`

.

(define (num-of-digits n [acc 1]) (cond ([< n 0] (num-of-digits-tail (- n))) ([< n 10] acc) (else (num-of-digits-tail (quotient n 10) (+ acc 1))) ) )

** Task 2:** Write a function `(num->str n [radix 10])`

taking as input an integer `n`

together with `radix`

denoting the number of symbols used to represent the number `n`

(for example 2,10,16 for binary, decimal, hexadecimal representation respectively). This function returns a string containing the representation of `n`

in the corresponding numerical system. For the representation use the standard symbols 0123456789ABCDEF.

Examples:

`(num->str 52) ⇒ “52”`

,`(num->str 5 2) ⇒ “101”`

,`(num->str 255 16) ⇒ “FF”`

.

*Hint:* The representation can be obtained by consecutive division of `n`

by `radix`

and collecting the remainders. The remainder after integer division can be computed by the function `remainder`

.

(define (num->str n [radix 10]) (define rem (remainder n radix)) (define initial (if (< rem 10) (char->integer #\0) (- (char->integer #\A) 10))) (define rem-str (string (integer->char (+ initial rem)))) (if (< n radix) rem-str (string-append (num->str (quotient n radix) radix) rem-str) ) )

The main purpose is to practice elementary recursive manipulation with lists. Lists can be decomposed by functions `car`

and `cdr`

. On the other hand, lists can be built by functions `cons, list`

or `append`

. Also higher-order functions `filter`

and `map`

can be used as they were introduced in the second lecture (`map`

only applied to a single list).

**Exercise 1:** Write the function `(my-reverse lst)`

taking a list `lst`

and returning a list consisting of elements from `lst`

in the reverse order. E.g. `(my-reverse '(a b c)) ⇒ (c b a)`

. The function should use the tail recursion.

*Hint:* The idea is to use an accumulator `acc`

storing the intermediate result. We start with an empty accumulator and recursively deconstruct the list `lst`

element by element by means of `car,cdr`

and join them to the accumulator by `cons`

. The computation for `lst = '(a b c)`

and `acc = '()`

go as follows:

`(cdr lst)` | `(cons (car lst) acc)` |
---|---|

'(b c) | '(a) |

'(c) | '(b a) |

'() | '(c b a) |

(define (my-reverse lst [acc '()]) (if (null? lst) acc (my-reverse (cdr lst) (cons (car lst) acc)) ) )Note that using the accumulator is a general concept.

**Exercise 2:** Write a function `(letter-frequencies str)`

which takes a string `str`

and returns a histogram of letters occurring in `str`

so that the most frequent characters come first. The histogram is just a list of pairs `(char . num)`

where `char`

is a character and `num`

is the number of its occurrences in `str`

. E.g. `(letter-frequencies “good”) ⇒ ((#\o . 2) (#\d . 1) (#\g . 1))`

. The string `str`

should be first converted into lowercase characters so that `#\A`

and `#\a`

represent the same character. Non-alphabetic characters should be removed.

*Idea:* The function `letter-frequencies`

is just a composition of several functions.

string-downcase -> string->list -> filter-alphabetic -> sort -> group-same -> join-lengths -> sort

- The function
`string-downcase`

translates all characters into lowercase letters and it is implemented in racket. - The function
`string->list`

is implemented as well and it decomposes a given string into a list of its characters. - Then non-alphabetic characters can be filter out by
`filter`

function using the predicate`char-alphabetic?`

. - To compute the number of occurrences of characters, we apply
`sort`

function which groups together the same characters, e.g.`(sort '(#\c #\z #\c) char<?) ⇒ (#\c #\c #\z)`

. The function`sort`

takes as its second argument a boolean function taking two arguments and comparing them. - The function
`group-same`

scans the input list and returns a list consisting of lists of the same consecutive characters, e.g.`(group-same '(#\c #\c #\z)) ⇒ ((#\c #\c) (#\z))`

. - The function
`join-lengths`

creates for each group of the same character a pair of the for (char . num) where the number of occurrences num is computed by function`length`

. - Finally, the output is sorted by numbers of occurrences.

The function `group-same`

is the only recursive function in our program. It has to keep as an intermediate result a partially built group of the same character. If the new character `(car l)`

coming from the list is the same as the current character in the group, the partial group is extended by this character. Once the new character `(car l)`

differs from the current character in the group, the partial group is closed, joined to the output and a new group is created.

(define (group-same lst) (define (iter l gr) (cond ([null? l] (list gr)) ([eqv? (car gr) (car l)] (iter (cdr l) (cons (car gr) gr))) (else (cons gr (iter (cdr l) (list (car l))))) ) ) (if (null? lst) '() (iter (cdr lst) (list (car lst))) ) ) (define (join-lengths grs) (map (lambda (g) (cons (car g) (length g))) grs) ) (define (letter-frequencies str) (sort (join-lengths (group-same (sort (filter char-alphabetic? (string->list (string-downcase str))) char<?))) (lambda (x y) (> (cdr x) (cdr y)))) )

If you wish, you can use function `file->string`

to check letter frequencies in any file, for instance in Shakespeare's Sonnets by calling `(letter-frequencies (file->string "sonnets.txt"))`

and comparing the result with the letter frequencies in English alphabet Wikipedia.

**Task 1:** Write a function `(average-list lst)`

taking a list of numbers `lst`

and returning their arithmetical average. E.g. `(average-lst '(1 2 3)) ⇒ 3`

. The function should be tail-recursive.

*Hint:* As the function should be tail-recursive, it has to use an accumulator storing a partial sum of elements from the list. Finally, the resulting sum is divided by the number of all elements in the list. For the number of elements in `lst`

, you can use the function `length`

.
Depending on your implementation function can return precise rational numbers like `(average-list '(0 1)) ⇒ 1/2`

. If you want to have the usual floating-point representation, use the function `exact->inexact`

transforming the result into imprecise floting-point representation.

(define (average-list lst) (define (iter l acc) (if (null? l) acc (iter (cdr l) (+ acc (car l))) ) ) (exact->inexact (/ (iter lst 0) (length lst))) )

**Task 2:** Taking an inspiration from the `group-same`

function, write a function `(split-list n lst)`

which takes a natural number `n`

and a list `lst`

and returns a list of lists consisting of `n`

-tuples of consecutive elements from `lst`

. E.g. `(split-list 2 '(a b 1 2 3 4)) => ((a b) (1 2) (3 4))`

. In case the number of elements is not divisible by `n`

, make the last list in the output shorter. E.g. `(split-list 3 '(a b 1 2)) => ((a b 1) (2))`

.

Using functions `split-list`

and `average-list`

from the previous task, write a function `(n-block-average n lst)`

which splits a given list of numbers `lst`

into `n`

-tuples of consecutive numbers and returns a list of averages of these `n`

-tuples. E.g. `(n-block-average 2 '(1 3 1 5)) ⇒ (2 3)`

.

*Hint:* The function `split-list`

needs two accumulators. The first accumulator keeps a partially built segment of consecutive elements and the second tracks how many elements we have to read from the list to complete the `n`

-tuple of consecutive elements.

(define (split-list n lst) (define (iter l k segment) (cond ([null? l] (list segment)) ([= k 0] (cons segment (iter l n '()))) (else (iter (cdr l) (- k 1) (append segment (list (car l))))) ) ) (iter lst n '()) ) (define (n-block-average n lst) (map average-list (split-list n lst)) )

**Exercise 1:** Write a function `(mult-all-pairs lst1 lst2)`

taking two lists and returning a list of all possible binary products between elements from `lst1`

and elements from `lst2`

. Mathematically, it could be written by a comprehension term as `[ x*y | x in lst1, y in lst2 ]`

. E.g. `(mult-all-pairs '(1 2 3) '(-2 0)) ⇒ (-2 0 -4 0 -6 0)`

. Once you have it, generalize your function to `(f-all-pairs f lst1 lst2)`

so that the multiplication is replaced by any binary function `f`

. E.g. `(f-all-pairs cons '(1 2 3) '(a b)) ⇒ ((1 . a) (1 . b) (2 . a) (2 . b) (3 . a) (3 . b))`

.

*Hint:* These functions are just applications of two nested `map`

functions. For each element `x`

in `lst1`

we multiply by `x`

all elements in `lst2`

. A function multiplying by `x`

can be created from the multiplication function `*`

by partial application of `x`

, i.e.,
we take the curryfied version of `*`

and apply it to `x`

yielding `((curry *) x)`

. Once we map `((curry *) x)`

along `lst2`

, the result is a list. So doing it for each `x`

in `lst1`

results in a list of lists. Thus we have to flatten the result and append all the lists. This can be done by `apply`

-ing `append`

.

(define (mult-all-pairs lst1 lst2) (apply ; flatten the result append (map (lambda (x) (map ((curry *) x) lst2)) ; multiply all elements of lst2 by x lst1) ; do it for each element x in lst1 ) ) (define (f-all-pairs f lst1 lst2) (apply append (map (lambda (x) (map ((curry f) x) lst2)) lst1) ) )

**Exercise 2:** Suppose we represent univariate polynomials as lists of monomials. Each monomial of the form $ax^n$ is represented as a list `(a n)`

consisting of the coefficient `a`

and the exponent `n`

. Thus the polynomial $2-3x+x^2$ is represented by `((2 0) (-3 1) (1 2))`

. We assume that each exponent can occur in the polynomial representation at most once. E.g. `((1 0) (2 0))`

is not a valid representation. Devise functions `(add-pol p1 p2)`

and `(mult-pol p1 p2)`

taking as arguments two polynomials `p1,p2`

and returning their sum and product respectively. For example, let `p1`

be `((1 0) (1 1))`

(i.e., $p_1(x)=1+x$) and `p2`

`((-1 0) (1 1) (3 2))`

(i.e., $p_2(x)=-1+x+3x^2$). Then

(add-pol p1 p2) => ((2 1) (3 2)) (mult-pol p1 p2) => ((-1 0) (4 2) (3 3))Even though it might look like a tedious task, it is not so terrible because we will call higher-order functions to rescue us. Thanks to the folding function

`foldl`

, we will reduce our problem just to monomials. Let's start by defining simple operations on monomials. To make our code more comprehensible, we define the following functions extracting the coefficient and the exponent from a monomial.
(define (get-coef m) (car m)) ; first component (define (get-exp m) (cadr m)) ; second componentNext it is easy to define addition of two monomials of the same exponents, namely $ax^n + bx^n = (a+b)x^n$. Similarly, multiplication of monomials is defined by $(ax^n)(bx^k)=abx^{n+k}$.

(define (add-mon m1 m2) (list (+ (get-coef m1) (get-coef m2)) ; sum coefficients (get-exp m1)) ; keep exponent ) (define (mult-mon m1 m2) (list (* (get-coef m1) (get-coef m2)) ; multiply coefficients (+ (get-exp m1) (get-exp m2))) ; sum exponents )

Now we come to the main trick. Suppose we have two polynomials $p_1(x)=a_0+a_1x$ and $p_2(x)=b_0+b_1x+b_2x^2$. We can express their sum as
$p_1(x) + p_2(x) = ((p_1(x) + b_0) + b_1x) + b_2x^2$. Thus we need only to add a **polynomial** and a **monomial** at a single steps. Then the repetitive sum can be done by `foldl`

function. Similarly for the multiplication, we can first compute products of all monomials by means of the function `f-all-pairs`

from Exercise 1 and then express the results as $p_1(x)p_2(x) = (((a_0b_0 + a_0b_1x) + a_0b_2x^2) + a_1b_0x) + \cdots$.

Thus we need a function adding a monomial `mon`

and a polynomial `pol`

. The function has to distinguish two cases: 1) we add a monomial whose exponent does not occur in `pol`

, 2) or whose exponent occurs in `pol`

. So we first filter monomials in `pol`

according to their exponents
to obtain the monomial of the same exponent as `mon`

and the remaining monomials. If there is no monomial of the same exponent, we just cons `mon`

to the result, otherwise we add monomials of the same exponent and cons it to the result.

(define (add-mon-pol mon pol) (define (same-exp? m) (= (get-exp mon) (get-exp m))) ; #t if m has the same exponent as mon (define same-mon (filter same-exp? pol)) ; list containing the monomial of the same exponent or empty list (define rest (filter (compose not same-exp?) pol)) ; remaining monomials of different exponents (if (null? same-mon) (cons mon rest) (cons (add-mon mon (car same-mon)) rest)) )

Finally, we can apply the folding function `foldl`

to sum all monomials as was shown above. However, there are still two problems we have to deal with. 1) It may happen that the result contains monomials of the form $0x^n$. Such monomials can be clearly filtered out of the result. 2) It is common to sort monomials according to their exponents. Thus we define a function `normalize`

solving these two problems.

(define (normalize p) (define (non-zero-coef? m) (not (= 0 (get-coef m)))) (sort (filter non-zero-coef? p) (lambda (p1 p2) (< (get-exp p1) (get-exp p2)))) ) (define (add-pol p1 p2) (normalize (foldl add-mon-pol p1 p2)) ) (define (mult-pol p1 p2) (normalize (foldl add-mon-pol '() (f-all-pairs mult-mon p1 p2))) )

**Task 1:** Write a function `linear-combination`

taking a list of vectors, a list of coefficients and returning the corresponding linear combination. The function should be created in the curried form (the list of vectors being the first argument) because it will be convenient for the next task. For example, consider a linear combination $2\cdot(1, 2, 3) - 1\cdot(1, 0, 1) + 3\cdot(0, 2, 0) = (1,10,5)$. Then your implementation should work as follow:

((linear-combination '((1 2 3) (1 0 1) (0 2 0))) '(2 -1 3)) => (1 10 5)

*Hint:* Create first a binary function computing scalar multiplication of a scalar and a vector using `map`

. Then use the fact that `map`

can apply the scalar multiplication to two lists simultaneously (in our case the list of coefficients and the list of vectors). This results in a list of vectors multiplied by respective coefficients. Then it suffices to sum them component by component.

(define (scalar-mult coef vec) (map ((curry *) coef) vec) ) (define (linear-combination vectors) (lambda (coefs) (apply map + (map scalar-mult coefs vectors)) ) )

**Task 2:** Use the function from the previous task to define a function `(matrix-mult m1 m2)`

computing the matrix multiplication of `m1`

and `m2`

. Then apply `foldl`

function to define the power of a square matrix, i.e., a function `(matrix-power k mat)`

computing `k`

-fold product of `mat`

. You can assume that $k\geq 1$ so that there is no need to define the identity matrix. E.g.

(matrix-mult '((1 2 3) (-1 0 2)) '((1 -1) (2 0) (0 3))) => ((5 8) (-1 7)) (matrix-power 3 '((2 3) (0 -1))) => ((8 -9) (0 -1))

*Hint:* Use the fact that the matrix multiplication is just a repeated application of the `linear-combination`

function. More precisely, consider $m_1\cdot m_2$. The $i$-th row of the result is just the linear combination of the rows of $m_2$ with the coefficients taken from the $i$-th row of $m_1$. So it suffices to apply the `(linear-combination m_2)`

to each row of $m_1$.

To define the matrix power, use the `foldl`

function applied to a list composed of the same matrix `mat`

. To create such a list, use function `(make-list n el) ⇒ (el el … el)`

.

(define (matrix-mult m1 m2) (map (linear-combination m2) m1) ) (define (matrix-power k mat) (foldl matrix-mult mat (make-list (- k 1) mat)) )

**Exercise 1:** Write a function `(permutations lst)`

taking a list `lst`

and returning all its permutations. E.g. `(permutations '(1 2 3)) => ((1 2 3) (2 1 3) (2 3 1) (1 3 2) (3 1 2) (3 2 1))`

.

*Hint:* Suppose that we have all permutations of a list of length $n$ and we want to build all permutations of its extension by an element. To do that it suffices to take the element and interleave it in all possible ways into all the permutations of length $n$. For instance, `((2 3) (3 2))`

are all permutations of the list `(2 3)`

. If we want to compute all permutations of `(1 2 3)`

, we take each permutation of length 2 and interleave the element `1`

into it as follows:

(2 3) => ((1 2 3) (2 1 3) (2 3 1)) (3 2) => ((1 3 2) (3 1 2) (3 2 1))Appending all these lists gives us the desired permutations of

`(1 2 3)`

.
Write first a function `interleave`

taking an element, a list and returning all possible ways of inserting the element into the list.
Using this function, devise the function `permutations`

using the recursion on the length of `lst`

.

(define (interleave el) (lambda (lst) (if (null? lst) (list (list el)) ; there is only a single way one can insert el into '() (cons (cons el lst) ; otherwise one possibility is to prepend el to lst (map ((curry cons) (car lst)) ((interleave el) (cdr lst)))) ; or take all possible insertions of el into (cdr lst) ) ; and prepend (car lst) ) ) (define (permutations lst) (if (null? lst) '(()) (apply append (map (interleave (car lst)) (permutations (cdr lst)))) ; into each permutation of (cdr lst) interleave (car lst) ) ; and append the results )

**Exercise 2:** Binary decision trees are tree representing Boolean functions, i.e., functions from $\{0,1\}^n$ to $\{0,1\}$. Let $f(x_1,\ldots,x_n)$ be a Boolean function. The corresponding binary decision tree is created as follows:

- Each input variable $x_i$ induces the $i$th-level in the tree whose nodes are labelled by $x_i$.
- Leaves are elements from $\{0,1\}$.

Each path from the root to a leaf encodes an evaluation of input variables. If the path in an internal node $x_i$ goes to the left, the variable $x_i$ is evaluated by $0$. If to the right, it is evaluated by $1$. The leaf in the path represents the value $f(x_1,\ldots,x_n)$ for the evaluation defined by the path. Example of a Boolean function and its binary decision tree:

We will represent such binary tree in Scheme by nested lists. The internal nodes are of the form `(<var> <left-subtree> <right-subtree>)`

. For instance, the above tree is represented as follows:

(define bool-tree '(x1 (x2 (x3 1 0) (x3 0 1)) (x2 (x3 0 0) (x3 1 1))))

Your task is to write two functions. The first one `(evaluate tree vals)`

takes a binary decision tree `tree`

representing a Boolean function $f(x_1,\ldots,x_n)$, a list `vals`

of values of variables $x_1,\ldots,x_n$ and returns $f(x_1,\ldots,x_n)$. E.g.

(evaluate bool-tree '(1 0 1)) => 0 (evaluate bool-tree '(0 1 1)) => 1The second function

`(satisficing-evaluations tree)`

taking a binary decision tree `tree`

representing a Boolean function $f(x_1,\ldots,x_n)$ and returning all its satisficing evaluations, i.e., those for which $f(x_1,\ldots,x_n)=1$. E.g.
(satisficing-evaluations bool-tree) => (((x1 0) (x2 0) (x3 0)) ((x1 0) (x2 1) (x3 1)) ((x1 1) (x2 1) (x3 0)) ((x1 1) (x2 1) (x3 1)))

Before we start to code the functions itself, we define a couple of helper functions accessing the members of a node.

(define (variable tree) (car tree)) (define (left-subtree tree) (cadr tree)) (define (right-subtree tree) (caddr tree))Such functions are not necessary but it is a good practice to define them for the following reasons:

- Your code is more readable. E.g. if I write
`(iter (right-subtree tr) …`

, then it is clear that I iterate over the right subtree. On the other hand, one has to remember the precise structure of the node to understand`(iter (caddr tr) …`

. - Such helper functions erect so-called abstraction barriers between your code and the data representation. If you decide for some reason to change your representation (e.g, to change the structure of nodes to
`(<left-subtree> <var> <right-subtree>)`

), it suffices to recode only helpers functions. The rest of your code stays untouched unlike the case when you don't use them.

We devise two versions of `evaluate`

. The first is recursive function consuming consecutively values of $x_1,\ldots,x_n$ and based on its value recursively evaluate either left or right subtree. Once all the values are consumed, we should be in a leaf specifying the value of $f(x_1,\ldots,x_n)$.

(define (evaluate tree vals) (cond ([null? vals] tree) ; the leaf is the resulting value ([= (car vals) 0] (evaluate (left-subtree tree) (cdr vals))) ; if the variable value is 0, go to the left (else (evaluate (right-subtree tree) (cdr vals))) ; otherwise go to the right ) )

The second version uses higher-order functions. It takes the list of values of $x_1,\ldots,x_n$ and converts it into the list of functions `left-subtree`

, `right-subtree`

corresponding to the path defined by `vals`

. Finally, it applies their composition to `tree`

.

(define (evaluate2 tree vals) (define (left-right v) ; define function 0 -> left-subtree, 1 -> right-subtree (if (= v 0) left-subtree right-subtree)) ((apply compose (map left-right (reverse vals))) tree) ; map it over vals, compose and apply to tree )

The function `satisficing-evaluations`

is a recursive function using an accumulator `ev`

keeping partial evaluation as we traverse the tree.
It recursively finds all satisficing evalutions of the left and right subtree, extend them by $0$ (resp. $1$) if they come from left (resp. right), and append them together.

(define (satisficing-evaluations tree) (define (make-assignment var val) (list var val)) ; a helper function creating an assignment (define (iter tr ev) (if (number? tr) ; are we in a leaf? (if (= tr 1) (list (reverse ev)) '()) ; if yes and the resulting value is 1 return that evaluation, otherwise discard it (append (iter (left-subtree tr) (cons (make-assignment (variable tr) 0) ev)) ; if not, extend the partial evaluation ev (iter (right-subtree tr) (cons (make-assignment (variable tr) 1) ev))) ; recursively collects satisficing evaluations for ) ; left and right subtree and append ) (iter tree '()) )

**Task 1:** Write a function `(sub-seq lst)`

taking a list `lst`

and returning a list of all its sublists/subsequences. E.g.

(sub-seq '(1 2 3)) => (() (3) (2) (2 3) (1) (1 3) (1 2) (1 2 3))

*Hint:* Code it as a recursive function using the following facts. 1) There is only a single subsequence of the empty list, namely the empty list. 2) Subsequences of $(x_1,x_2,\ldots,x_n)$ are just subsequences of $(x_2,\ldots,x_n)$ together with subsequences starting with $x_1$ and following by a subsequence of $(x_2,\ldots,x_n)$.

(define (sub-seq lst) (if (null? lst) '(()) (let ([el (car lst)] [rest-sub-seq (sub-seq (cdr lst))]) (append rest-sub-seq (map ((curry cons) el) rest-sub-seq)) ) ) )

**Task 2:** Consider a binary tree representing a tournament. Each internal node corresponds to a match. Its structure is `(<winner> <left-subtree> <right-subtree>)`

. Leafs are of the form `(<team>)`

. E.g.

(define tournament '(F (D (A (A) (B)) (D (C) (D))) (F (F (E) (F)) (G (G) (H)))))represents the following tree:

F / \ / \ / \ / \ / \ D F / \ / \ / \ / \ A D F G / \ / \ / \ / \ A B C D E F G H

Write a function `(beaten-teams tree)`

taking a binary tournament tree and outputting the list of beaten teams by the winner. E.g. `(beaten-teams tournament) ⇒ (D G E)`

.

*Hint:* Code it as a recursive function starting in the root defining the winner of the tournament. Then follow the path labelled by the winner and collects the beaten teams along the path to an accumulator. Once you are in a leaf return the accumulator.

(define (beaten-teams tree) (define (winner tr) (car tr)) (define (is-leaf? tr) (= (length tr) 1)) (define (left-subtree tr) (cadr tr)) (define (right-subtree tr) (caddr tr)) (define (iter tr acc) (cond ([is-leaf? tr] acc) ([eqv? (winner (left-subtree tr)) (winner tree)] (iter (left-subtree tr) (cons (winner (right-subtree tr)) acc))) (else (iter (right-subtree tr) (cons (winner (left-subtree tr)) acc))) ) ) (iter tree '()) )

**Exercise 1:** Define a function `(stream-add s1 s2)`

adding two infinite streams together component-wise. For instance,

0 1 2 3 4 5 6 .... + 1 1 1 1 1 1 1 .... -------------------- 1 2 3 4 5 6 7 ....Using

`stream-add`

, define the infinite stream `fib-stream`

of all Fibonacci numbers. We can test it for instance as follows:
(stream->list (stream-take fib-stream 10)) => (0 1 1 2 3 5 8 13 21 34)

Adding two infinite streams can be done recursively. Since the streams are infinite we do not have to check the emptiness of any of the input streams.

(define (stream-add s1 s2) (stream-cons (+ (stream-first s1) (stream-first s2)) (stream-add (stream-rest s1) (stream-rest s2))))The definition of Fibonacci sequence $F(0)=0$, $F(1)=1$, and $F(n)=F(n-1) + F(n-2)$ for $n>1$ can be reformulated as follows:

0 1 1 2 3 5 8 13 ... ; F(n-2) - Fibonacci sequence + 1 1 2 3 5 8 13 21 ... ; F(n-1) - shifted Fibonacci sequence to the left by one element ---------------------------- 0 1 1 2 3 5 8 13 21 34 ... ; Fibonacci sequence starts with 0,1 followed by the sum of the above sequences

This directly leads to the following code:

(define fib-stream (stream-cons 0 (stream-cons 1 (stream-add fib-stream (stream-rest fib-stream)))) )

Apart from streams, this lab is also focused on graphs. A graph $G=(V,E)$ is a tuple consisting of a set of vertices $V$ (also called nodes) and a set of edges
$E\subseteq\{\{u,v\}\mid u,v\in V, u\neq v\}$. We will represent a graph in Scheme as a list of two lists. The first is a list of vertices and the second is a list of edges. An edge $\{u,v\}$ is represented as a list `(u v)`

. We define a constructor for a graph and helper functions getting
the list of vertices and the list of edges.

(define (make-graph nodes edges) (list nodes edges)) (define (get-nodes g) (car g)) (define (get-edges g) (cadr g))

The following graph is represented as follows:

(define gr (make-graph '(1 2 3 4 5 6) '((1 2) (1 5) (2 3) (2 5) (3 4) (4 5) (4 6))))

**Exercise 2:** Given a graph $G$, a Hamiltonian path is a path visiting each vertex of $G$ exactly once (see wikipedia). We will represent a path as a list of consecutive nodes in the path. The above graph `gr`

has a Hamiltonian path `(3 2 1 5 4 6)`

.

Write a function `(find-hamiltonian-path g)`

which takes a graph as its input and returns a Hamiltonian path, if it exists, and `#f`

otherwise.
E.g.

(find-hamiltonian-path gr) => (3 2 1 5 4 6) (find-hamiltonian-path (make-graph '(a b c d) '((a b) (a c) (a d)))) => #f

As a Hamiltonian path traverses each node exactly once, if it exists, it has to be represented by a permutation of the nodes. Thus we can apply the function `permutations`

from the previous lab to generate all permutations of nodes and check for each of them whether it forms a Hamiltonian path or not. We start with a definition of a function checking if a given list of nodes is a path. For that, we need a function testing whether a pair of nodes is connected.

; test whether a pair of nodes is connected (define (edge? g) (lambda (p) (define edges (get-edges g)) (or (member p edges) (member (reverse p) edges)) ) )Given a list, we create a list of pairs of consecutive nodes. E.g.

`(1 2 3 4)`

is transformed to `((1 2) (2 3) (3 4))`

. This is done
by taking `(1 2 3)`

and `(2 3 4)`

and joining them by mapping `list`

element-wise. Finally, we test whether all these pairs are connected.
To do so, we use the function `(andmap f lst)`

. This function is implemented in Racket. It behaves like `map`

but it aggregates the results of `f`

by `and`

function, i.e., once any of the results is `#f`

, it returns `#f`

and the last result otherwise.
(define (check-path g) (lambda (lst) (define but-last (take lst (- (length lst) 1))) (if (andmap (edge? g) (map list but-last (cdr lst))) lst #f) ) )Now we can apply the above function to all permutation. The function

`(check-path g)`

for a graph `g`

either returns `lst`

if `lst`

forms a path or `#f`

otherwise. Thus we can map it over all permutations of nodes and filter those which form a path. If there is a permuation being a path at the same time, we have a Hamiltonian path. Otherwise, we return `#f`

.
(define (find-hamiltonian-path g) (define nodes (get-nodes g)) (define perms (permutations nodes)) (let ([paths (filter identity (map (check-path g) perms))]) (if (null? paths) #f (car paths) ) ) )

**Task 1:** Write a function `(stream-mul s1 s2)`

taking two infinite streams and multiplying them elements-wise. Using this function, define an infinite stream `factorial-stream`

of factorials $0!, 1!, 2!, 3!,\ldots$.

*Hint:* The recursive definition of factorial $f(0)=1$ and $f(n)=n\cdot f(n-1)$ for $n>0$ gives us

1 2 3 4 5 ... ; n * 1 1 2 6 24 ... ; f(n-1) -------------------- 1 1 2 6 24 120 ... ; f(n)In your definition, you can use the function

`(in-naturals n)`

implemented in Racket defining the stream of natural numbers starting from n.
Once you have the stream of factorials `factorial-stream`

, the function `stream-mul`

and the stream of natural numbers `(in-natural 0)`

(or even simply `(in-naturals)`

), you can define a function `(exp-stream x)`

taking a number `x`

and returning the power series representing $e^x$, i.e., $e^x = 1 + x + \frac{x^2}{2!} + \frac{x^3}{3!} + \cdots$. Then you can approximate the value $e^x$ by summing an initial segment of this stream. E.g. to approximate $e$, we can sum the first 100 elements:

(apply + (stream->list (stream-take (exp-stream 1.0) 100)))

(define (stream-mul s1 s2) (stream-cons (* (stream-first s1) (stream-first s2)) (stream-mul (stream-rest s1) (stream-rest s2)))) (define factorial-stream (stream-cons 1 (stream-mul (in-naturals 1) factorial-stream))) (stream->list (stream-take factorial-stream 10)) (define (exp-stream x) (define recipr (stream-map ((curry /) 1) factorial-stream)) (define powers (stream-map ((curry expt) x) (in-naturals))) (stream-mul powers recipr) )

**Task 2:** Given a graph $G=(V,E)$, a subset of nodes $S\subseteq V$ is called a vertex cover, if for every edge $\{u,v\}\in E$, we have
$u\in S$ or $v\in S$. If $S$ is smallest possible, it is called minimum vertex cover (see wikipedia).

Write a function `(min-vertex-cover g)`

taking a graph `g`

and returning a minimum vertex cover of `g`

. E.g.

(min-vertex-cover gr) => (1 2 4)

*Hint:* The idea is similar to Exercise 2. Instead of all permutations, we can take all subsets of nodes. Subsets can be generated by the function `sub-seq`

from the previous lab. We can sort them by cardinality and starting from the smallest ones, we can check which of them form a vertex cover. In fact, it is computationally more efficient, if we create a stream of subsets so that subsets are computed lazily as they are needed.
Thus we can test smaller subsets first without computing large ones. To create such a lazy stream, we can modify the function `sub-seq`

. It is basically the same code where list functions are replaced by their stream equivalents. However, our original function `sub-seq`

does not generate subsets ordered by their cardinality. To fix this, we have to modify the function merging together the result of the recursive call and the newly created subsets. Thus we define a function `(stream-merge s1 s2 cmp)`

which takes two streams and a function `cmp`

comparing two elements of these streams and returns a stream where the values are merged so that the smaller elements come first.

; lazy subsequences (define (stream-merge s1 s2 cmp) (cond ([stream-empty? s1] s2) ([stream-empty? s2] s1) ([cmp (stream-first s1) (stream-first s2)] (stream-cons (stream-first s1) (stream-merge (stream-rest s1) s2 cmp))) (else (stream-cons (stream-first s2) (stream-merge s1 (stream-rest s2) cmp))) ) ) (define (sub-seq lst) (if (null? lst) (stream '()) (let ([el (car lst)] [rest-sub-seq (sub-seq (cdr lst))]) (stream-merge rest-sub-seq (stream-map ((curry cons) el) rest-sub-seq) (lambda (x y) (< (length x) (length y)))) ) ) )

; minimum vertex cover = smallest subset of nodes such that each edge has one of its node in it (define (check-cover g) (define edges (get-edges g)) (lambda (lst) (if (andmap (lambda (e) (or (member (car e) lst) (member (cadr e) lst))) edges) lst #f) ) ) (define (min-vertex-cover g) (define nodes (get-nodes g)) (stream-first (stream-filter identity (stream-map (check-cover g) (sub-seq nodes)))) )

This lab is closely related to the corresponding lecture. In that lecture, I showed how to implement an interpreter of a simple programming language Brainf*ck (for details see wikipedia). The syntax of Brainf*ck is very simple. It is just a sequence of eight possible characters: < > + - , . [ ]. The semantics of this language is captured by a tape of a fixed size consisting of positive numbers and having a pointer pointing to an active number. Brainf*ck programs specify computations over this tape.

Symbol | Meaning |
---|---|

< | move pointer to the left by one step |

> | move pointer to the right by one step |

+ | increase the active number determined by pointer by one |

- | decrease the active number determined by pointer by one |

, | read one number from input and store it |

. | display the active number |

[ `code` ] | while the active number is not zero, execute `code` |

As I explained in the lecture, Scheme/Racket can represent any tree structure as data. Thus we don't need to write a parser and represent Brainf*ck
directly as a list of commands where cycles are recursively represented by nested lists. The only limitation with this approach is the special meaning of symbols , and . in Racket. So we replace them by symbols @ * respectively. For instance, the program reading the first two numbers from input, adding them and displaying the result `,>,[-<+>]<.`

is represented in Racket as follows:

'(@ > @ [- < + >] < *)The square brackets are interpreted in Racket as parentheses so the cycle automatically creates a nested list. Another example for your test cases is the program multiplying two numbers:

'(@ > @ < [- > [- > + > + < <] > [- < + >] < <] > > > *)

As the lecture introduced mutable data structures in Racket, I implemented the tape as an object (function closure) containing a mutable fixed-size vector representing the tape and a number representing the index/pointer of the active number. The goal of this lab is to modify my implementation from the lecture so that it is purely functional. This means that you need to replace the tape object with a purely functional data structure. Next, the implementation of the interpreter has to be modified a bit. My implementation creates a global tape that is modified by the interpreter during the computation. However, this is not a purely functional code. Thus the tape has to be as a part of the state of the computation included among interpreter's accumulators.

**Task 1:** Create a purely functional representation of the tape of a fixed size with a pointer. I will provide detailed hints on how to proceed.
Represent your tape as a list `(left value right)`

where `left`

is a list representing numbers on the tape stored left from the pointer,
`val`

represents the active number and `right`

is a list representing the number on the right. So start with the following definitions
of a constructor, a function creating an empty tape and a function `get`

returning a function accessing a component of the tape according to the message.

(define (make-tape left val right) (list left val right)) (define (fresh-tape size) (make-tape '() 0 (make-list (- size 1) 0))) (define (get msg) (cond ([eqv? msg 'left] car) ([eqv? msg 'val] cadr) ([eqv? msg 'right] caddr) (else (error "unknown message")) ) )Now we can access for example the right list of a tape

`tape`

by calling `((get 'right) tape)`

.
Your task is to finish the following function definitions:

(define (change op tape) (make-tape ((get 'left) tape) (op ((get 'val) tape) 1) ((get 'right) tape))) ) (define (move dir tape) (let ([left ((get 'left) tape)] [val ((get 'val) tape)] [right ((get 'right) tape)]) (cond ([null? ((get dir) tape)] (error "Outside tape")) ([eqv? dir 'left] (make-tape (cdr left) (car left) (cons val right))) (else (make-tape (cons val left) (car right) (cdr right)))) )) )

The function `(change op tape)`

takes an operation + (resp. -) and a tape and returns a new tape where the active number is increased
(resp. decreased). The second function `(move dir tape)`

takes a direction `'left`

(resp. `'right`

) and a tape and returns
a new tape where the pointer moves left (resp. right). In case the active number is a boundary number and moving the pointer would get
the pointer outside the tape, the function should throw an error by calling `(error “outside”)`

. E.g. consider a tape consisting of numbers 1,2,3,4,5,6,7 with 4 being the active number.

(define tape (make-tape '(3 2 1) 4 '(5 6 7))) (change - tape) => '((3 2 1) 3 (5 6 7)) (change + tape) => '((3 2 1) 5 (5 6 7)) (move 'left tape) => '((2 1) 3 (4 5 6 7)) (move 'right tape) => '((4 3 2 1) 5 (6 7))

**Task 2:** Modify the implementation of the interpreter from the lecture so that it uses your purely functional tape.

*Hint:* The implementation from the lecture uses a global mutable tape which is defined once and then only reset when executing a program.
Apart from the tape, the interpreter keeps its state in accumulators `prg`

containing remaining commands and `input`

storing the remaining input. You have to add one more accumulator tracking the tape.

Moreover, the function `eval-prg`

returns the remaining input after processing all commands. This allows us to use it to execute a code in a cycle
and obtain the remaining input to continue with the computation. In your modification, the function `eval-prg`

has to return the remaining input
together with the actual tape. This can be done e.g. by returning a list `(list input tape)`

.

For your convenience, my complete implementation is shown below. The particular tasks for you can be found below it.

#lang racket ; constant defining the size of tape (define SIZE 10) ; constructor of the object tape of a given size (define (make-tape size) (define tape (make-vector size 0)) ; initialize fresh tape (define ptr 0) ; pointer points to the first element (define (change op vec ptr) (vector-set! tape ptr (op (vector-ref tape ptr) 1))) (define (move op ptr) (let ([new-ptr (op ptr 1)]) (if (or (< new-ptr 0) (> new-ptr size)) (error "Moving outside tape") new-ptr))) (lambda (msg) (cond ([eqv? msg 'tape] tape) ([eqv? msg 'plus] (change + tape ptr)) ([eqv? msg 'minus] (change - tape ptr)) ([eqv? msg 'left] (set! ptr (move - ptr))) ([eqv? msg 'right] (set! ptr (move + ptr))) ([eqv? msg 'dot] (vector-ref tape ptr)) ([eqv? msg 'comma] (lambda (val) (vector-set! tape ptr val))) ([eqv? msg 'reset] (vector-fill! tape 0) (set! ptr 0)) ) )) ; defines a global tape used by the interpreter (define tape (make-tape SIZE)) ; evaluates comma command, i.e., (car input) -> tape[ptr] (define (eval-comma prg input) (cond ([null? input] (error "Empty input")) (else ((tape 'comma) (car input)) (eval-prg prg (cdr input))))) ; recursive call preocessing further commands ; evaluates all the commands beside comma (define (eval-cmd cmd prg input) (cond ([eqv? cmd '+] (tape 'plus)) ([eqv? cmd '-] (tape 'minus)) ([eqv? cmd '<] (tape 'left)) ([eqv? cmd '>] (tape 'right)) ([eqv? cmd '*] (printf "~a " (tape 'dot))) (else (error "Unknown command"))) (eval-prg prg input) ; recursive call preocessing further commands ) (define (eval-cycle cycle prg input) (if (= (tape 'dot) 0) ; is cycle is finished? (eval-prg prg input) ; if yes, recursive call preocessing further commands (let ([new-input (eval-prg cycle input)]) ; otherwise evaluate cycle code (eval-cycle cycle prg new-input) ; and execute the cycle again ) )) (define (eval-prg prg input) (if (null? prg) ; are all commands processed? input ; if yes, return remaining input (let ([cmd (car prg)] [rest (cdr prg)]) (cond ([eqv? cmd '@] (eval-comma rest input)) ([list? cmd] (eval-cycle cmd rest input)) (else (eval-cmd cmd rest input)))) )) ; executes the given program with the given input (define (run-prg prg input) (tape 'reset) ; fill tape by zeros (eval-prg prg input) ; evaluate program (printf "done~n") )

A solution to Task 2 can be found here.

This lab focuses on lambda calculus. First, we focus on the syntax of $\lambda$-expressions. Second, we focus on its semantics, i.e., the computation specified by $\lambda$-expressions whose one step is performed by the $\beta$-reduction (and $\alpha$-conversion if necessary). To help you to play with these notions and concepts, I implemented in Racket an interpreter of $\lambda$-calculus transforming a given $\lambda$-expression into its normal form (if it exists). It follows the normal order evaluation strategy. In addition, I implemented a few helper functions to help you inspect $\lambda$-expressions. You can download the interpreter here lambda-calculus.rkt.

To follow the exercises, it is recommended to have a piece of paper, pen, DrRacket IDE installed and the interpreter. To use the interpreter, download the above-mentioned file and store it in a directory where you want to create your own code. Then create a new Racket file starting as follows:

#lang racket (require "lambda-calculus.rkt")

$\lambda$-expressions are represented in the interpreter as S-expressions. It does not allow to use of any conventions regarding parenthesis. So you need to explicitly place them all. For instance, the $\lambda$-expression $\lambda xy.xy(\lambda ab.b)$ has to be represented as follows:

'(λ x : (λ y : ((x y) (λ a : (λ b : b)))))So we had to add the outermost parenthesis, expand the shortcuts $\lambda xy.$ to $\lambda x.(\lambda y.$, and put the parenthesis determining the order of the applications, i.e., as the application is left-associative, $xy(\lambda ab.b)$ is in fact $((x y) (\lambda ab.b))$. The symbol λ can be entered in DrRacket by pressing Ctrl+\. Instead of the dot symbol, the colon symbol is used.

The module `lambda-calculus.rkt`

provides the following functions:

`(draw-expr expr)` | draws the syntax tree the given $\lambda$-expression `expr` ; redexes are colored in red |

`(substitute expr var val)` | substitutes `val` for the free occurrences of `var` in `expr` |

`(reduce expr)` | reduces `expr` by a one-step $\beta$-reduction in the normal order |

`(eval expr [info 'quiet])` | finds the normal form of `expr` ; if `info` is set to `'verbose` , displays all the steps; if `info` is `'tree` , then all the steps are drawn as trees |

**Exercise 1:** Draw the syntax tree of the $\lambda$-expression $(\lambda x.y(xx))(\lambda y.y(xx))$ and determine which variable occurrences are free and which are bound.

We will use the helper function `draw-expr`

. First create the correct representation as S-expression:

'((λ x : (y (x x))) (λ y : (y (x x))))Then evaluate the following function call:

(draw-expr '((λ x : (y (x x))) (λ y : (y (x x)))))It displays the following tree:

An occurrence of a variable $v$ is bound if it is in the syntax tree below the node $\lambda v$ and it free otherwise. So for our expression, the occurrences of $x$ in the left branch are bound and they are free in the right branch. The occurrence of $y$ in the left branch is free and bound in the right branch.

**Exercise 2:** Draw the syntax tree of the $\lambda$-expression $\lambda y.xy(\lambda ab.b)$ and determine which variable occurrences are free and which are bound.

Try to first draw the tree on paper. Then compare your result with the result returned by the function `draw-expr`

. The $\lambda$-expression is represented in Racket as follows:

'(λ y : ((x y) (λ a : (λ b : b))))

**Exercise 3:** Find all redexes in $(\lambda x.x y) z ((\lambda u.u) ((\lambda v.v) z)))$. Which one is the leftmost outermost redex and which one is the leftmost innermost redex? Reduce the leftmost outermost redex.

*Hint:* Try to find the redexes. Then call `(draw-expr expr)`

for `expr`

being the following S-expression:

'(((λ x : (x y)) z) ((λ u : u) ((λ v : v) z)))The roots of redexes are colored in red. To check that your reduction was correct call

(reduce '(((λ x : (x y)) z) ((λ u : u) ((λ v : v) z))))

**Exercise 4:** Recall that multiplication of two numbers is computed by $M \equiv \lambda abc.a(bc)$. Find the normal form of $M01$ following the normal order reduction strategy, i.e., compute $0\cdot 1$ which should result in $0$. The numbers $0,1$ are abbreviations for $\lambda$-expressions $\lambda sz.z$ and $\lambda sz.sz$ respectively.

*Hint:* Once you do it on paper, check your result in Racket. You can use Racket definitions and semiquoting to make your $\lambda$-expression more readable.

(define zero '(λ s : (λ z : z))) (define one '(λ s : (λ z : (s z)))) (define M '(λ a : (λ b : (λ c : (a (b c)))))) (eval `((,M ,zero) ,one) 'verbose) ; displays each reduction step as λ-expression (eval `((,M ,zero) ,one) 'tree) ; draws each reduction step as syntax tree

**Exercise 5:** Recall that a pair $(a,b)$ is represented in $\lambda$-calculus as $(a,b)\equiv \lambda z.zab$. The projections into the first and second component can be obtained by applying $(a,b)$ to Boolean values $T\equiv \lambda ab.a$ and $F\equiv \lambda ab.b$. Thus
$(a,b)T \to^\beta a$ and $(a,b)T \to^\beta b$. We can even define a `cons`

function by $CONS \equiv \lambda abz.zab$. In Racket you can define all these constructions as follows (the final two calls check that it behaves as expected):

(define T '(λ x : (λ y : x))) (define F '(λ x : (λ y : y))) (define CONS '(λ a : (λ b : (λ z : ((z a) b)))) ) (eval `(((,CONS a) b) ,T)) (eval `(((,CONS a) b) ,F))

Write a $\lambda$-expression swapping components of a given pair $p$.

*Hint:* The desired $\lambda$-expression should take a pair $p$ and return another pair with swapped components.
So the expression should start with $\lambda pz.z??$ where the question marks are the components of the returned pair.

*Solution:* $\lambda pz.z(pF)(pT)$

Once you have it, fill it into the following code and check that it correctly swaps the components:

(define SWAP `(λ p : (λ z : ((z (p ,F)) (p ,T))))) (eval `(,SWAP ((,CONS a) b))) => '(λ z : ((z b) a))

**Exercise 6:** Since we can create pairs, we can create lists as in Racket. We represent the empty list by the false value $F$. Now we can
create a list `'(a b)`

by

(define lst `((,CONS a) ((,CONS b) ,F))) (eval `(,lst ,T)) => 'a (eval `((,lst ,F) ,T)) => 'b

Write a $\lambda$-expression $NULL?$ testing if a list is empty, i.e., it returns $T$ if it is empty and $F$ otherwise.

*Hint:* A list is either a pair or $F$ if it is empty. Let denote it by $p$.
Recall the definition of the zero test from the lecture $Z\equiv \lambda x.xF\neg F$, where $\neg\equiv \lambda x.xFT$.
We need something similar for the list $p$. So our desired $\lambda$-expression should look like $\lambda p.pe_1e_2$ where $e_1,e_2$ have to be filled by suitable $\lambda$-expressions serving as arguments for $p$. If $p$ is empty (i.e., $p\equiv F$) then $p$ is just projection into the second argument. Thus $e_2$ should be $T$, i.e., we have $\lambda p.pe_1T$. Now, if we substitute for $p$ a pair
(i.e., $p \equiv \lambda z.zab$), we obtain $(\lambda z.zab)e_1T$. Thus $e_1$ is going to be substituted for $z$ and consequently it will be applied to $a$ and $b$, i.e., we would end up with $e_1abT$. Since the result in this case should be $F$, we need the result of $e_1ab$ to be $\neg$ because
$\neg F\to^\beta T$.

*Solution:* $\lambda p.p(\lambda ab.\neg)T$

Check your solution in Racket.

(define neg `(λ x : ((x ,F) ,T))) (define NULL? `(λ p : ((p (λ a : (λ b : ,neg))) ,T))) (eval `(,NULL? ,F)) ; => T (eval `(,NULL? ,lst)) ; => F

**Exercise 7:** Define a $\lambda$-expression computing the length of a list.

*Hint:* Follow the approach from the lecture where we defined a function $R\equiv \lambda rn.Zn0(nS(r(Pn)))$ which we turned into a recursive one by $Y$-combinator (i.e., $YR$).

Recall $Y\equiv \lambda y.(\lambda x.y(xx))(\lambda x.y(xx))$. You also need the successor function $S\equiv \lambda wyx.y(wyx)$ for adding $1$. The computation of the desired $\lambda$-expression can be expressed in Racket as follows:

(define len (lambda (p) (if (null? p) 0 (+ (len (cdr p)) 1))))

Modify the $\lambda$-expression $R$ by replacing $Z$ by $NULL?$ from the previous exercise, adding $1$ can be done just by applying the successor function $S$, and the predecessor function $P$ has to be replaced by the expression returning the second component.

*Solution:* $LEN \equiv \lambda rp.NULL?p0(S(r(pF)))$

Check your solution in Racket:

(define S '(λ w : (λ y : (λ x : (y ((w y) x)))))) (define Y '(λ y : ((λ x : (y (x x))) (λ x : (y (x x)))))) (define LEN `(λ r : (λ lst : ( ((,NULL? lst) ,zero) (,S (r (lst ,F))) ) ) ) ) ) (eval `((,Y ,LEN) ,F)) ; => 0 (eval `((,Y ,LEN) ((,CONS a) ,F))) ; => 1 (eval `((,Y ,LEN) ((,CONS a) ((,CONS b) ,F)))) ; => 2

The aim of the lab is to practice function definitions using pattern matching and guarded equations together with the list comprehension.

**Exercise 1:** Write a function `separate :: [Int] -> ([Int], [Int])`

taking a list and returning a pair of lists. The first
containing elements on indexes 0,2,4,… and the second on the indexes 1,3,5,… E.g.

separate [1,2,3,4,5] => [[1,3,5], [2,4]]

*Hint:* Using pattern matching `x:y:xs`

and recursion.

separate :: [Int] -> ([Int], [Int]) separate [] = ([], []) separate [x] = ([x], []) separate (x:y:xs) = let (evs, ods) = separate xs in (x:evs, y:ods)

**Exercise 2:** Write a function `numToStr :: Int -> Int -> String`

taking as input an integer `n`

together with a `radix`

denoting the number of symbols used to represent the number `n`

(for example 2,10,16 for binary, decimal, hexadecimal representation respectively). This function returns a string containing the representation of `n`

in the corresponding numerical system. For the representation use the standard symbols `0123456789ABCDEF`

.

Examples:

numToStr 52 10 => "52" numToStr 5 2 => "101" numToStr 255 16 => "FF".

*Hint:* The representation can be obtained by consecutive division of `n`

by `radix`

and collecting the remainders. The integer division can be computed by the function `div`

and the remainder after integer division can be computed by the function `mod`

.

numToStr :: Int -> Int -> String numToStr n radix = if n < radix then [chars !! n] else (numToStr d radix) ++ [chars !! r] where chars = ['0'..'9'] ++ ['A'..'F'] d = n `div` radix r = n `mod` radix

**Exercise 3:** Write a function `split n xs`

that takes a natural number `n`

and a list `xs :: [Int]`

and splits `xs`

into a list of
lists of `n`

-many consecutive elements. The last chunk of numbers can be shorter than `n`

. E.g.

split 3 [1..10] => [[1,2,3],[4,5,6],[7,8,9],[10]] split 3 [1,2] => [[1,2]]Use the function

`split`

to implement a function `average_n n xs`

taking a list of integers and returning the list of the averages of `n`

consecutive elements.
E.g.
average_n 3 [-1,0,1,2,3] => [0.0,2.5]

*Hint:* You can use functions `take n xs`

and `drop n xs`

. The first one returns the list of the first `n`

elements of `xs`

. The second returns the remaining list after stripping the first `n`

elements off. Further, use function `length xs`

returning the length of `xs`

.

The function `split`

can be written recursively. If the length of `xs`

is less than or equal to `n`

then return just `xs`

.
If it is bigger then take the first `n`

elements and cons them to the result of the recursive call of `split`

after dropping the first `n`

elements.

split :: Int -> [Int] -> [[Int]] split n xs | (length xs) <= n = [xs] | otherwise = take n xs : (split n (drop n xs))

The function `average_n`

can be easily written via the list comprehension using `split`

. The only caveat is the division operation involved in the computation of averages. Even though the inner lists after applying `split`

are of the type `[Int]`

, their averages are floating numbers. So the type of `average_n`

is `Int -> [Int] -> [Float]`

. We can compute the sum of an inner list by the function `sum`

and its length by `length`

but the type system would complain if we want to divide them. To overcome this problem, one has to convert the integer arguments into floating-point numbers. This can be done by the function `fromIntegral`

converting an integer into any more general numeric type.

average_n :: Int -> [Int] -> [Float] average_n n ys = [fromIntegral (sum xs) / fromIntegral (length xs) | xs <- xss] where xss = split n ys

**Task 1:** Write a function `copy :: Int -> String -> String`

that takes an integer `n`

and a string `str`

and returns
a string consisting of `n`

copies of `str`

. E.g.

copy 3 "abc" => "abcabcabc"

copy :: Int -> String -> String copy n str | n <= 0 = "" | otherwise = str ++ copy (n - 1) str -- tail recursive version copy2 :: Int -> String -> String copy2 n str = iter n "" where iter k acc | k <= 0 = acc | otherwise = iter (k-1) (acc ++ str)

**Task 2:** The Luhn algorithm is used to check bank card numbers for simple errors such as mistyping a
digit, and proceeds as follows:

- consider each digit as a separate number;
- moving left, double every other number from the second last, e.g. 1 7 8 4 ⇒ 2 7 16 4;
- subtract 9 from each number that is now greater than 9;
- add all the resulting numbers together;
- if the total is divisible by 10, the card number is valid.

Define a function `luhnDouble :: Int -> Int`

that doubles a digit and subtracts 9 if the result is
greater than 9. For example:

luhnDouble 3 => 6 luhnDouble 7 => 5

Using `luhnDouble`

and the integer remainder function `mod`

, define a function
`luhn :: [Int] -> Bool`

that decides if a list of numbers representing a bank card number is valid. For
example:

luhn [1,7,8,4] => True luhn [4,7,8,3] => False

*Hint:* Since the numbers are processed from right to left, reverse first the list by the function `reverse`

. Then create a list of numbers
to be luhnDoubled and the rest by the function `separate`

.

luhnDouble :: Int -> Int luhnDouble n | n > 4 = 2*n - 9 | otherwise = 2*n luhn :: [Int] -> Bool luhn xs = (sum evs + sum [luhnDouble x | x <- ods]) `mod` 10 == 0 where rxs = reverse xs (evs, ods) = separate rxs

**Exercise 1:** Define a type representing binary trees storing data in leaves of a general type `a`

. Each non-leaf node has always two children. Make your type an instance of the class `Show`

so that it can be displayed in an xml-like format. A leaf node containing a datum `x`

should be displayed as `<Leaf x/>`

and an inner
node `<Node>…children nodes…</Node>`

. E.g. the following tree

* / \ * 'd' / \ 'a' * / \ 'b' 'c'is displayed as

<Node><Node><Leaf 'a'/><Node><Leaf 'b'/><Leaf 'c'/></Node></Node><Leaf 'd'/></Node>

*Solution:* We will declare a recursive parametric data type `Tree a`

over a general type `a`

. There will be two data constructors
`Leaf`

and `Node`

. The leaf contain a datum of type `a`

and the node has a left subtree and a right subtree.

data Tree a = Leaf a | Node (Tree a) (Tree a)

To make `Tree a`

an instance of the `Show`

class. We have to constrain type `a`

to be an instance of `Show`

otherwise it would not be
clear how to display the data stored in the tree. The definition of the function `show`

is then straightforward.

instance (Show a) => Show (Tree a) where show (Leaf x) = "<Leaf " ++ show x ++ "/>" show (Node left right) = "<Node>" ++ show left ++ show right ++ "</Node>"

Now we can define the tree from the above picture as

tree :: Tree Char tree = Node (Node (Leaf 'a') (Node (Leaf 'b') (Leaf 'c'))) (Leaf 'd')

**Exercise 2:** Consider the `Tree a`

data type from the previous exercise. Write a function

treeDepth :: Tree a -> Inttaking a tree and returning its depth.

*Solution:* The tree depth can be computed recursively as $treeDepth(t) = 1$ if $t$ is a leaf and
$treeDepth(t)=1+\max(treeDepth(left),treeDepth(right))$ if $t$ has two subtrees $left$ and $right$. This is a recursive definition which can be
directly rewritten into Haskell as follows:

treeDepth :: Tree a -> Int treeDepth (Leaf _) = 1 treeDepth (Node left right) = 1 + max (treeDepth left) (treeDepth right)

For the tree from the previous exercise we have

> treeDepth tree 4

**Exercise 3:** Consider again the `Tree a`

data type from Exercise 1. Write a function

labelTree :: Tree a -> Tree (a, Int)labelling the leaves of a tree by consecutive natural numbers in the infix order. So it should replace a leaf datum

`x`

by the pair `(x,n)`

for some natural number. So we would like to obtain something like that:
* * / \ / \ * 'd' * ('d',3) / \ => / \ 'a' * ('a',0) * / \ / \ 'b' 'c' ('b',1) ('c',2)

The idea behind this function will be useful in your homework assignment and it is crucial to understand state monads later on. So try to understand it well.

*Solution:* To traverse through the nodes (in particular leaves) can be easily done recursively. The problem is with the counter for labels.
In imperative programming language, we could introduce a variable `counter`

initialize it by 0. Once we would encounter a leaf, we would label
it by `counter`

and modify `counter = counter + 1`

. Unfortunately, we cannot do that in a purely functional language like Haskell.

We need an accumulator in the signature of the labelling function holding the counter value. So we could think of a helper function

labelHlp :: Tree a -> Int -> Tree (a, Int)taking as input the second argument representing the counter. Unfortunately, this is still not enough because such an accumulator can depend only on the path leading from the root node into a leaf. However, the accumulator has to depend on the previously labelled leaves. So we must enrich the output of the helper function as well so that we send the counter value back when returning from a recursive call. So we actually need to return not only the labelled tree but also the counter value as follows:

labelHlp :: Tree a -> Int -> (Tree (a, Int), Int)Now, when we encounter a leaf node, we label it by the counter accumulator and return a labelled leaf together with the increased counter value. For the non-leaf nodes, we first label the left subtree by the numbers starting with the counter value. This results in a labelled tree and a new counter value. Second, we label the right subtree with the numbers starting from the new counter value.

labelHlp :: Tree a -> Int -> (Tree (a, Int), Int) labelHlp (Leaf x) n = (Leaf (x, n), n+1) labelHlp (Node left right) n = let (left', n') = labelHlp left n (right', n'') = labelHlp right n' in (Node left' right', n'')

Finally, we wrap the helper function in the definition of `labelTree`

. This definition just set the counter value to 0, call the helper function
and then project into the first component via the function `fst`

.

labelTree :: Tree a -> Tree (a, Int) labelTree t = fst (labelHlp t 0)

**Task 1:** Define a recursive data type `Polynomial a`

representing univariate polynomials with an indeterminate $x$ whose coefficients are of a general type `a`

. The definition will have two data constructors. First, `Null`

representing the zero polynomial. Second, `Pol`

whose parameters are a monomial and recursively the rest of the polynomial. Monomial should by represented as pairs of type `(a, Int)`

where the first component is the coefficient and the second is the exponent. E.g. `(c,e)`

represents $cx^e$. You can define a new name for that type as follow:

type Monomial a = (a, Int)Make your type an instance of show class. Polynomials should be displayed as follows:

> Null 0 > Pol (3, 2) Null 3*x^2 > Pol (-2, 0) Null (-2) > Pol (-1, 0) (Pol (-2, 1) (Pol (1, 3) Null)) (-1) + (-2)*x^1 + 1*x^3

*Hint:* Make first a function

format :: (Show a, Ord a, Num a) => Monomial a -> Stringthat returns a string representing a given monomial. Note the constraint on the type

`a`

. We assume that coefficients are numeric values that can be added and subtracted and can be ordered. The reason for this that we need to find out whether the given coefficient is negative and in that case we have to wrap it into parentheses, i.e., we need to compare with 0. Further, note that a constant monomial has no `x^0`

.
Then define the instance of `Show`

for `Polynomial a`

. You need to constrain the `show`

function
in the same way as `format`

.

type Monomial a = (a, Int) data Polynomial a = Null | Pol (Monomial a) (Polynomial a) format :: (Show a, Num a, Ord a) => Monomial a -> String format (c, e) | e == 0 = display c | otherwise = display c ++ "x*^" ++ show e where display k | k >= 0 = show k | otherwise = "(" ++ show k ++ ")" instance (Show a, Num a, Ord a) => Show (Polynomial a) where show Null = "0" show (Pol m Null) = format m show (Pol m ms) = format m ++ " + " ++ show ms

**Task 2:** Write a function

getDegree :: Polynomial a -> Intreturning the degree of a given polynomial. The zero polynomial has degree $-1$ by definition. Otherwise, you have to find the highest exponent occurring in the polynomial.

getDegree :: Polynomial a -> Int getDegree p = iter p (-1) where iter Null n = n iter (Pol (_, e) ms) n | e > n = iter ms e | otherwise = iter ms n

**Exercise 1:** Haskell functions can be polymorphic if we use type variables in their definitions. Write a function

permutations :: [a] -> [[a]]taking a list of elements of type

`a`

and returning a list of all its permutations.
*Solution:* We will use the same approach as in Racket. First, we define a function

interleave :: a -> [a] -> [[a]]taking an element

`x`

of type `a`

and a list `ys`

of elements of type `a`

and returning a list of lists where `x`

is plugged into
`ys`

by all possible ways. E.g.
> interleave 0 [1,2,3] [[0,1,2,3],[1,0,2,3],[1,2,0,3],[1,2,3,0]]

The base case for the `interleave`

function is simple as there is only a single way to plug `x`

into the empty list `[]`

, namely
`[x]`

. If the list is of the form `y:ys`

, then one way to plug `x`

into it is to prepend `x`

(i.e., `x:y:ys`

). The remaining
possibilities can be computed recursively by calling `interleave x ys`

and prepending `y`

.

interleave :: a -> [a] -> [[a]] interleave x [] = [[x]] interleave x (y:ys) = (x:y:ys) : [y:xs | xs <- interleave x ys]

Now we can easily define the `permutations`

function. The base case for the empty list is trivial. For a nonempty list `x:xs`

we
can recursively compute permutations of `xs`

and interleave `x`

into all such permutations. Finally, we have to concatenate the results
into a single list of permutations. This can be done by the function `concat`

which is implemented in `Prelude`

(you also saw how to implement
such function in the lecture. I called that function `flatten`

).

permutations :: [a] -> [[a]] permutations [] = [[]] permutations (x:xs) = concat [interleave x p | p <- permutations xs]

**Exercise 2:** Use the function `permutations`

from the previous exercise to write a function `findHamiltonian`

which finds all Hamiltonian paths in a given graph.

We first have to represent graphs in a data structure. To be general, we define a graph data structure over any data type `a`

. First, we define a type for edges as pairs of values of type `a`

. Second, we define a parametric algebraic data type `Graph a`

as a record consisting of a list of vertices and a list of edges. We also make this type an instance of the type class `Show`

by automatic derivation.

type Edge a = (a,a) data Graph a = Graph {vertices :: [a], edges :: [Edge a]} deriving ShowNow it is possible to define graphs for instance as follows:

gr :: Graph Int gr = Graph {vertices=[1..6], edges=[(1, 2), (1, 5), (2, 3), (2, 5), (3, 4), (4, 5), (4, 6)]} > gr Graph {vertices = [1,2,3,4,5,6], edges = [(1,2),(1,5),(2,3),(2,5),(3,4),(4,5),(4,6)]}Moreover, we have automatically functions

`vertices :: Graph a -> [a]`

and `edges :: Graph a -> [Edge a]`

:
> vertices gr [1,2,3,4,5,6] > edges gr [(1,2),(1,5),(2,3),(2,5),(3,4),(4,5),(4,6)]

Recall that a Hamiltonian path in a graph is a path going through all the vertices exactly once. To solve the task, we will use brute force, generating all possible permutations of vertices and checking if they form a path or not. First, we define a helper function `isEdge`

taking a pair of vertices of type `a`

and a graph over `a`

and returning `True`

if those vertices are connected and `False`

otherwise. To test the membership of an element in a list, we can use the function `elem`

. Note the type declaration of `isEdge`

. As the function is polymorphic, we have to assume that `a`

is an instance of the class `Eq`

so that we test the membership by the `elem`

function.

isEdge :: Eq a => Edge a -> Graph a -> Bool isEdge (a,b) g = (a,b) `elem` edgs || (b,a) `elem` edgs where edgs = edges g

Next, we define a function testing whether a given list of vertices is a path in a given graph. That can be easily done by list comprehension generating all indexes but the last one. Note the use of the function `and`

. It can be applied to a list of type `[Bool]`

performing logical conjunction of all its members.

isPath :: Eq a => [a] -> Graph a -> Bool isPath vs g = and [ isEdge (vs !! i, vs !! (i+1)) g | i <- [0..length vs-2] ]

Finally, we take all permutations of vertices and test which of them form a path in a given graph. Collecting all such paths is the list of all Hamiltonian paths.

findHamiltonian :: Eq a => Graph a -> [[a]] findHamiltonian g = [p | p <- perms, isPath p g] where perms = permutations (vertices g)

**Exercise 3:** The next exercise focuses on operator overloading. With the boom of neural nets, it became important to find algorithms how to compute efficiently and precisely derivatives of functions that are used to construct networks layers. There are basically three approaches. First, syntactic derivation manipulating symbolic expressions. Second, approximation via the limit defining the derivative of a function at a point. Third, computing derivatives via dual numbers. We will discuss the last approach.

Dual numbers are numbers of the form $a+b\epsilon$ for $a,b\in\mathbb{R}$ and $\epsilon$ is something like the complex unit $i$ but instead of $i^2=-1$ we have $\epsilon^2=0$ https://en.wikipedia.org/wiki/Dual_number. For those who like algebra, it can be constructed by taking the ring of univariate polynomials $\mathbb{R}[\epsilon]$ and taking its quotient by the ideal generated by $\epsilon^2$, i.e., $\mathbb{R}[\epsilon]/\langle\epsilon^2\rangle$. If you do not understand the last sentence, you can safely ignore it. As I like algebra I could not resist the temptation to explain it in the algebraic language. Based on the above definition, we can define over the set of dual numbers algebraic operations like addition $(a+b\epsilon)+(c+d\epsilon)=(a+c) + (b+d)\epsilon$, multiplication $(a+b\epsilon)(c+d\epsilon)=ac+(ad+bc)\epsilon+bd\epsilon^2=ac+(ad+bc)\epsilon$.

Dual numbers can be used to compute the derivative of a function at a point. Consider first a polynomial $p(x)=b_0+b_1x+b_2x^2$. Let us compute its value at $a+\epsilon$. \[p(a+\epsilon) = b_0 + b_1(a+\epsilon) + b_2(a+\epsilon)^2= b_0 + b_1a + b_2a^2 + b_1\epsilon + b_22a\epsilon=p(a)+p'(a)\epsilon\] So you see that the resulting dual number contains the value of $p(a)$ and also its derivative $p'(a)$. This can be generalized to any analytic function by taking its Taylor expansion at a point $a$: \[f(x) = \sum_{i=0}^\infty \frac{f^{(n)}(a)}{n!}(x-a)^n\] If we evaluate this series at $a+\epsilon$, we get \[f(a+\epsilon) = \sum_{i=0}^\infty \frac{f^{(n)}(a)}{n!}(a+\epsilon-a)^n = f(a) + f'(a)\epsilon\] as $\epsilon^n=0$ for $n\geq 2$. Thus we again computed the value $f(a)$ and also $f'(a)$ by evaluating a function $f(x)$ at $a+\epsilon$.

We will represent dual numbers as pairs. Thus we declare a new parametric type over a type `a`

. We also automatically derive its instances of
the class `Eq`

and `Ord`

. This automatic derivation orders the dual numbers lexicographically and two dual numbers are equal if they have the same components.

data DualNum a = DN a a deriving (Eq, Ord)We also define our own instance of

`Show`

so that e.g. `DN 3 10`

is displayed as `3 + 10eps`

.
instance Show a => Show (DualNum a) where show (DN x x') = show x ++ " + " ++ show x' ++ "eps"

In order to be able to evaluate a function at a dual number, we define `DualNum a`

an instance of `Num`

. Then we can compute $f(a)$ and $f'(a)$ for $f$ defined as any composition of functions from the `Num`

definition.

instance Num a => Num (DualNum a) where (DN x x') + (DN y y') = DN (x + y) (x' + y') (DN x x') - (DN y y') = DN (x - y) (x' - y') (DN x x') * (DN y y') = DN (x * y) (x*y' + y*x') fromInteger i = DN (fromInteger i) 0 abs (DN x x') = DN (abs x) (signum x * x') signum (DN x _) = DN (signum x) 0I should likely comment on the above definition a bit. The addition, subtraction, multiplication is clear. The function

`fromInteger :: Num a => Integer -> a`

embeds integers into the set of dual numbers. So it maps $a$ to $a+0\epsilon$. The last two definitions are not mathematically correct. We pretend that `signum`

function has the derivative $0$ everywhere which is not true at $0$. Similarly `abs`

has no derivative at $0$.
Dual numbers can be also divided if the first component of the divisor is non-zero as follows:
\[\frac{x+x'\epsilon}{y+y'\epsilon}=\frac{(x+x'\epsilon)(y-y'\epsilon)}{(y+y'\epsilon)(y-y'\epsilon)}=\frac{xy+(x'y-xy')\epsilon}{y^2}=
\frac{x}{y}+\frac{x'y-xy'}{y^2}\epsilon\]
So we can make `DualNum a`

an instance of `Fractional`

.

instance Fractional a => Fractional (DualNum a) where (DN x x') / (DN y y') = DN (x/y) ((x'*y - x*y') / (y*y)) fromRational r = DN (fromRational r) 0

Now we can define a function $f$ and evaluate it at a dual number $a+\epsilon$ to compute $f(a)$ and $f'(a)$. The function has to be polymorphic working for any instance `a`

of the class `Num`

or `Fractional`

.

f :: Num a => a -> a f x = x^2 + 1 > f (DN 5 1) 26 + 10epsIndeed, for $f(x)=x^2+1$ we have $f(5)=5^2+1=26$ and $f'(x)=2x$, $f'(5)=10$. Another example

g :: Fractional a => a -> a g x = (x^2 - 2) / (x - 1) > g (DN 0 1) 2.0 + 2.0epsbecause $g'(x)=\frac{x^2-2x+2}{(x-1)^2}$, i.e., $g(0)=2$ and $g'(0)=2$.

The next example is more impressive. Consider the function `sqr`

computing the square root of a given number. We define this function by iterative computation via the Raphson-Newton method. The function `iterate f a`

computes an infinite list `[a,f a, f (f a), f (f (f a)),…]`

. So in our case, it calls iteratively `improve`

to compute better and better estimates. Once two consecutive elements of this infinite list are close enough, we finish the computation.

sqr :: (Fractional a, Ord a) => a -> a sqr x = convAbs $ iterate improve 1 where improve r = (r + x/r) / 2 convAbs (x1:x2:xs) | abs (x1-x2) < 1e-10 = x2 | otherwise = convAbs xsI think that it is quite impressive that we can compute a derivative of the function

`sqr`

at a point even though it is defined by an iterative computation.
> sqr (DN 9 1) 3.0 + 0.16666666666666666epsIndeed, for $sqr(x)=\sqrt{x}$ we have $sqr'(x)=\frac{1}{2\sqrt{x}}$ so that $sqr'(9)=\frac{1}{6}=0.1\overline{6}$.

**Extra bonus:** For those who are interested, we can go even further and make `DualNum a`

an instance of `Floating`

. If you recall the chain rule, i.e., for a compose function $f(x)=h(g(x))$ we have $f'(x) = h'(g(x))g'(x)$), then it is easy to decode the following definitions.

instance (Floating a) => Floating (DualNum a) where pi = DN pi 0 exp (DN x x') = DN r (r*x') where r = exp x log (DN x x') = DN (log x) (x' / x) sqrt (DN x x') = DN r (x' / (2 * r)) where r = sqrt x sin (DN x x') = DN (sin x) (x' * cos x) cos (DN x x') = DN (cos x) (-x' * sin x) acos (DN x x') = DN (acos x) (-x' / sqrt(1 - x*x)) asin (DN x x') = DN (asin x) ( x' / sqrt(1 - x*x)) atan (DN x x') = DN (atan x) ( x' / (1 + x*x)) sinh x = (exp x - exp (-x)) / 2 cosh x = (exp x + exp (-x)) / 2 asinh x = log (x + sqrt (x*x + 1)) acosh x = log (x + sqrt (x*x - 1)) atanh x = (log (1 + x) - log (1 - x)) / 2Then it is possible to define any polymorphic function over an instance of

`Floating`

and we can compute its derivative. E.g.
f2 :: Floating a => a -> a f2 x = x^4 + sin (x^2) - exp x * log x + 7 -- the derivative of f2 df2 :: Floating a => a -> a df2 x = 4*x^3 + 2 * x * cos (x^2) - exp x/x - exp x * log x -- value of f2 and its derivative at 3 > f2 (DN 3 1) 66.34590079693074 + 73.77182176598502eps -- value of df2 at 3 > df2 3 73.77182176598502

**Task 1:** Write a function `merge :: Ord b => (a -> b) -> [a] -> [a] -> [a]`

taking a function `f :: a -> b`

where `b`

is supposed to be an orderable type and two lists of elements of type `a`

. Suppose that these two lists are sorted via `f`

, i.e., for `[a1,a2,a3,…]`

we have `f a1 <= f a2 <= f a3 <= ...`

. As a result it returns a merged sorted list.

Once you have the function `merge`

, implement a function `subseqs :: [a] -> [[a]]`

which takes a list and returns all its sublists (i.e., subsequence of its elements) sorted by their length.

*Hint:* The subsequences can be generated recursively because subsequences of `x:xs`

are just subsequences of `xs`

together with subsequences of `xs`

extended by `x`

. To produce the sorted result, use the `merge`

function.

merge :: (a -> Int) -> [a] -> [a] -> [a] merge _ [] ys = ys merge _ xs [] = xs merge f p@(x:xs) q@(y:ys) | f x < f y = x:merge f xs q | otherwise = y:merge f p ys subseqs :: [a] -> [[a]] subseqs [] = [[]] subseqs (x:xs) = merge length (subseqs xs) [x:ys | ys <- subseqs xs]

**Exercise 1:** This is a warm-up exercise. Write a function converting a string into a CamelCase format. It takes a string, splits particular words separated by whitespace characters, changes the first letter of each word to uppercase and join all the words into a single string. E.g. `“ no air”`

is converted into `“NoAir”`

. Moreover, make the function polymorphic so that it works over any functor instance over `String`

, i.e., our function should have the following type:

toCamelCaseF :: Functor f => f String -> f String

*Solution:* First, we need a function converting an alphabetic character into uppercase. In the library `Data.Char`

there is a function `toUpper`

doing that. We will implement this function ourselves. To represent the relation between lowercase and uppercase letters, we take a list of tuples `[('a','A'), ('b','B'),…]`

. This can be created by zipping `['a'..'z']`

and `['A'..'Z']`

. For a character `c`

if it is a lowercase letter, then we return the corresponding uppercase letter; otherwise we return just `c`

. To do that we can use the function

lookup :: Eq a => a -> [(a, b)] -> Maybe bthat takes an element of type

`a`

and a list of pairs and lookups the element among first components of those pairs. If it is there, it returns `Just`

the second component and otherwise `Nothing`

. Using the case expression, we can distinguish both cases by pattern matching.
toUpper :: Char -> Char toUpper c = case lookup c $ zip ['a'..'z'] ['A'..'Z'] of Nothing -> c Just c' -> c'

To split the input string into particular words, we can apply the function

words :: String -> [String]Then we have to apply

`toUpper`

to the first letter of each word. Finally, concatenate the resulting words. Thus we have a function converting a string into a CamelCase string.
toCamelCase :: String -> String toCamelCase = concat . map toUpperHead . words where toUpperHead "" = "" toUpperHead (x:xs) = toUpper x:xs

It remains to lift the above function by `fmap`

so that we can apply `toCamelCase`

over any functor instance.

toCamelCaseF :: Functor f => f String -> f String toCamelCaseF = fmap toCamelCaseExamples:

> toCamelCaseF [" no air ", " get back"] -- over the list functor ["NoAir","GetBack"] > toCamelCaseF (Just " no air ") -- over the Maybe functor Just "NoAir" > toCamelCaseF getLine -- over IO functor no air -- user's input "NoAir"

**Exercise 2:** A deterministic finite automaton (DFA) is a tuple $\langle Q,\Sigma,\delta,init,F\rangle$, where $Q$ is a set of states, $\Sigma$ is a finite alphabet, $\delta\colon Q\times\Sigma\to Q$ is a transition function, $init\in Q$ is an initial state and $F\subseteq Q$ is a set of final states. DFAs play a crucial role in applications of regular expressions as each regular expression can be converted into an equivalent DFA accepting the language defined by the regular expression. For instance, the regular expression `[0-9]+\.[0-9][0-9]`

defines a language of numbers having the decimal point followed by two digits, e.g. $123.00$, $0.12$, $3476.25$. The equivalent automaton is depicted below. It has states `Before, Digit, Dot, First, Second`

. `Before`

is the initial state and `Second`

is the only final state. Automaton reads the input characters and changes its state according to $\delta$. After the whole input is read, it accepts the input string iff it is in a final state. At the beginning it is in `Before`

. Once it reads a digit, the state changes to `Digit`

and remains there until `.`

is read. Then next digit changes the state to `First`

and finally the second digit after the decimal point changes the state to `Second`

that is final. Anything else leads to the state `Fail`

.

Our task is to define a parametric data type `DFA a`

modelling a DFA and implement the function

evalDFA :: DFA a -> String -> Booltaking an automaton, a string

`w`

and returning true if `w`

is accepted by the automaton and false otherwise.
Further, define the above automaton and use it to implement a function

parseNum :: String -> Maybe Floattaking a string and returning

`Just`

the parsed floating number if the string is accepted by the automaton or `Nothing`

.
Finally, lift `parseNum`

to any functor instance
parseNumF :: Functor f => f String -> f (Maybe Float)

*Solution:* To model an automaton, the transition function $\delta\colon Q\times\Sigma\to Q$, the initial and final states.
We make the type `DFA a`

parametric over a type `a`

representing states as we wish to work with automata whose states might be integers or strings or other data types. We could also make `DFA a`

parametric over a type `a`

representing the alphabet $\Sigma$ but for this example we set $\Sigma=$ `Char`

. Thus the transition function $\delta$ is of type `a -> Char -> a`

. The initial state is of type `a`

and the set of final states can be represented as a predicate of type `a -> Bool`

.

data DFA a = Automaton (a->Char->a) a (a->Bool)Now we can write the function simulating the automaton computation. It starts with the initial states and repeatedly applies the transition function to the current state and the current letter. This can be done by folding as I explained in the lecture introducing folding in Scheme. In the comment below, you can see how to implement the automaton computation directly without folding. Finally, the predicate defining the final states is applied.

evalDFA :: DFA a -> String -> Bool evalDFA (Automaton dlt s inF) w = inF (foldl dlt s w) -- inF (deltaStar s w) -- where deltaStar q [] = q -- deltaStar q (a:ws) = deltaStar (dlt q a) ws

We first define a type representing the states. Then we define the automaton over these states.

data State = Before | Digit | Dot | First | Second | Fail isNum :: Char -> Bool isNum c = c `elem` ['0'..'9'] final :: State -> Bool final Second = True final _ = False delta :: State -> Char -> State delta Before c | isNum c = Digit | otherwise = Fail delta Digit c | isNum c = Digit | c == '.' = Dot | otherwise = Fail delta Dot c | isNum c = First | otherwise = Fail delta First c | isNum c = Second | otherwise = Fail delta Second _ = Fail delta Fail _ = Fail automaton :: DFA State automaton = Automaton delta Before final

Next, the function `parseNum`

takes a string, uses the automaton to check if the string has the correct format. If yes, it is read by the `read`

function and otherwise `Nothing`

is returned.

parseNum :: String -> Maybe Float parseNum w = if evalDFA automaton w then Just (read w) else Nothing

Now, we can lift it via `fmap`

.

parseNumF :: Functor f => f String -> f (Maybe Float) parseNumF = fmap parseNum

Examples:

> parseNumF ["234", "123.12", ".5", "0.50"] -- the list functor instance [Nothing,Just 123.12,Nothing,Just 0.5] > parseNumF getLine -- IO functor instance 1234.34 -- user's input Just 1234.34 > parseNumF getLine -- IO functor instance 1.234 -- user's input Nothing

**Exercise 3:** Using the function `parseNumF`

from the previous exercise, write a function `parseIO :: IO ()`

that displays a string “Enter number:\n” and then reads from the keyboard a string. If the string has the correct format (i.e., number with two digits after the decimal point), then it displays “Ok”; otherwise it asks the user's input again.

*Solution:* First, we execute the action `putStrLn`

displaying the string “Enter number:”. Then we execute the action `parseNumF getLine :: IO (Maybe Float)`

. Depending of its result, we either display “Ok” or execute the whole action `parseIO`

again. We can either use the monadic operators as follows:

parseIO :: IO () parseIO = putStrLn "Enter number:" >> parseNumF getLine >>= \x -> case x of Nothing -> parseIO Just _ -> putStrLn "Ok"

or we can use the do-syntax as follows:

parseIO :: IO () parseIO = do putStrLn "Enter number:" x <- parseNumF getLine case x of Nothing -> parseIO Just _ -> putStrLn "Ok"

**Task 1:** Consider the following data type representing Boolean propositional formulas built up from atoms by negations, conjunctions and disjunctions.

data Expr a = Atom a | Neg (Expr a) | And (Expr a) (Expr a) | Or (Expr a) (Expr a) deriving (Eq, Show)

The type constructor `Expr`

has a single parameter `a`

representing a data type for atoms. So for instance `Expr Bool`

is a Boolean expression that can be directly evaluated, e.g. the expression $(True\wedge \neg False)\vee False$ is represented as

expr :: Expr Bool expr = Or (And (Atom True) (Neg (Atom False))) (Atom False)

On the other hand, `Expr String`

might represent propositional formulas whose atoms are variables represented as strings, e.g. the formula
$(\neg x\vee x)\wedge y$ is represented as

fle :: Expr String fle = And (Or (Neg (Atom "x")) (Atom "x")) (Atom "y")

Write a function `eval :: Expr Bool -> Bool`

evaluating a given Boolean expression. Thus it should evaluate `expr`

to `True`

. Further, implement a function `getAtoms :: Expr a -> [a]`

returning the list of atoms for a given expression, e.g. `getAtoms fle`

should return
`[“x”,“x”,“y”]`

.

*Hint:* Logical operations negation, conjunction and disjunction can be respectively computed by `not, &&, ||`

. The last two are infix operators.

eval :: Expr Bool -> Bool eval (Atom c) = c eval (Neg e) = not (eval e) eval (And e1 e2) = eval e1 && eval e2 eval (Or e1 e2) = eval e1 || eval e2 getAtoms :: Expr a -> [a] getAtoms (Atom c) = [c] getAtoms (Neg e) = getAtoms e getAtoms (And e1 e2) = getAtoms e1 ++ getAtoms e2 getAtoms (Or e1 e2) = getAtoms e1 ++ getAtoms e2

**Task 2:** The type constructor `Expr`

from the previous task can be made into an instance of `Functor`

as follows:

instance Functor Expr where fmap f (Atom c) = Atom (f c) fmap f (Neg e) = Neg (fmap f e) fmap f (And e1 e2) = And (fmap f e1) (fmap f e2) fmap f (Or e1 e2) = Or (fmap f e1) (fmap f e2)

Thus if we have a map `f :: a -> b`

, it can be lifted by `fmap`

to a map of type `Expr a -> Expr b`

. This might be handy if we need to rename variables or we want to assign concrete Boolean values to variables. Write a polymorphic function

subst :: Functor f => [String] -> f String -> f Booltaking a list of strings (variables) and a data structure over strings returning the same data structure where the strings (variables) in the input list are replaced by

`True`

and the rest by `False`

. Use the lifting by `fmap`

.

subst :: Functor f => [String] -> f String -> f Bool subst xs = fmap (`elem` xs)

Next, apply the function `subseqs :: [a] -> [[a]]`

from the previous lab returning a list of all sublists of a given list.

subseqs :: [a] -> [[a]] subseqs [] = [[]] subseqs (x:xs) = subseqs xs ++ [x:ys | ys <- subseqs xs]

The above function can generate all possible evaluations of a propositional formula if we apply it to the result of `getAtoms`

. Implement functions

isTaut, isSat :: Expr String -> Booltesting whether a given formula is a tautology (resp. satisfiable). A propositional formula is satisfiable if there exists an evaluation of atoms such that the Boolean expression resulted from the replacing atoms by the respective Boolean values is evaluated to

`True`

. A propositional formula is called tautology if it is satisfied by all possible evaluations of its atoms.
*Hint:* To check that there exists an evaluation satisfying a formula or if all evaluations satisfy the formula, use the functions `or`

, `and`

respectively. These functions are applicable to any list of Boolean values.

check :: ([Bool] -> Bool) -> Expr String -> Bool check g e = g [ eval $ subst vs e | vs <- vss] where vss = subseqs $ getAtoms e isTaut, isSat :: Expr String -> Bool isTaut = check and isSat = check or

This lab will illustrate a complete Haskell program searching the shortest path in a maze. We will see `Maybe`

and `IO`

monads in action.
It will be split into two parts. The first part deals with the breadth-first search and the second with the parsing of the file containing a maze.
Short fragments of code are left for you to fill.

Before you start, make sure that you have the following imports in your source file:

import Data.Char import Control.ApplicativeWe are going to need these libraries for our parser.

As building blocks for a maze, we introduce the following data type:

data Block = W | F | S deriving (Eq,Show)The values

`W`

, `F`

, `S`

represent respectively a wall, a free space and a star that we will use to depict solutions.
A data type capturing mazes can be defined as follows:
data Maze = M [[Block]] maze :: Maze -- a testing maze maze = M [[W,W,W,W,W], [W,F,W,F,W], [W,F,W,W,W], [W,F,F,F,W], [W,W,W,W,W]]

To display a maze we make `Maze`

into an instance of `Show`

.

instance Show Maze where show (M []) = "" show (M (r:rs)) = map dispBlock r ++ "\n" ++ show (M rs) where dispBlock W = '#' dispBlock F = ' ' dispBlock S = '*'

Finally, we represent a position in a maze by a tuple of integers. A path can be represented as a list of positions and a planning task is a triple consisting of start and goal positions and a maze.

type Pos = (Int, Int) type Path = [Pos] type Task = (Pos,Pos,Maze)

We will need to extract a block on a given position and conversely to set a block on a given position. To see `Maybe`

monad in action,
we implement these function to be safe. E.g. if we provide a position outside the maze, it will return `Nothing`

. We will start by implementing
such safe functions for lists.

Suppose we have an index `n`

, an element `x :: a`

and a list `xs :: [a]`

. We want to implement a function that replaces the element of index
`n`

in `xs`

by `x`

provided that `n`

is within the range of indexes of `xs`

. If `n`

is outside this range, it returns `Nothing`

.

safePut :: Int -> a -> [a] -> Maybe [a] safePut n x xs | n `elem` [0..length xs-1] = Just $ take n xs ++ [x] ++ drop (n+1) xs | otherwise = Nothing

Similarly, try to implement the function `safeGet`

that extract the element of index `n`

provided it exists:

safeGet :: Int -> [a] -> Maybe a safeGet n xs | n `elem` [0..length xs-1] = Just $ xs !! n | otherwise = Nothing

Now we can use the above functions to implement functions extracting and setting a block in a maze.
To extract a block, we first safely extract a row of a maze. If it is successful, we can extract the block from the row.
Using the fact that `Maybe`

is a monad, we don't have to test every time if the computation was successful.

getBlock :: Pos -> Maze -> Maybe Block getBlock (x,y) (M xss) = do row <- safeGet y xss block <- safeGet x row return block > getBlock (1,0) maze Just W > getBlock (10,10) maze Nothing

Using `safeGet`

and `safePut`

, try to implement a function that takes
a block `b`

, a maze `m`

, a position `(x,y)`

and returns a new maze created by replacing
the block on `(x,y)`

by `b`

.

setBlock :: Block -> Pos -> Maze -> Maybe Maze setBlock b (x,y) (M xss) = do row <- safeGet y xss row' <- safePut x b row xss' <- safePut y row' xss return (M xss') > setBlock S (1,2) maze Just ##### # # # #*### # # #####

Finally, if we have a path (i.e., a list of positions), we can set recursively all its positions in a maze. Again using the fact that `Maybe`

is a monad.

setPath :: Maze -> Path -> Maybe Maze setPath m [] = Just m setPath m (p:ps) = do m' <- setBlock S p m m'' <- setPath m' ps return m''You might note that this is in fact a kind of monadic

`foldr`

. There is of course a generic monadic `foldr`

called `foldrM`

.
If you import `Data.Foldable`

, then you can rewrite the above function as follows:
setPath = foldrM (setBlock S)

As `setPath`

returns a value of type `Maybe Maze`

, we can extract it from the `Maybe`

context by pattern matching.

drawSol :: Maze -> Path -> Maze drawSol m ps = case setPath m ps of Nothing -> m Just m' -> m'

To find a path leading from a start position into the goal position, we need a function taking a position and returning all possible next positions.
Assume that there are at most 8 possible moves. All possibilities are generated by the function `neighbs`

. Out of these possibilities we have to filter only those leading to a free block. Moreover, it is necessary to check that the input position is admissible as well.

neighbs :: Pos -> [Pos] neighbs (x,y) = [(x-1,y), (x+1,y), (x,y-1), (x,y+1), (x-1,y-1), (x-1,y+1), (x+1,y-1), (x+1,y+1)] nextPos :: Pos -> Maze -> [Pos] nextPos p m = case getBlock p m of -- is the input position admissible? Just F -> [ p' | p' <- neighbs p, getBlock p' m == Just F] -- if yes, take all possibilities and filter admissible positions _ -> [] > nextPos (1,1) maze [(1,2)]

Using `nextPos`

, implement the following function taking a path, a maze and returning all its possible extensions. For efficiency reasons
we will represent paths in BFS in the reversed order. Thus extend a given path using the operator `(:)`

.

extend :: Path -> Maze -> [Path] extend [] _ = [] extend path@(p:_) m = map (:path) $ nextPos p m > extend [(1,2),(1,1)] maze [[(1,1),(1,2),(1,1)],[(1,3),(1,2),(1,1)],[(2,3),(1,2),(1,1)]]

Now we can easily implement BFS. Recall that in BFS we use a queue storing partial solutions. We will implement this queue naively as a list.
In addition, we have to keep information about which positions were already visited. We define the function `solve`

that is just a wrapper for
the `bfs`

function implementing BFS. The function `bfs`

takes several arguments. The first is a list of already visited positions.
The second is the queue of partial solutions. The third is the goal position and the last one is the maze.

solve :: Task -> Maybe Path solve (p,q,m) = bfs [] [[p]] q m bfs :: [Pos] -> [Path] -> Pos -> Maze -> Maybe Path bfs _ [] _ _ = Nothing bfs visited (path@(p:_):paths) q m -- consider the first path in the queue and its head p | p == q = Just $ reverse path -- is path a solution? If yes, return the reversed solution | p `elem` visited = bfs visited paths q m -- does path end in an already visited position? If yes, disregard it | otherwise = bfs (p:visited) (paths ++ extend path m) q m -- add p to visited positions and extend path by all possible positions > solve ((1,2),(3,3),maze) Just [(1,2),(2,3),(3,3)] > solve ((3,1),(3,3),maze) Nothing

As a next task, we have to create a user interface for the BFS solver. We have to allow the user to specify a maze together with start and goal positions. The user provides a string containing all the necessary data via the standard input. It might look as follows:

start = (1,1) goal = (28,4) ######################################### # # # # # # # # ########### ####### ########### # # # # # # # ##################### # #### # # # # # ########## ################ # # # # # # # #########################################

Our program is supposed to parse this input and display its solution provided it exists:

######################################### #********* # # # # * # # # ###########* ####### ########### # # * # # **** # # # * #####################* # #### * # # # ***** # # *########## ################* # # ****************************** # # # # # #########################################

We will use the type constructor `Parser`

that I explained in the lecture. Below you can find its definition and definitions of all its instances
for `Functor`

, `Applicative`

, `Monad`

and `Alternative`

. So you can directly copy them into your source file.

Let me recall the info on `Parser`

shortly. A parser over type `a`

is a function taking an input string, consuming a part of it and returning
the parsed value of type `a`

and the remaining unused input string. The parsing can fail that's why it returns a value of type
`Maybe (a, String)`

. For instance, if you want to parse an integer and the input string starts with a letter, then the parsing fails.

The function `parse`

just helps us to remove the data constructor `P`

. So if you want to apply a parser `p`

to an input `inp`

, call
`parse p inp`

.

As we want to make `Parser`

an instance of `Monad`

so that we can sequence parsers, we have to define also instances for super-classes
`Applicative`

and `Functor`

. Functor instances over data type `a`

implements a function `fmap`

allowing to lift
a map `f :: a -> b`

to a map of type `Parser a -> Parser b`

. The function `fmap`

always
keeps the functor structure untouched only changes values of type parameter `a`

. So for `Parser a`

it just keeps the parsing
function the same expect of modifying the output value `v :: a`

by `f v`

.

Functors allow lifting unary maps to the functorial context. E.g. we can lift `(+1)`

to `Parser Int`

but we cannot lift binary `(+)`

.
If we lift `(+) :: Int -> Int -> Int`

to `Parser Int`

by `fmap`

, we obtain a function
`Parser Int -> Parser (Int -> Int)`

. However, to lift `(+)`

, we need type
`Parser Int -> Parser Int -> Parser Int`

. Applicative functors implement `<*>`

that can transform
`Parser (Int -> Int)`

to `Parser Int -> Parser Int`

.
The function `pure`

just wraps a value into the `Parser`

context. It is in fact a synonym for the monadic `return`

.

The monad instance for `Parser`

has to define the bind operator `»=`

. Its implementation first parses a value `v :: a`

.
If the parsing fails, then the whole parsing fails. Otherwise, we apply `f v`

obtaining the next parser applied to the unused
input `out`

.

Finally, we define the instance of `Alternative`

. It consists of `empty`

and `<|>`

. The first is the always failing parser.
The second operator allows trying two parsers for the same input and the first successful returns its result.

newtype Parser a = P (String -> Maybe (a, String)) parse :: Parser a -> String -> Maybe (a, String) parse (P p) inp = p inp instance Functor Parser where -- fmap :: (a -> b) -> Parser a -> Parser b fmap f p = P (\inp -> case parse p inp of Nothing -> Nothing Just (v,out) -> Just (f v, out)) instance Applicative Parser where -- (<*>) :: Parser (a -> b) -> Parser a -> Parser b pg <*> px = P (\inp -> case parse pg inp of Nothing -> Nothing Just (g,out) -> parse (fmap g px) out) pure v = P (\inp -> Just (v,inp)) instance Monad Parser where -- (>>=) :: Parser a -> (a -> Parser b) -> Parser b p >>= f = P (\inp -> case parse p inp of Nothing -> Nothing Just (v,out) -> parse (f v) out) instance Alternative Parser where -- empty :: Parser a empty = P (\_ -> Nothing) -- (<|>) :: Parser a -> Parser a -> Parser a p <|> q = P (\inp -> case parse p inp of Nothing -> parse q inp Just (v,out) -> Just (v,out))

Now we are ready to implement the parser for our BFS application. We start with simple parsers out of which we compose the final one.
The structure of the input `<file>`

is specified by the following grammar. The first line contains a definition of the start position
and the second one a definition of the goal position. The start definition starts with `“start”`

followed possibly by spaces,
then `“=”`

, again possibly followed by spaces and then a position followed by the new-line character `“\n”`

.
The goal definition is analogous. The position is just a tuple of numbers in parentheses separated by a comma and possibly by spaces.
The maze `<map>`

consists of rows followed by `“\n”`

. Each row is a (possibly empty) sequence of the wall `“#”`

and free `“ ”`

blocks.

<file> -> <start> <goal> <map> <start> -> "start" <sep>* "=" <sep>* <pos> "\n" <goal> -> "goal" <sep>* "=" <sep>* <pos> "\n" <pos> -> "(" <sep>* <digit>+ <sep>* "," <sep>* <digit>+ <sep>* ")" <map> -> (<row> "\n")* <map> <row> -> (<wall> | <sep>)* "\n" <wall> -> "#" <digit> -> 0 | 1 | ... | 9 <sep> -> " "

First, we create a basic parser `item`

consuming a single character and failing if there is none.
Based on that we can define a parser `sat`

parsing a character satisfying a given predicate. If you need extra exercises, reimplement
the following parsers using the operators `>>=`

and `>>`

.

item :: Parser Char item = P (\inp -> case inp of "" -> Nothing (x:xs) -> Just (x,xs)) sat :: (Char -> Bool) -> Parser Char sat pr = do x <- item if pr x then return x else empty

To parse numbers we need a parser for a single digit. The predicate `isDigit`

from `Data.Char`

recognizes digits. Further, we need parsers
for a specific character and even a specific string like `“start”`

.

digit :: Parser Char digit = sat isDigit char :: Char -> Parser Char char c = sat (== c) string :: String -> Parser String string [] = return [] string (x:xs) = do char x string xs return (x:xs) > parse digit "34abc" Just ('3',"4abc") > parse (string "start") "start = (1,2)" Just ("start"," = (1,2)")Note that the above function

`string`

returns a parser whose output value is known in advance (it is `x:xs`

). Its only reason is to
check if the parsing does not fail.
As we define `Parser`

to be an instance of `Alternative`

, we have for free two parser combinators `many`

and `some`

. Both of them
apply repeatedly a given parser until it fails. The parser `many p`

always succeeds even if `p`

fails for the first time.
On the other hand, `some p`

succeeds only if the first application of `p`

succeeds.

> parse (many (char 'a')) "aaabc" Just ("aaa","bc") > parse (many (char 'a')) "bc" Just ("","bc") > parse (some (char 'a')) "aaabc" Just ("aaa","bc") > parse (some (char 'a')) "bc" NothingThus

`many`

can handle (possibly empty) sequences (e.g., an arbitrary sequence of spaces) and `some`

non-empty sequences
(e.g., non-empty sequences of digits representing an integer). To disregard sequences of spaces, we define the following parser
together with the function `token`

that transform any parser so that it omits spaces at the beginning and at the end.

space :: Parser () space = do many (sat isSpace) return () token :: Parser a -> Parser a token p = do space x <- p space return x > parse (token (char '=')) " = (1,2)" Just ('=',"(1,2)")

Now we will follow the grammar. We start with a parser for a position.

pos :: Parser Pos pos = do char '(' -- it has to start with '(' space -- possibly followed by spaces x <- some digit -- then parses a nonempty sequence of digits token (char ',') -- then comma possible surrounded by spaces y <- some digit -- then a second non-empty sequence of digits space -- possibly spaces char ')' -- then the closing ')' return (read x, read y) -- the position is returned, sequences of digits are converted by read > parse pos "( 343, 55 )" Just ((343,55),"") > parse pos "(1 2)" Nothing

Using the above parsers, try to define the following function taking a string and returning the parser of a definition.

def :: String -> Parser Pos def str = do string str token (char '=') p <- pos char '\n' return p > parse (def "start") "start = (3,2)\n" Just ((3,2),"")

Next, we focus on maze parsing. We define simple parsers for blocks. Out of them, we can create a parser for rows. Using the operator
`<|>`

, we can define the parser `wall <|> free`

which parses either the wall or free block.

wall :: Parser Block wall = do char '#' return W free :: Parser Block free = do char ' ' return F row :: Parser [Block] row = do bs <- many (wall <|> free) char '\n' return bs > parse row " ### # \n# #\n" Just ([F,F,W,W,W,F,W,F],"# #\n")

A maze is just a (possibly empty) sequence of rows. The input starts with the start and goal definitions followed by a maze.

mapP :: Parser Maze mapP = do rs <- many row return (M rs) file :: Parser Task file = do p <- def "start" q <- def "goal" m <- mapP return (p,q,m)

Finally, we put all the pieces together. We start with a function taking a task and returning an IO action which
either displays the found solution or informs that there is no solution. Note that the function `print`

is just the composition of `show`

followed by `putStrLn`

.

solveTask :: Task -> IO () solveTask t@(p,q,m) = case solve t of Nothing -> putStrLn "No solution exists." Just ps -> print $ drawSol m ps

We need to create a `main`

function returning the main IO action to be executed. It reads completely the input by `getContents`

.
Then it parses the input. If the parser fails or does not consume the whole input, it prints an error message.
Otherwise, we have a task `t`

and `solveTask t`

can be executed.

main :: IO () main = do str <- getContents case parse file str of Nothing -> putStrLn "Incorrect task!" Just (t, "") -> solveTask t Just (_, out) -> putStrLn $ "Unused input: " ++ out

Now, if we have a text file `maze.txt`

with the input, we can run our source code by

$ runghc lab12.hs < maze.txt

Alternatively, we can compile it and then run the compiled executable file.

$ ghc lab12.hs $ ./lab12 < maze.txt

This lab is focused on the state monad `State`

. In the lecture, I show you how it is implemented. In this lab, we are going to use the implementation in the library `Control.Monad.State`

. So include the following lines into your source file:

import Control.Monad.State import System.Random import Data.List

The second import is important as we are going to work with pseudorandom numbers. The last import allows us to use some extra functions manipulating lists.

The state monad `State s a`

is a type constructor taking two parameters `s`

and `a`

representing type of states and output respectively.
You can imagine this type as

newtype State s a = State { runState :: s -> (a, s) }The unary type constructor

`State s`

is an instance of `Monad`

.
The values enclosed in this monadic context are functions taking a state and returning a pair whose
first component is an output value and the second one is a new state.
Using the bind operator, we can compose such functions in order to create more complex stateful computations out of
simpler ones.
The function `runState :: State s a -> s -> (a, s)`

is the accessor function extracting the actual function from
the value of type `State s a`

.
As `State s`

is a monad, we can use all generic functions working with monads including the do-notation. Apart from that,
the implementation of the state monad comes with several functions allowing to handle the state.

get :: State s s -- outputs the state but doesn't change it put :: s -> State s () -- set the state to the given value, outputs empty value modify :: (s -> s) -> State s () -- modifies the state by the given function, outputs empty value evalState :: State s a -> s -> a -- computes just the output evalState p s = fst (runState p s) execState :: State s a -> s -> s -- computes just the final state execState p s = snd (runState p s)

States in purely functional languages must be handled via accumulators added into function signatures. Using the state monad allows us to abstract away those accumulators.

**Exercise 1:**
Consider the function `reverse`

reversing a given list. We can implement it as a tail recursive function in the same way as in Scheme
using an accumulator.

reverseA :: [a] -> [a] reverseA xs = iter xs [] where iter [] acc = acc iter (y:ys) acc = iter ys (y:acc)

Now we try to implement that via the state monad. The above accumulator is a list. So we will use it as our state. We don't have to output anything
as the resulting reversed list is stored in the accumulator/state. Thus we are interested in the type `State [a] ()`

whose values contain functions
of type `[a] -> ((), [a])`

. We will implement a function `reverseS :: [a] -> State [a] ()`

which takes
a list and returns a stateful computation reversing the given list (i.e. a monadic value enclosing a function of type `[a] -> ((), [a])`

reversing the given list).

I will show several variants. The first more or less copies the tail recursive function `reverseA`

.

reverseS :: [a] -> State [a] () reverseS [] = return () -- if the list is empty, keep the state untouched and return empty value reverseS (x:xs) = do ys <- get -- if not, extract the state into ys put (x:ys) -- change the state to x:ys reverseS xs -- recursive call on the rest xs

Now we can execute the returned computation as follows:

> runState (reverseS [1,2,3,4]) [] ((),[4,3,2,1]) > execState (reverseS [1,2,3,4]) [] [4,3,2,1]

The above variant just strips off the first element `x`

and modifies the state by the function `(x:)`

. Thus we can rewrite it as follows:

reverseS :: [a] -> State [a] () reverseS [] = return () -- if the list is empty, keep the state untouched and return empty value reverseS (x:xs) = do modify (x:) -- if not, update the state reverseS xs -- recursive call on the rest xs

Finally, the above variant is just applying the action `modify (x:)`

for every `x`

in the list. Thus we can use the monadic function
`mapM_ :: (a -> m b) -> [a] -> m ()`

taking a function creating a monadic action from an argument of type `a`

and a list of values of type `a`

. The resulting action outputs the empty value. Once it is executed, it executes all the actions
returned by applying the given function to each element in the given list.

reverseS :: [a] -> State [a] () reverseS = mapM_ (modify . (:))

**Task 1:** Suppose, you are given a list of elements. Your task is to return a list of all its pairwise different elements together with the number
of their occurrences. E.g. for `“abcaacbb”`

it should return `[('a',3),('b',3),('c',2)]`

in any order. A typical imperative approach to this problem is to keep in memory (as a state) a map from elements to their numbers of occurrences. This state is updated as we iterate through the list. With the state monad, we can implement this approach in Haskell.

First, we need a data structure representing a map from elements to their numbers of occurrences. We can simply represent it as a list of pairs
`(el, n)`

where `el`

is an element and `n`

is its number of occurrences. We also define a type representing a stateful computation over
the map `Map a Int`

.

type Map a b = [(a,b)] type Freq a = State (Map a Int) ()

*Hint:* First implement the following pure function taking an element `x`

and a map `m`

and returning an updated map. If the element
`x`

is already in `m`

(i.e., there is a pair `(x,n)`

), then return the updated map which is the same as `m`

except the pair `(x,n)`

is replaced by `(x,n+1)`

. If `x`

is not in `m`

, then return the map extending `m`

by `(x,1)`

. To check that `x`

is in `m`

,
use the function `lookup :: Eq a => a -> [(a, b)] -> Maybe b`

that returns `Nothing`

if `x`

is not in `m`

and otherwise
`Just n`

where `n`

is the number of occurrences of `x`

.

update :: Eq a => a -> Map a Int -> Map a Int update x m = case lookup x m of Nothing -> (x,1):m Just n -> (x,n+1):[p | p <- m, fst p /= x]

Once you have that, take the inspiration from Exercise 1 and implement a function `freqS`

taking a list and returning the stateful computation
that once executed computes the map of occurrences. E.g.

> execState (freqS "Hello World") [] [('d',1),('l',3),('r',1),('o',2),('W',1),(' ',1),('e',1),('H',1)]

freqS :: Eq a => [a] -> State (Map a Int) () freqS = mapM_ (modify . update) -- Alternatively you can do this {- freqS [] = return () freqS (x:xs) = do m <- get let m' = update x m put m' --modify (update x) -- or replace the first 3 lines with this freqS xs -}

**Exercise 2:** Recall that pseudorandom numbers from a given interval $(x,y)$ can be generated by the function

randomR :: (RandomGen g, Random a) => (a, a) -> g -> (a, g)located in the module

`System.Random`

. It takes an interval and a generator and returns a random value of type `a`

in the given interval together with
a new generator. `Random`

is a type class collecting types whose random values can be generated by `randomR`

.
A first generator can be created by `mkStdGen :: Int -> StdGen`

from a given seed.
If we want to generate a sequence of random numbers, we have to use in each step the new generator obtained from the previous step.
To abstract the generators away, we use the state monad whose states are generators, i.e., `State StdGen a`

where `StdGen`

is the type
of generators. The type `a`

serves as the type of the generated random numbers. To shorten the type annotations, we introduce a new name:

type R a = State StdGen a

Our task is to implement a function that integrates a function $f\colon\mathbb{R}\to\mathbb{R}$ on the given interval $(a,b)$ by the Monte-Carlo method, i.e., we want to compute approximately $\int_a^b f(x)\mathrm{d}x$. For simplicity, we assume that $f(x)\geq 0$ for all $x\in (a,b)$. The Monte-Carlo method is a sampling method. If we know an upper bound $u$ for $f$ on the interval $(a,b)$, we can estimate the area below the graph of $f$ by generating a sequence of random points in the rectangle $(a,b)\times(0,u)$. Then we count how many points were below $f$. The integral is approximately $\frac{k}{n}(b-a)u$ where $k$ is the number of point below the graph of $f$ and $n$ is the number of all generated points (see the picture).

*Solution:* We first prepare a stateful computation, generating a sequence of random points in a given rectangle. We define two types:

type Range a = (a,a) type Pair a = (a,a)The first one represents intervals and the second one points. Next, we define a function taking an interval and returning a stateful computation generating a single random value in the given interval.

randR :: Random a => Range a -> R a randR r = do g <- get -- get the current state, i.e. generator let (x, g') = randomR r g -- generate a random number x together with a new generator g' put g' -- change the state to g' return x -- output xThe above function can be simplified using the constructor

`state :: (s -> (a,s)) -> State s a`

as was shown in the lecture.
randR:: Random a => Range a -> R a randR r = state (randomR r)

Since we need to generate points, we define a function taking two intervals and returning a stateful computation generating a random point in their Cartesian product.

randPair :: Random a => Range a -> Range a -> R (Pair a) randPair xr yr = do x <- randR xr -- generate x-coordinate y <- randR yr -- generate y-coordinate return (x,y) -- output the generated pointNote that we don't have to deal with generators when sequencing

`randR xr`

with `randR yr`

. Now if we want to generate a random point, we can
execute the stateful computation returned by `randPair`

. E.g. we create an initial state/generator by `mkStdGen seed`

and then use the `evalState`

function because we are interested only in the output not the final generator.
> evalState (randPair (0,1) (4,5)) (mkStdGen 7) (0.6533518674031419,4.888537398010264)To simplify the above call, we define a function executing any stateful computation of type

`R a`

.
runRandom :: R a -> Int -> a runRandom action seed = evalState action $ mkStdGen seedNow we need a sequence of random points. We can define a recursive function doing that as follows:

randSeq :: Random a => Range a -> Range a -> Int -> R [Pair a] randSeq _ _ 0 = return [] -- if the number of points to be generated is 0, returns [] randSeq xr yr n = do p <- randPair xr yr -- otherwise, generate a point p ps <- randSeq xr yr (n-1) -- recursively generate the rest of points ps return (p:ps) -- output p:ps > runRandom (randSeq (0,1) (4,5) 3) 7 [(0.6533518674031419,4.888537398010264),(0.9946813218691467,4.707024867915484),(0.8495826522836318,4.720133514494717)]The function

`randSeq`

is just sequencing the actions `randPair`

and collecting their results. So we can use `sequence`

allowing to take a list of monadic actions and returning the action which is the sequence of those actions returning the list
of their outputs. To create a list to `randPair`

actions, use the function `replicate`

.
> replicate 5 3 [3,3,3,3,3] > runRandom (sequence $ replicate 3 (randPair (0,1) (0,1))) 7 [(0.6533518674031419,0.8885373980102645),(0.9946813218691467,0.7070248679154837),(0.8495826522836318,0.7201335144947166)]In fact, there is a monadic version of

`replicate`

. So we can rewrite the last call as follows:
> runRandom (replicateM 3 (randPair (0,1) (0,1))) 7 [(0.6533518674031419,0.8885373980102645),(0.9946813218691467,0.7070248679154837),(0.8495826522836318,0.7201335144947166)]

Now we are ready to finish the Monte-Carlo integration. It takes as arguments a function $f$, an inteval $(a,b)$, an upper bound $u$ and a number of points to be generated.

integrate :: (Double -> Double) -> Range Double -> Double -> Int -> Double integrate f xr@(a,b) u n = whole * fromIntegral (length below) / (fromIntegral n) where -- compute the area below f below = [(x,y) | (x,y) <- samples, y <= f x] -- get the list of points below f whole = (b-a)*u -- area of the rectangle samples = runRandom (replicateM n (randPair xr (0,u))) 123 -- generate samples

You can test it on functions you know their integrals.

> integrate id (0,1) 1 10000 -- f(x)=x on (0,1) should be 0.5 0.499 > integrate (^2) (0,1) 1 10000 -- f(x)=x^2 on (0,1) should be 1/3 0.3383 > integrate sin (0,pi) 1 10000 -- f(x)=sin x on (0,pi) should be 2 2.0065352278478006 > integrate exp (0,1) 3 10000 -- f(x)=e^x on (0,1) should e-1 1.7226

**Task 2:** Implement a function generating a random binary tree having $n$ many nodes. To be more specific, consider the following type:

data Tree a = Nil | Node a (Tree a) (Tree a) deriving (Eq, Show)The values of

`Tree a`

are binary trees having a value of type `a`

in their nodes together with a left and right children.
The `Nil`

value indicates that there is no left (resp. right) child. Leaves are of the form `Node x Nil Nil`

.
Your tasks is to implement a function `randTree`

taking a number of nodes `n`

and natural number `k`

and returning a stateful
computation generating a random binary tree having `n`

many nodes containing values from $\{0,1,\ldots,k-1\}$.

*Hint:* To generate random integers in a given interval, use the above function `randR`

. Generating a random binary tree can be done recursively. In each node, you generate a random integer $m$ from $\{0,\ldots,n-1\}$. This is the number of nodes of the left subtree.
So you recursively generate the left subtree `ltree`

with `m`

many nodes. Then you recursively generate the right subtree `rtree`

with $n-m-1$ many nodes. Finally you return `Node x ltree rtree`

where `x`

is a randomly generated integer from $\{0,1,\ldots,k-1\}$.
The base case for $n=0$ just returns `Nil`

, i.e., no subtree.

randTree :: Int -> Int -> R (Tree Int) randTree 0 _ = return Nil randTree n k = do m <- randR (0,n-1) ltree <- randTree m k rtree <- randTree (n-m-1) k x <- randR (0,k-1) return $ Node x ltree rtree

You can use your function to generate a random binary tree with 10 nodes containing integers from $\{0,1,2\}$ as follows:

> runRandom (randTree 10 3) 1 Node 1 (Node 0 (Node 2 Nil Nil) (Node 1 (Node 2 Nil Nil) (Node 1 Nil Nil))) (Node 1 (Node 1 Nil Nil) (Node 2 Nil (Node 2 Nil Nil)))

You can also check that the method does not provide a uniform distribution.

> trees = runRandom (replicateM 10000 (randTree 3 2)) 1 > execState (freqS trees) [] [387,234,210,448,221,187,207,223,200,214,403,428,218,409,222,379,199,199,235,206,215,209,184,223,206,187,222,416,187,213,190,193,438,231,222,221,205,204,209,196]

courses/fup/tutorials/start.txt · Last modified: 2021/05/14 07:46 by xhorcik