Duzy commit ze smieciami

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
new 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)
+
+