1 files changed, 100 insertions, 0 deletions
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