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 | 43422 -> 0 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, 0 insertions, 444 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 deleted file mode 100644 index 6d38ce0..0000000 --- a/Semestr 2/racket/l11z20/compiled/drracket/errortrace/graph_rkt.dep +++ /dev/null @@ -1 +0,0 @@ -("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 differdeleted file mode 100644 index ef91f9a..0000000 --- a/Semestr 2/racket/l11z20/compiled/drracket/errortrace/graph_rkt.zo +++ /dev/null diff --git a/Semestr 2/racket/l11z20/graph.bak b/Semestr 2/racket/l11z20/graph.bak deleted file mode 100644 index 9f4d79d..0000000 --- a/Semestr 2/racket/l11z20/graph.bak +++ /dev/null @@ -1,97 +0,0 @@ -#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 deleted file mode 100644 index ec19576..0000000 --- a/Semestr 2/racket/l11z20/graph.rkt +++ /dev/null @@ -1,100 +0,0 @@ -#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 deleted file mode 100644 index 6f1f7b4..0000000 --- a/Semestr 2/racket/l11z20/solution.bak +++ /dev/null @@ -1 +0,0 @@ -#lang racket diff --git a/Semestr 2/racket/l11z20/solution.rkt b/Semestr 2/racket/l11z20/solution.rkt deleted file mode 100644 index e3ad81f..0000000 --- a/Semestr 2/racket/l11z20/solution.rkt +++ /dev/null @@ -1,245 +0,0 @@ -#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) - - |