Welcome to the CHICKEN Scheme pasting service

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

 Adding edges (List in hash-table)
2.612s CPU time, 0.912s GC time (major), 2504795 mutations, 18/10377 GCs (major/minor)

 Checking nodes (List in hash-table)
0.004s CPU time, 0/4 GCs (major/minor)

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

 Removing edges (List in hash-table)
103.723s CPU time, 3.78s GC time (major), 14/731982 GCs (major/minor)

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

 Adding edges (Nested hash-tables)
11.225s CPU time, 7.669s GC time (major), 5209795 mutations, 18/17604 GCs (major/minor)

 Checking nodes (Nested hash-tables)
0s CPU time, 0/4 GCs (major/minor)

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

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

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

 Adding edges (Nested persistent hash maps)
7.824s CPU time, 0.8s GC time (major), 31651897 mutations, 1/44455 GCs (major/minor)

 Checking nodes (Nested persistent hash maps)
0s CPU time, 10000 mutations, 0/11 GCs (major/minor)

 Checking edges (Nested persistent hash maps)
3.097s CPU time, 20000000 mutations, 0/21880 GCs (major/minor)

 Removing edges (Nested persistent hash maps)
3.748s CPU time, 17020000 mutations, 0/28541 GCs (major/minor)



-----------------------------------------------------------------------------------------------
(use srfi-69 srfi-1 persistent-hash-map)

(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))))(use srfi-69 srfi-1 persistent-hash-map)

(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-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 "Unknown 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-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 (nphm-graph)
  (define g (map->transient-map (persistent-map)))
  
  (define (id) "Nested persistent hash maps")

  (define (add-edge! s-node d-node #!optional (property 'none))
    (let ((edges (map-ref g s-node)))
      (if edges
          (map-add! edges d-node property)
          (map-add! g s-node
                    (map->transient-map (persistent-map d-node property))))))

  (define (remove-edge! s-node d-node)
    (let ((edges (map-ref g s-node)))
      (if edges
          (map-delete! edges d-node)
          #f)))

  (define (has-node? node)
    (map-contains? g node))

  (define (has-edge? s-node d-node)
    (let ((edges (map-ref g s-node)))
      (if edges
          (map-contains? edges d-node)
          #f)))

  (define (graph->alist)
    (map->alist g))

  ;; Dispatcher
  (lambda (selector)
    (case selector
      ((id)                id)
      ((add-edge!)         add-edge!)
      ((remove-edge!)      remove-edge!)
      ((has-edge?)         has-edge?)
      ((has-node?)         has-node?)
      ((graph->alist)      graph->alist)
      (else (error "Unknown procedure")))))

(define (make-graph #!optional (impl 'lht))
  (case impl
    ((lht)     (lht-graph))
    ((nht)     (nht-graph))
    ((nphm)    (nphm-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))
(define nphm-graph (make-graph 'nphm))

(run-test lht-graph)
(printf "~N-----------------------------------------------------------------~N")
(run-test nht-graph)
(printf "~N-----------------------------------------------------------------~N")
(run-test nphm-graph)


  (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-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 "Unknown 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-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 (nphm-graph)
  (define g (map->transient-map (persistent-map)))
  
  (define (id) "Nested persistent hash maps")

  (define (add-edge! s-node d-node #!optional (property 'none))
    (let ((edges (map-ref g s-node)))
      (if edges
          (map-add! edges d-node property)
          (map-add! g s-node
                    (map->transient-map (persistent-map d-node property))))))

  (define (remove-edge! s-node d-node)
    (let ((edges (map-ref g s-node)))
      (if edges
          (map-delete! edges d-node)
          #f)))

  (define (has-node? node)
    (map-contains? g node))

  (define (has-edge? s-node d-node)
    (let ((edges (map-ref g s-node)))
      (if edges
          (map-contains? edges d-node)
          #f)))

  (define (graph->alist)
    (map->alist g))

  ;; Dispatcher
  (lambda (selector)
    (case selector
      ((id)                id)
      ((add-edge!)         add-edge!)
      ((remove-edge!)      remove-edge!)
      ((has-edge?)         has-edge?)
      ((has-node?)         has-node?)
      ((graph->alist)      graph->alist)
      (else (error "Unknown procedure")))))

(define (make-graph #!optional (impl 'lht))
  (case impl
    ((lht)     (lht-graph))
    ((nht)     (nht-graph))
    ((nphm)    (nphm-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))
(define nphm-graph (make-graph 'nphm))

(run-test lht-graph)
(printf "~N-----------------------------------------------------------------~N")
(run-test nht-graph)
(printf "~N-----------------------------------------------------------------~N")
(run-test nphm-graph)