---
tags: mp, WCh
---

# Lista 4

## Ćwiczenie 1

; Wybrana reprezentacja:
; Lista par współrzędnych (col row).
; N.p. odpowiedź dla (queens 4):
; '(((4 . 3) (3 . 1) (2 . 4) (1 . 2)) ((4 . 2) (3 . 4) (2 . 1) (1 . 3)))
(define (empty-board)
'())

adjoin-position

(define (adjoin-position row col rest)
(cons (cons col row) rest))

safe?

(define (safe? k positions)
    (define this (car (filter (lambda (x) (= (car x) k)) positions)))
    (= 0 (length (filter
        (lambda (other) ; czy other konfliktuje z this?
            (and
                (not (equal? this other)) ; jeśli this = other, nie ma konfliktu
                (or
                    (= (cdr this) (cdr other)) ; ten sam wiersz
                    ; (= (car this) (car other)) ; ta sama kolumna
                    (= (abs (- (cdr this) (cdr other)))
                        (abs (- (car this) (car other)))) ; ta sama przekątna
                )
            )
        )
        positions
    )))
)

queens

#lang racket
(define (concatMap x y) (append-map x y))
(define (from-to x y)
    (if (= x y)
        (list y)
        (cons x (from-to (+ x 1) y))
))

(define (queens board-size)
  ;; Return the representation of a board with 0 queens inserted
  (define (empty-board)
    null)
  ;; Return the representation of a board with a new queen at
  ;; (row , col) added to the partial representation `rest '
  (define (adjoin-position row col rest)
    (cons (cons col row) rest))
  ;; Return true if the queen in k-th column does not attack any of
  ;; the others
  (define (safe? k positions)
        (define this (car (filter (lambda (x) (= (car x) k)) positions)))
        (= 0 (length (filter
            (lambda (other) ; czy other konfliktuje z this?
                (and
                    (not (equal? this other)) ; jeśli this = other, nie ma konfliktu
                    (or
                        (= (cdr this) (cdr other)) ; ten sam wiersz
                        ; (= (car this) (car other)) ; ta sama kolumna
                        (= (abs (- (cdr this) (cdr other)))
                            (abs (- (car this) (car other)))) ; ta sama przekątna
                    )
                )
            )
            positions
        ))))
  ;; Return a list of all possible solutions for k first columns
  (define (queen-cols k)
    (if (= k 0)
        (list (empty-board))
        (filter
         (lambda (positions) (safe? k positions))
         (concatMap
          (lambda (rest-of-queens)
            (map (lambda (new-row)
                   (adjoin-position new-row k rest-of-queens))
                 (from-to 1 board-size)))
          (queen-cols (- k 1))))))
  (queen-cols board-size))

## Ćwiczenie 2

(append-map
  (lambda (rest-of-queens)
   (map (lambda (new-row)
         (adjoin-position new-row k rest-of-queens))
        (from-to 1 board-size)))
  (queen-cols (- k 1))))))

vs

(append-map
 (lambda (new-row)
  (map (lambda (rest-of-queens)
         (adjoin-position new-row k rest-of-queens))
       (queen-cols (- k 1))))
(from-to 1 board-size)))))

Różnica między tymi dwoma podejściami jest taka, że w pierwszym, w każdym wywołaniu rekurencyjnym queen-cols jest wywołane tylko raz (jako drugi argument append-map), ale w drugim (intuicyjnie) queen-cols jest wywoływane w każdym “obrocie” append-map, co znacznie obniża wydajność, bo dla każdego nowego wiersza są ponawiane te same obliczenia.

Można to naprawić korzystając np. z let i zapisując wartośc (queen-cols (- k 1)) przed wywołaniem append-map.

## Ćwiczenie 3

(define (leaf) 'leaf)
(define (leaf? t) (eq? t 'leaf))
(define (node value left-subtree right-subtree)
    (list 'node value left-subtree right-subtree))
(define (left-subtree t)
  (caddr t))
(define (right-subtree t)
  (cadddr t))
(define (label t)
  (car t))
(define (value t)
  (cadr t))

(define (btree? t)
  (or (eq? t 'leaf)
      (and (list? t)
           (= 4 (length t))
           (eq? (label t) 'node)
           (btree? (left-subtree t))
           (btree? (right-subtree t)))))

(define (mirror t)
    (if (leaf? t) (leaf)
        (node (value t) (mirror (right-subtree t)) (mirror (left-subtree t)))
    ))
    
(require rackunit)
(check-equal? (mirror '(node a (node b (node c leaf leaf) leaf) (node d leaf leaf)))
    '(node a (node d leaf leaf) (node b leaf (node c leaf leaf))))

## Ćwiczenie 4

Jedynym miejscem w wersji iteracyjnej, w którym alokujemy pamięć jest cons w linii 10. Tymczasem w wersji rekurencyjnej procedura append kopiuje elementy, więc (flatten (left-subtree t)) jest nieużytkiem.

(define (flatten-rec t)
    (if (leaf? t) null
        (append (flatten-rec (left-subtree t)) (list (value t)) (flatten-rec (right-subtree t)))
    ))

(define (flatten t)
    (define (iter acc t)
        (if (leaf? t) acc
            (iter
                (cons
                    (value t)
                    (iter acc (right-subtree t)))
                (left-subtree t))
        )
    )
    (iter null t)
)

(check-equal? (flatten '(node a (node b (node c leaf leaf) leaf) (node d leaf leaf)))
    '(c b a d))

## Ćwiczenie 5

(define (insert l x)
    (if (null? l)
        (list x)
        (if (> x (car l))
            (cons (car l) (insert (cdr l) x))
            (cons x l)
        )
    )
)

; (1 2 1 5 2 7 2) ()
; (2 1 5 2 7 2) (1)
; (1 5 2 7 2) (1 2)
; (5 2 7 2) (1 1 2)
; (2 7 2) (1 1 2 5)
(define (insertion-sort l)
    (define (sort l acc)
      (if (null? l)
        acc
        (sort (cdr l) (insert acc (car l)))))
    (sort l '()))

(define (random-list k)
  (if (= k 0)
      null
      (cons (random 10000) (random-list (- k 1))))) 

(insertion-sort (random-list 100))


(take (insertion-sort (random-list 10000)) 100)

(define (insert x t)
  (cond
    [(leaf? t)        (node x (leaf) (leaf))]
    [(= (value t) x)  t]
    [(> (value t) x)  (node (value t)
                                (insert x (left-subtree t))
                                (right-subtree t))]
    [(< (value t) x)  (node (value t)
                                (left-subtree t)
                                (insert x (right-subtree t)))]))

(define (tree-sort l)
    (define (from-list acc xs)
        (if (null? xs)
            acc
            (from-list (insert (car xs) acc)
                       (cdr xs))))
    (flatten (from-list (leaf) l))
)

## Ćwiczenie 6

Szukamy elementu do usunięcia.
Usuwamy najmniejszy element z jego prawego poddrzewa (R->L->L->…->L).
Ten najmniejszy element wstawiamy w miejsce elementu do usunięcia.

(define (delete elt t)
    (define (find-smallest t)
        (if (leaf? (left-subtree t))
            (value t)
            (find-smallest (left-subtree t))))
    (cond
        [(leaf? t) (leaf)]
        [(= (value t) elt)
            (if (leaf? (right-subtree t))
                (left-subtree t)
                (let [(smallest (find-smallest (right-subtree t)))]
                    (node
                        smallest
                        (left-subtree t)
                        (delete smallest (right-subtree t))
                    )))]
        [(> (value t) elt) (node (value t)
            (delete elt (left-subtree t))
            (right-subtree t))]
        [(< (value t) elt) (node (value t)
            (left-subtree t)
            (delete elt (right-subtree t)))]
    )
)