aboutsummaryrefslogtreecommitdiff
path: root/Semestr 2/racket/l11z20
diff options
context:
space:
mode:
authorFranciszek Malinka <franciszek.malinka@gmail.com>2021-10-05 21:49:54 +0200
committerFranciszek Malinka <franciszek.malinka@gmail.com>2021-10-05 21:49:54 +0200
commitc5fcf7179a83ef65c86c6a4a390029149e518649 (patch)
treed29ffc5b86a0d257453cedcf87d91a13d8bf3b0d /Semestr 2/racket/l11z20
parentf8a88b6a4aba1f66d04711a9330eaba49a50c463 (diff)
Duzy commit ze smieciami
Diffstat (limited to 'Semestr 2/racket/l11z20')
-rw-r--r--Semestr 2/racket/l11z20/compiled/drracket/errortrace/graph_rkt.dep1
-rw-r--r--Semestr 2/racket/l11z20/compiled/drracket/errortrace/graph_rkt.zobin43422 -> 0 bytes
-rw-r--r--Semestr 2/racket/l11z20/graph.bak97
-rw-r--r--Semestr 2/racket/l11z20/graph.rkt100
-rw-r--r--Semestr 2/racket/l11z20/solution.bak1
-rw-r--r--Semestr 2/racket/l11z20/solution.rkt245
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
deleted file mode 100644
index ef91f9a..0000000
--- a/Semestr 2/racket/l11z20/compiled/drracket/errortrace/graph_rkt.zo
+++ /dev/null
Binary files differ
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)
-
-