blob: ec195760e8d3c6766f49578caa0775b03106f9bf (
plain)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
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@)
|
