Welcome to the CHICKEN Scheme pasting service
Benchmarking on data strutctures added by arthurmaciel on Wed Feb 13 15:18:38 2013
$ 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)