$ csc implementations.scm -o implementations && ./implementations 

 Adding edges (Nested hash-tables)
6.632s CPU time, 3.396s GC time (major), 5209795 mutations, 45/17615 GCs (major/minor)

 Serializing to file (Nested hash-tables)
19.613s CPU time, 2.592s GC time (major), 22653398 mutations, 5/56528 GCs (major/minor)

 Checking nodes (Nested hash-tables)
0s CPU time

 Checking edges (Nested hash-tables)
1.076s CPU time, 0/8441 GCs (major/minor)

 Removing edges (Nested hash-tables)
1.112s CPU time, 0/8746 GCs (major/minor)

-----------------------------------------------------------------

 Adding edges (List in hash-table)
1.564s CPU time, 2504795 mutations, 0/10471 GCs (major/minor)

 Serializing to file (List in hash-table)
20.25s CPU time, 3.216s GC time (major), 22673569 mutations, 10/54625 GCs (major/minor)

 Checking nodes (List in hash-table)
0s CPU time

 Checking edges (List in hash-table)
47.315s CPU time, 0/4889 GCs (major/minor)

 Removing edges (List in hash-table)
102.21s CPU time, 0.288s GC time (major), 1/732014 GCs (major/minor)


(use extras srfi-69 srfi-1)

;; Conventions:
;; nht = nested hash tables
;; lht = list in hash table
;; 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)))))
  
  ;; 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 (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 (run-test graph)
  (time (add-edges graph))
;;  (pp ((graph 'graph->alist)))
  (time (serialize-to-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 nht-graph)
(printf "~N-----------------------------------------------------------------~N")
(run-test lht-graph)