---
# System prepended metadata

title: Lista zagadnień nr 10 (na 12.05.2020)
tags: [mp20-dabi]

---

---
tags: mp20-dabi
---
# Lista zagadnień nr 10 (na 12.05.2020)
### Metody programowania 2020, II UWr

Grupa ćwiczeniowa: dabi 

---
### Ćwiczenie 1
::: info
Rozwiązuje: **Wszyscy**
:::
```racket=
(define (FACTORIAL k)
  '(letrec [fact (lambda (n) (if (= n 0) 1 (* n (fact (- n 1)))))] (fact k)))

(define (FACTORIAL k)
  `(letrec [fact (lambda (n) (if (= n 0) 1 (* n (fact (- n 1)))))] (fact ,k)))

(define (factorial k)
  (letrec ([fact (lambda (n) (if (= n 0) 1 (* n (fact (- n 1)))))]) 
    (fact k)))    

> (time (factorial 1000))
cpu time: 0 real time: 0 gc time: 0
> (time (eval (parse (FACTORIAL 1000))))
cpu time: 62 real time: 64 gc time: 47
```
---
### Ćwiczenie 2
::: info
Rozwiązuje: **Delta**
:::
```racket=
(define (let-error c k)
  (if (runtime-error? c) c (k c)))
  
[(let-expr x e1 e2)
     (let-error (eval-env e1 env) (lambda (v1)
           (eval-env e2 (env-add x v1 env))))]
           
[(let-expr x e1 e2)
     (let-error [v1 (eval-env e1 env)]
       (eval-env e2 (env-add x v1 env)))]
       
(define-syntax let-error
  (syntax-rules ()
    [(let-error [v c1] c2)
     (if (runtime-error? c1) 
         c1 
         (let ([v c1]) c2))]))
         
(define (eval-env e env)
  (match e
    [(const n)
     n]

    [(var-expr x)
     (env-lookup x env)]

    [(let-expr x e1 e2)
     (let-error [v1 (eval-env e1 env)]
       (eval-env e2 (env-add x v1 env)))]

    [(letrec-expr f ef eb)
     (let ((new-env (env-add f (blackhole) env)))
       (let-error [vf (eval-env ef new-env)]
         (begin (env-update! f vf new-env)
                (eval-env eb new-env))))]

    [(if-expr eb et ef)
     (let-error [vb (eval-env eb env)]
         (match vb
           [#t (eval-env et env)]
           [#f (eval-env ef env)]
           [v  (error "Not a boolean:" v)]))]

    [(lambda-expr x e)
     (clo x e env)]

    [(app-expr ef ea)
     (let-error [vf (eval-env ef env)]
         (let-error [va (eval-env ea env)]
            (match vf
             [(clo x e env)
              (eval-env e (env-add x va env))]
             [(builtin p args nm)
              (if (= nm 1)
                  (apply p (reverse (cons va args)))
                  (builtin p (cons va args) (- nm 1)))]
             [_ (error "Not a function:" vf)])))]
             

;;;;;;;;;;;;;;;

[(app-expr ef ea)
     (let-error* ([vf (eval-env ef env)]
                  [va (eval-env ea env)])
            (match vf
             [(clo x e env)
              (eval-env e (env-add x va env))]
             [(builtin p args nm)
              (if (= nm 1)
                  (apply p (reverse (cons va args)))
                  (builtin p (cons va args) (- nm 1)))]
             [_ (error "Not a function:" vf)])))]

(define-syntax let-error*
  (syntax-rules ()
    [(_ () c)
     c]
    [(_ ([v1 c1] [v2 c2] ...) c)
     (if (runtime-error? c1) 
         c1 
         (let ([v1 c1]) 
           (let-error* ([v2 c2] ...) c)))]))
```
---
### Ćwiczenie 3
::: info
Rozwiązuje: **Echo**
:::
```racket=
(struct (handle e1 e2) #:transparent)

(define (eval-env e env)
    (match e
    ...
      [(handle e1 e2)
      (let ([c1 (eval-env e1 env)])
        (if (runtime-error? c1)
            (eval-env e2 env)
            c1))]))

```
---
### Ćwiczenie 4
::: info
Rozwiązuje: **Foxtrot**
:::
```racket=
> (eval (parse '(choose (choose 1 2) (choose 3 4))))
'(1 3 1 4 2 3 2 4)

> (eval (parse '(choose (choose 1 2) (choose (fail 42) 4))))
'(1 () 1 4 2 () 2 4)

> (eval (parse '(choose 1 (fail 42))))
'()
;'(1 ())

(define (fail p)
            (builtin fail-proc null 1))
(define (fail-proc p) '())
```
Inna wersja
```racket=
(define effect-env
  (foldl (lambda (p env) (env-add (first p) (second p) env))
         start-env
         ...
           (choose ,(effect-builtin/2 (lambda (x y) (append x y))))
           (fail   ,(effect-builtin/1 (lambda (x) '()))) ;
           )))
```

---
### Ćwiczenie 5
::: info
Rozwiązuje: **Alpha**
:::
```racket=
;Na podstawie pliku nondeterminism-monadic.rkt

(define effect-env
  (foldl (lambda (p env) (env-add (first p) (second p) env))
         start-env
         `((choose ,(effect-builtin/1 (lambda (x) x)))
           )))
(define PROGRAM
  '((if (choose (cons true (cons false null))) 
      (lambda (x) x) 
      (lambda (x) (+ x 1))) 
      (choose (cons 1 (cons 2 null)))))
  
> (eval (parse PROGRAM))
'(1 2 2 3)

;Nic wiecej nie zmienialem, tylko effect-env.
```
---
### Ćwiczenie 6
::: info
Rozwiązuje: **Beta**
:::

```racket=
(define (n-queens n)
  `(let nqueens
        (lambda (k)
          (letrec aux 
                  (lambda (xs) 
                    (if (= (length xs) k)
                        xs
                        (let p (choose (list_to k)) 
                          (if (ok? p xs)
                              (aux (cons p xs))
                              (fail "no way")))
                              
                  (aux null))
        (nqueens ,n)))
  
```
---
### Ćwiczenie 7
::: info
Rozwiązuje: **Charlie**
:::
```racket=
```