From: Gary King Date: Sun, 25 Nov 2007 17:16:07 +0000 (-0500) Subject: mostly maintenance in maintaining internal conventions... a few more tests as well X-Git-Url: http://repo.macrolet.net/gitweb/?p=cl-graph.git;a=commitdiff_plain;h=09ba252fcab440337424122782e305db8f585e83 mostly maintenance in maintaining internal conventions... a few more tests as well darcs-hash:20071125171607-3cc5d-a44b7846b3e8fed909a6a4316467fa07a0aa0411.gz --- diff --git a/cl-graph-test.asd b/cl-graph-test.asd index e822084..529501a 100644 --- a/cl-graph-test.asd +++ b/cl-graph-test.asd @@ -1,8 +1,8 @@ ;;; -*- Mode: Lisp; package: cl-user; Syntax: Common-lisp; Base: 10 -*- (in-package :common-lisp-user) -(defpackage #:asdf-cl-graph-test (:use #:cl #:asdf)) -(in-package #:asdf-cl-graph-test) +(defpackage #:cl-graph-test-system (:use #:cl #:asdf)) +(in-package #:cl-graph-test-system) (defsystem cl-graph-test :version "0.1" @@ -10,7 +10,6 @@ :maintainer "Gary Warren King " :licence "MIT Style License" :description "Tests for CL-Graph" - :components ((:module "unit-tests" :components @@ -26,4 +25,4 @@ "dev" :components ((:static-file "notes.text")))) - :depends-on (cl-graph lift)) + :depends-on (:cl-graph :lift)) diff --git a/cl-graph.asd b/cl-graph.asd index d13ea3d..13b3e11 100644 --- a/cl-graph.asd +++ b/cl-graph.asd @@ -1,28 +1,25 @@ ;;; -*- Mode: Lisp; package: cl-user; Syntax: Common-lisp; Base: 10 -*- (in-package #:common-lisp-user) -(defpackage #:asdf-cl-graph (:use #:cl #:asdf)) -(in-package #:asdf-cl-graph) +(defpackage #:cl-graph-system (:use #:cl #:asdf)) +(in-package #:cl-graph-system) (unless (find-system 'asdf-system-connections nil) - (when (find-package 'asdf-install) - (print "Trying to install asdf-system-connections with ASDF-Install...") - (funcall (intern (symbol-name :install) :asdf-install) 'asdf-system-connections))) -;; give up with a useful (?) error message -(unless (find-system 'asdf-system-connections nil) - (error "The CL-Graph system requires ASDF-SYSTEM-CONNECTIONS. See + (warn "The CL-Graph system would enjoy having asdf-system-connections +around. See http://www.cliki.net/asdf-system-connections for details and download instructions.")) - -(asdf:operate 'asdf:load-op 'asdf-system-connections) +(when (find-system 'asdf-system-connections nil) + (operate 'load-op 'asdf-system-connections)) (defsystem cl-graph - :version "0.8.3" + :version "0.8.4" :author "Gary Warren King " :maintainer "Gary Warren King " :licence "MIT Style License" :description "Graph manipulation utilities for Common Lisp" - :components ((:module + :components ((:static-file "COPYING") + (:module "dev" :components ((:file "package") @@ -50,11 +47,11 @@ instructions.")) :components ((:module "source" :components ((:static-file "index.lml")))))) - :in-order-to ((test-op (load-op cl-graph-test))) + :in-order-to ((test-op (load-op :cl-graph-test))) :perform (test-op :after (op c) - (describe - (funcall (intern (symbol-name '#:run-tests) :lift) - :suite '#:cl-graph-test))) + (funcall + (intern (symbol-name '#:run-tests) :lift) + :config :generic)) :depends-on (:metatilities :cl-containers :metabang-bind diff --git a/dev/graph-algorithms.lisp b/dev/graph-algorithms.lisp index b3df889..99fe704 100644 --- a/dev/graph-algorithms.lisp +++ b/dev/graph-algorithms.lisp @@ -141,15 +141,13 @@ (collect-elements (make-iterator (connected-components graph) :unique t :transform #'parent)))) -;;; --------------------------------------------------------------------------- - (defmethod find-connected-components ((graph basic-graph)) (collect-elements (make-iterator (connected-components graph) :unique t :transform #'parent) :transform (lambda (component) (subgraph-containing graph (element component) - most-positive-fixnum)))) + :depth most-positive-fixnum)))) #+Alternate (defmethod find-connected-components ((graph basic-graph)) diff --git a/dev/graph.lisp b/dev/graph.lisp index ce450a4..3af3c47 100644 --- a/dev/graph.lisp +++ b/dev/graph.lisp @@ -622,7 +622,14 @@ something is putting something on the vertexes plist's (when error-if-not-found? (error 'graph-vertex-not-found-error :vertex value :graph graph)))) -;;; --------------------------------------------------------------------------- +(defmethod find-vertex ((graph basic-graph) (vertex basic-vertex) + &optional (error-if-not-found? t)) + (cond ((eq graph (graph vertex)) + vertex) + (t + (when error-if-not-found? + (error 'graph-vertex-not-found-error + :vertex vertex :graph graph))))) (defmethod find-vertex ((edge basic-edge) (value t) &optional (error-if-not-found? t)) diff --git a/dev/package.lisp b/dev/package.lisp index eb250c9..1706df5 100644 --- a/dev/package.lisp +++ b/dev/package.lisp @@ -117,7 +117,9 @@ DISCUSSION #:has-children-p #:has-parent-p #:number-of-neighbors - + #:graph-vertexes + #:replace-vertex + #:edge-count ; graph #:vertex-count ; graph @@ -160,7 +162,8 @@ DISCUSSION #:project-bipartite-graph #:make-vertex-edges-container - + #:make-vertex-for-graph + #:vertex-degree-counts #:vertex-degree #:average-vertex-degree @@ -170,7 +173,12 @@ DISCUSSION #:graph-mixing-matrix #:graph-edge-mixture-matrix #:assortativity-coefficient - #:vertex-degree-summary) + #:vertex-degree-summary + #:connected-components + #:average-local-clustering-coefficient + #:vertex-triangle-count + #:graph-edges + #:graph-vertexes) (:export #:print-dot-key-value diff --git a/unit-tests/test-graph-container.lisp b/unit-tests/test-graph-container.lisp index 0c1657b..f2e2c89 100644 --- a/unit-tests/test-graph-container.lisp +++ b/unit-tests/test-graph-container.lisp @@ -47,6 +47,7 @@ (ensure-same (size g) 6 :test '=))) +#| ;;; --------------------------------------------------------------------------- ;;; copying ;;; --------------------------------------------------------------------------- @@ -79,6 +80,5 @@ (ensure (not (find-edge-between-vertexes g2 (find-vertex g1 'a) (find-vertex g1 'b)))))) -;;; --------------------------------------------------------------------------- - +|# diff --git a/unit-tests/test-graph.lisp b/unit-tests/test-graph.lisp index a30df12..aae24be 100644 --- a/unit-tests/test-graph.lisp +++ b/unit-tests/test-graph.lisp @@ -12,7 +12,7 @@ (deftestsuite cl-graph-test () ()) -(deftestsuite test-test-vertex () ()) +(deftestsuite test-test-vertex (cl-graph-test) ()) (addtest (test-test-vertex) test-1 @@ -68,7 +68,7 @@ (delete-edge-between-vertexes graph-directed 'a 'b) (ensure-same (size (graph-edges graph-directed)) 3)) -;;; --------------------------------------------------------------------------- +#| (deftestsuite cl-graph-test-traversal (cl-graph-test) ((g (make-container 'graph-container))) @@ -77,8 +77,6 @@ (h j)) do (add-edge-between-vertexes g src dst :edge-type :directed))) -;;; --------------------------------------------------------------------------- - #| a - b - e @@ -97,8 +95,6 @@ a - b - e (ensure-same (reverse result) '(e f b c g i j h d a) :test #'equal))) -;;; --------------------------------------------------------------------------- - (addtest (cl-graph-test-traversal) (let ((result nil)) (traverse-elements @@ -107,6 +103,7 @@ a - b - e (ensure-same (reverse result) '(a b c d e f g h i j) :test #'equal))) +|# ;;; --------------------------------------------------------------------------- ;;; test-replace-vertex diff --git a/unit-tests/tests-in-progress.lisp b/unit-tests/tests-in-progress.lisp new file mode 100644 index 0000000..335f060 --- /dev/null +++ b/unit-tests/tests-in-progress.lisp @@ -0,0 +1,51 @@ +(in-package cl-graph) + +(defun foo () + (let ((graph (cl-graph:make-graph 'cl-graph:graph-container + :vertex-test #'equal))) + (cl-graph:add-vertex graph "a") + (cl-graph:add-vertex graph "b") + (cl-graph:add-vertex graph "c") + (cl-graph:add-vertex graph "d") + (cl-graph:add-vertex graph "e") + (cl-graph:add-edge-between-vertexes graph "a" "b" :edge-type :directed) + (cl-graph:add-edge-between-vertexes graph "b" "c" :edge-type :directed) + (cl-graph:add-edge-between-vertexes graph "c" "a" :edge-type :directed) + (cl-graph:add-edge-between-vertexes graph "d" "e" :edge-type :directed) + graph)) + +(loop for component in + (cl-graph:find-connected-components (foo)) + for index from 1 do + (format t "~&Component ~D (~d node~:p and ~d edge~:p)" + index (vertex-count component) (edge-count component)) + (iterate-edges component (lambda (edge) + (format t "~& ~a to ~a" + (source-vertex edge) + (target-vertex edge)))) + (format t "~%")) + + +(defun mk-graph () + (let ((graph (cl-graph:make-graph 'cl-graph:graph-container + :vertex-test #'equal))) + (cl-graph:add-vertex graph "a") + (cl-graph:add-vertex graph "b") + (cl-graph:add-vertex graph "c") + (cl-graph:add-vertex graph "d") + (cl-graph:add-vertex graph "e") + (cl-graph:add-edge-between-vertexes graph "a" "b" :edge-type :directed) + (cl-graph:add-edge-between-vertexes graph "b" "c" :edge-type :directed) + (cl-graph:add-edge-between-vertexes graph "c" "a" :edge-type :directed) + (cl-graph:add-edge-between-vertexes graph "d" "e" :edge-type :directed) + graph)) + +(mk-graph) + +(setf *g* (mk-graph)) + +(mapcar (lambda (v) + (list v (cl-graph:in-cycle-p *g* v))) + (cl-graph:vertexes *g*)) + +(car (cl-graph:vertexes *g*))