aboutsummaryrefslogtreecommitdiff
path: root/Semestr 2/racket/l11z20/graph.rkt
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/graph.rkt
parentf8a88b6a4aba1f66d04711a9330eaba49a50c463 (diff)
Duzy commit ze smieciami
Diffstat (limited to 'Semestr 2/racket/l11z20/graph.rkt')
-rw-r--r--Semestr 2/racket/l11z20/graph.rkt100
1 files changed, 0 insertions, 100 deletions
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