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)