#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@)