diff options
Diffstat (limited to 'Semestr 2/racket/l11z20')
| -rw-r--r-- | Semestr 2/racket/l11z20/compiled/drracket/errortrace/graph_rkt.dep | 1 | ||||
| -rw-r--r-- | Semestr 2/racket/l11z20/compiled/drracket/errortrace/graph_rkt.zo | bin | 0 -> 43422 bytes | |||
| -rw-r--r-- | Semestr 2/racket/l11z20/graph.bak | 97 | ||||
| -rw-r--r-- | Semestr 2/racket/l11z20/graph.rkt | 100 | ||||
| -rw-r--r-- | Semestr 2/racket/l11z20/solution.bak | 1 | ||||
| -rw-r--r-- | Semestr 2/racket/l11z20/solution.rkt | 245 |
6 files changed, 444 insertions, 0 deletions
diff --git a/Semestr 2/racket/l11z20/compiled/drracket/errortrace/graph_rkt.dep b/Semestr 2/racket/l11z20/compiled/drracket/errortrace/graph_rkt.dep new file mode 100644 index 0000000..6d38ce0 --- /dev/null +++ b/Semestr 2/racket/l11z20/compiled/drracket/errortrace/graph_rkt.dep @@ -0,0 +1 @@ +("7.6" racket ("b51d3a36a64d34c7978bfc22f2a5fe674cee1cb6" . "8314027ed4c1c6fd9c412af77103e94790e59dd2") (collects #"errortrace" #"errortrace-key.rkt") (collects #"racket" #"main.rkt") (collects #"racket" #"runtime-config.rkt")) diff --git a/Semestr 2/racket/l11z20/compiled/drracket/errortrace/graph_rkt.zo b/Semestr 2/racket/l11z20/compiled/drracket/errortrace/graph_rkt.zo Binary files differnew file mode 100644 index 0000000..ef91f9a --- /dev/null +++ b/Semestr 2/racket/l11z20/compiled/drracket/errortrace/graph_rkt.zo diff --git a/Semestr 2/racket/l11z20/graph.bak b/Semestr 2/racket/l11z20/graph.bak new file mode 100644 index 0000000..9f4d79d --- /dev/null +++ b/Semestr 2/racket/l11z20/graph.bak @@ -0,0 +1,97 @@ +#lang racket + +(provide bag^ graph^ simple-graph@ graph-search^ graph-search@) + +;; sygnatura dla struktury danych +(define-signature bag^ + ((contracted + [bag? (-> any/c boolean?)] + [empty-bag (and/c bag? bag-empty?)] + [bag-empty? (-> bag? boolean?)] + [bag-insert (-> bag? any/c (and/c bag? (not/c bag-empty?)))] + [bag-peek (-> (and/c bag? (not/c bag-empty?)) any/c)] + [bag-remove (-> (and/c bag? (not/c bag-empty?)) bag?)]))) + +;; sygnatura: grafy +(define-signature graph^ + ((contracted + [graph (-> list? (listof edge?) graph?)] + [graph? (-> any/c boolean?)] + [graph-nodes (-> graph? list?)] + [graph-edges (-> graph? (listof edge?))] + [edge (-> any/c any/c edge?)] + [edge? (-> any/c boolean?)] + [edge-start (-> edge? any/c)] + [edge-end (-> edge? any/c)] + [has-node? (-> graph? any/c boolean?)] + [outnodes (-> graph? any/c list?)] + [remove-node (-> graph? any/c graph?)] + ))) + +;; prosta implementacja grafów +(define-unit simple-graph@ + (import) + (export graph^) + + (define (graph? g) + (and (list? g) + (eq? (length g) 3) + (eq? (car g) 'graph))) + + (define (edge? e) + (and (list? e) + (eq? (length e) 3) + (eq? (car e) 'edge))) + + (define (graph-nodes g) (cadr g)) + + (define (graph-edges g) (caddr g)) + + (define (graph n e) (list 'graph n e)) + + (define (edge n1 n2) (list 'edge n1 n2)) + + (define (edge-start e) (cadr e)) + + (define (edge-end e) (caddr e)) + + (define (has-node? g n) (not (not (member n (graph-nodes g))))) + + (define (outnodes g n) + (filter-map + (lambda (e) + (and (eq? (edge-start e) n) + (edge-end e))) + (graph-edges g))) + + (define (remove-node g n) + (graph + (remove n (graph-nodes g)) + (filter + (lambda (e) + (not (eq? (edge-start e) n))) + (graph-edges g))))) + +;; sygnatura dla przeszukiwania grafu +(define-signature graph-search^ + (search)) + +;; implementacja przeszukiwania grafu +;; uzależniona od implementacji grafu i struktury danych +(define-unit graph-search@ + (import bag^ graph^) + (export graph-search^) + (define (search g n) + (define (it g b l) + (cond + [(bag-empty? b) (reverse l)] + [(has-node? g (bag-peek b)) + (it (remove-node g (bag-peek b)) + (foldl + (lambda (n1 b1) (bag-insert b1 n1)) + (bag-remove b) + (outnodes g (bag-peek b))) + (cons (bag-peek b) l))] + [else (it g (bag-remove b) l)])) + (it g (bag-insert empty-bag n) '())) + ) diff --git a/Semestr 2/racket/l11z20/graph.rkt b/Semestr 2/racket/l11z20/graph.rkt new file mode 100644 index 0000000..ec19576 --- /dev/null +++ b/Semestr 2/racket/l11z20/graph.rkt @@ -0,0 +1,100 @@ +#lang racket + +(provide bag^ graph^ simple-graph@ graph-search^ graph-search@) + +;; sygnatura dla struktury danych +(define-signature bag^ + ((contracted + [bag? (-> any/c boolean?)] + [empty-bag (and/c bag? bag-empty?)] + [bag-empty? (-> bag? boolean?)] + [bag-insert (-> bag? any/c (and/c bag? (not/c bag-empty?)))] + [bag-peek (-> (and/c bag? (not/c bag-empty?)) any/c)] + [bag-remove (-> (and/c bag? (not/c bag-empty?)) bag?)]))) + +;; sygnatura: grafy +(define-signature graph^ + ((contracted + [graph (-> list? (listof edge?) graph?)] + [graph? (-> any/c boolean?)] + [graph-nodes (-> graph? list?)] + [graph-edges (-> graph? (listof edge?))] + [edge (-> any/c any/c edge?)] + [edge? (-> any/c boolean?)] + [edge-start (-> edge? any/c)] + [edge-end (-> edge? any/c)] + [has-node? (-> graph? any/c boolean?)] + [outnodes (-> graph? any/c list?)] + [remove-node (-> graph? any/c graph?)] + ))) + +;; prosta implementacja grafów +(define-unit simple-graph@ + (import) + (export graph^) + + (define (graph? g) + (and (list? g) + (eq? (length g) 3) + (eq? (car g) 'graph))) + + (define (edge? e) + (and (list? e) + (eq? (length e) 3) + (eq? (car e) 'edge))) + + (define (graph-nodes g) (cadr g)) + + (define (graph-edges g) (caddr g)) + + (define (graph n e) (list 'graph n e)) + + (define (edge n1 n2) (list 'edge n1 n2)) + + (define (edge-start e) (cadr e)) + + (define (edge-end e) (caddr e)) + + (define (has-node? g n) (not (not (member n (graph-nodes g))))) + + (define (outnodes g n) + (filter-map + (lambda (e) + (and (eq? (edge-start e) n) + (edge-end e))) + (graph-edges g))) + + (define (remove-node g n) + (graph + (remove n (graph-nodes g)) + (filter + (lambda (e) + (not (eq? (edge-start e) n))) + (graph-edges g))))) + +;; sygnatura dla przeszukiwania grafu +(define-signature graph-search^ + (search)) + +;; implementacja przeszukiwania grafu +;; uzależniona od implementacji grafu i struktury danych +(define-unit graph-search@ + (import bag^ graph^) + (export graph-search^) + (define (search g n) + (define (it g b l) + (cond + [(bag-empty? b) (reverse l)] + [(has-node? g (bag-peek b)) + (it (remove-node g (bag-peek b)) + (foldl + (lambda (n1 b1) (bag-insert b1 n1)) + (bag-remove b) + (outnodes g (bag-peek b))) + (cons (bag-peek b) l))] + [else (it g (bag-remove b) l)])) + (it g (bag-insert empty-bag n) '())) + ) + +;; otwarcie komponentu grafu +(define-values/invoke-unit/infer simple-graph@)
\ No newline at end of file diff --git a/Semestr 2/racket/l11z20/solution.bak b/Semestr 2/racket/l11z20/solution.bak new file mode 100644 index 0000000..6f1f7b4 --- /dev/null +++ b/Semestr 2/racket/l11z20/solution.bak @@ -0,0 +1 @@ +#lang racket diff --git a/Semestr 2/racket/l11z20/solution.rkt b/Semestr 2/racket/l11z20/solution.rkt new file mode 100644 index 0000000..e3ad81f --- /dev/null +++ b/Semestr 2/racket/l11z20/solution.rkt @@ -0,0 +1,245 @@ +#lang racket + +(require "graph.rkt") +(provide bag-stack@ bag-fifo@) + +;; struktura danych - stos +(define-unit bag-stack@ + (import) + (export bag^) + + (define (bag? b) + (and (cons? b) + (eq? (car b) 'stack))) + + (define empty-bag (cons 'stack null)) + + (define (bag-empty? b) + (null? (cdr b))) + + (define (bag-insert b val) + (cons 'stack (cons val (cdr b)))) + + (define (bag-peek b) + (cadr b)) + + (define (bag-remove b) + (cons 'stack (cddr b))) +) + +;; struktura danych - kolejka FIFO +(define-unit bag-fifo@ + (import) + (export bag^) + + (define (bag? b) + (and (list? b) + (eq? (length b) 3) + (eq? (first b) 'queue))) + + (define empty-bag + (list 'queue null null)) + + (define (bag-empty? b) + (and (null? (second b)) (null? (third b)))) + + (define (bag-insert b val) + (list 'queue (cons val (second b)) (third b))) + + (define (bag-peek b) + (let ((insq (second b)) + (popq (third b))) + (cond + [(null? popq) (last insq)] + [else (first popq)]))) + + (define (bag-remove b) + (let ((insq (second b)) + (popq (third b))) + (cond + [(null? popq) (list 'queue null (cdr (reverse insq)))] + [else (list 'queue insq (cdr popq))]))) +) + +;; otwarcie komponentów stosu i kolejki + +(define-values/invoke-unit bag-stack@ + (import) + (export (prefix stack: bag^))) + +(define-values/invoke-unit bag-fifo@ + (import) + (export (prefix fifo: bag^))) + +;; testy w Quickchecku +(require quickcheck) + +;; liczba zapytań na test quickchecka +(define TESTS 1000) + + +;; TESTY DO KOLEJKI + +;; xs to lista jakichś liczb, queries to rodzaj wykonywanych operacji +;; 0 - popuje na listę pops +;; 1 - insertuje na queue +;; jest nie ma nic na kolejce/stosie i dostajemy 0, to nic nie robimy +;; jesli queries albo xs są puste to po prostu kończymy obsługiwanie zapytań +;; na koncu sprawdzamy, czy (reverse pops) jest prefiksem xs + + +(define (check-queue xs queries) + (define (iter xs queries queue pops) + ;; (display queue) + ;; (newline) + (if (or (null? queries) (null? xs)) + (reverse pops) + (cond + [(and (eq? (car queries) 0) (not (fifo:bag-empty? queue))) + (iter xs (cdr queries) (fifo:bag-remove queue) (cons (fifo:bag-peek queue) pops))] + [else (iter (cdr xs) (cdr queries) (fifo:bag-insert queue (car xs)) pops)]))) + (define (is-prefix? xs ys) + (if (null? xs) + #t + (and (equal? (car xs) (car ys)) (is-prefix? (cdr xs) (cdr ys))))) + (is-prefix? (iter xs queries fifo:empty-bag null) xs)) + +;; sprawdzenie czy nasza funkcja testująca w ogóle działa +(define check-queue-test (lambda () (check-queue (list 1 2 3 4 5 6 7 8) (list 0 1 1 1 0 0 0 1 1 0 1 0 1 0 0)))) + +;; testowanie kolejki +(define-unit queue-tests@ + (import bag^) + (export) + + (quickcheck + (property ([xs (choose-list (choose-real -100000 100000) TESTS)] + [ops (choose-list (choose-integer 0 1) TESTS)]) + (check-queue xs ops)))) + +(invoke-unit queue-tests@ (import (prefix fifo: bag^))) + + +;; TESTY DO STOSU + +;; niestety tutaj nie jest tak kolorowo, na kolejce +;; dokładnie wiemy jaka jest koljeność popowanych, na stosie to dosyć dowolne. +;; Z drugiej strony jego implementacja jest dużo prostsza, więc testy też nie muszą +;; być bardzo rygorystyczne. + +(define (check-stack xs) + (define (insert-list stack xs) + (if (null? xs) + stack + (insert-list (stack:bag-insert stack (car xs)) (cdr xs)))) + (define (clear-stack stack pops) + (if (stack:bag-empty? stack) + pops + (clear-stack (stack:bag-remove stack) (cons (stack:bag-peek stack) pops)))) + (equal? xs (clear-stack (insert-list stack:empty-bag xs) null))) + + +;; testowanie stacka +(define-unit stack-tests@ + (import bag^) + (export) + (quickcheck + (property ([xs (choose-list (choose-real -100000 100000) TESTS)]) + (check-stack xs)))) + +(invoke-unit stack-tests@ (import (prefix stack: bag^))) + + + +;; testy kolejek i stosów +(define-unit bag-tests@ + (import bag^) + (export) + + ;; test przykładowy: jeśli do pustej struktury dodamy element + ;; i od razu go usuniemy, wynikowa struktura jest pusta + (quickcheck + (property ([s arbitrary-symbol]) + (bag-empty? (bag-remove (bag-insert empty-bag s))))) + + ;; Sprawdzenie własności wspólnych dla obu struktur + (quickcheck + (property ([s arbitrary-symbol]) + (equal? s (bag-peek (bag-insert empty-bag s))))) +) + +;; uruchomienie testów dla obu struktur danych + +(invoke-unit bag-tests@ (import (prefix stack: bag^))) +(invoke-unit bag-tests@ (import (prefix fifo: bag^))) + + + +;; TESTOWANIE PRZESZUKIWAŃ + +;; otwarcie komponentu grafu +(define-values/invoke-unit/infer simple-graph@) + +;; otwarcie komponentów przeszukiwania +;; w głąb i wszerz +(define-values/invoke-unit graph-search@ + (import graph^ (prefix stack: bag^)) + (export (prefix dfs: graph-search^))) + +(define-values/invoke-unit graph-search@ + (import graph^ (prefix fifo: bag^)) + (export (prefix bfs: graph-search^))) + +;; graf testowy +(define test-graph + (graph + (list 1 2 3 4) + (list (edge 1 3) + (edge 1 2) + (edge 2 4)))) + +(define test-graph2 + (graph (list 1) null)) + +(define test-graph3 + (graph (list 1 2 3 4 5 6 7 8 9 10) + (list (edge 1 2) + (edge 1 3) + (edge 2 3) + (edge 3 2) + (edge 3 5) + (edge 6 5) + (edge 5 7) + (edge 5 8) + (edge 7 9) + (edge 8 9) + (edge 9 10) + (edge 1 10) + (edge 10 1)))) + + +(define test-graph4 + (graph (list 1 2 3 4 5 6) + (list (edge 1 2) + (edge 2 3) + (edge 3 4) + (edge 4 5) + (edge 5 6)))) + +;; uruchomienie przeszukiwania na przykładowym grafie +(bfs:search test-graph 1) +(dfs:search test-graph 1) + +(bfs:search test-graph2 1) +(dfs:search test-graph2 1) + +(bfs:search test-graph3 1) +(dfs:search test-graph3 1) + +(bfs:search test-graph3 6) +(dfs:search test-graph3 6) + +(bfs:search test-graph4 1) +(dfs:search test-graph4 1) + + |