Two graph implementations added by arthurmaciel on Fri Feb 8 18:04:33 2013
(use extras srfi-69 srfi-1) ;; Conventions: ;; nht = nested hash tables implementation ;; The nodes are stored as keys in a hash-table. The hash-table values are hash-tables that ;; as keys hold other nodes number (and this forms an edge) and as values hold edge properties. ;; lht = list in hash table implementation ;; The nodes are also stored as keys in a hash-table. The hash-table values are alists which ;; hold as the car of each sublist other nodes number (so forming edges) and as the cdr ;; edge properties. ;; s-node = source node (of edge) ;; d-node = destination node (of edge) (define (lht-graph) (define g (make-hash-table)) (define (id) "List in hash-table") (define (add-edge! s-node d-node #!optional (property 'none)) (hash-table-update!/default g s-node (lambda (v) (cons (cons d-node property) v)) (list (cons d-node property)))) (define (remove-edge! s-node d-node) (let ((edges (hash-table-ref/default g s-node #f))) (if edges (delete! d-node edges)))) (define (has-node? node) (hash-table-exists? g node)) (define (has-edge? s-node d-node) (member d-node (hash-table-ref/default g s-node '()))) (define (graph->alist) (hash-table-map g (lambda(k v) (cons k v)))) (define (serialize #!optional (file "graph.txt")) (with-output-to-file file (lambda () (pp (graph->alist))))) (define (unserialize #!optional (file "graph.txt")) (with-input-from-file file (lambda () (set! g (alist->hash-table (read)))))) ;; Dispatcher (lambda (selector) (case selector ((id) id) ;;((add-node!) add-node!) ((add-edge!) add-edge!) ((remove-edge!) remove-edge!) ((has-edge?) has-edge?) ((has-node?) has-node?) ((graph->alist) graph->alist) ((serialize) serialize) ((unserialize) unserialize) (else (error "Uknown procedure"))))) (define (nht-graph) (define g (make-hash-table)) (define (id) "Nested hash-tables") (define (add-edge! s-node d-node #!optional (property 'none)) (let ((edges (hash-table-ref/default g s-node #f))) (if edges (hash-table-set! edges d-node property) (hash-table-set! g s-node (alist->hash-table `((,d-node . ,property))))))) (define (remove-edge! s-node d-node) (let ((edges (hash-table-ref/default g s-node #f))) (if edges (hash-table-delete! edges d-node) #f))) (define (has-node? node) (hash-table-exists? g node)) (define (has-edge? s-node d-node) (let ((edges (hash-table-ref/default g s-node #f))) (if edges (hash-table-exists? edges d-node) #f))) (define (graph->alist) (hash-table-map g (lambda(k v) (cons k (hash-table->alist v))))) (define (serialize #!optional (file "graph.txt")) (with-output-to-file file (lambda () (pp (graph->alist))))) ;; Dispatcher (lambda (selector) (case selector ((id) id) ;;((add-node!) add-node!) ((add-edge!) add-edge!) ((remove-edge!) remove-edge!) ((has-edge?) has-edge?) ((has-node?) has-node?) ((graph->alist) graph->alist) ((serialize) serialize) (else (error "Uknown procedure"))))) (define (make-graph #!optional (impl 'lht)) (case impl ((lht) (lht-graph)) ((nht) (nht-graph)))) ;; Test case (define VERTEXES 2500) (define EDGES 1000) (define (add-edges g) (printf "~N Adding edges (~A)~N" ((g 'id))) (do ((n 0 (+ n 1))) ((= n VERTEXES)) (do ((e 0 (+ e 1))) ((= e EDGES)) ((g 'add-edge!) n (+ e 1))))) (define (del-edges g) (printf "~N Removing edges (~A)~N" ((g 'id))) (do ((n 0 (+ n 1))) ((= n VERTEXES)) (do ((e 0 (+ e 1))) ((= e EDGES)) ((g 'remove-edge!) n (+ e 1))))) (define (check-nodes g) (printf "~N Checking nodes (~A)~N" ((g 'id))) (do ((n 0 (+ n 1))) ((= n VERTEXES)) (g 'has-node?) n)) (define (check-edges g) (printf "~N Checking edges (~A)~N" ((g 'id))) (do ((n 0 (+ n 1))) ((= n VERTEXES)) (do ((e 0 (+ e 1))) ((= e EDGES)) ((g 'has-edge?) n (+ e 1))))) (define (serialize-to-file g) (printf "~N Serializing to file (~A)~N" ((g 'id))) ((g 'serialize))) (define (unserialize-from-file g) (printf "~N Unserializing from file (~A)~N" ((g 'id))) ((g 'unserialize))) (define (run-test graph) (time (add-edges graph)) ;; (pp ((graph 'graph->alist))) (time (serialize-to-file graph)) (time (unserialize-from-file graph)) ;; (time (check-nodes graph)) ;; (time (check-edges graph)) ;; (time (del-edges graph))) ) (define lht-graph (make-graph 'lht)) (define nht-graph (make-graph 'nht)) (run-test lht-graph) (printf "~N-----------------------------------------------------------------~N") (run-test nht-graph)