(intern (symbol-name '#:run-tests) :lift)
:config :generic))
:depends-on ((:version :metatilities-base "0.6.0")
- :cl-containers
- :metabang-bind
+ (:version :cl-containers "0.11.0")
))
(defmethod operation-done-p
(iterate-elements
edges
(lambda (edge)
- (bind ((v1 (element (source-vertex edge)))
- (v2 (element (target-vertex edge))))
+ (let ((v1 (element (source-vertex edge)))
+ (v2 (element (target-vertex edge))))
(add-edge-between-vertexes
graph v1 v2 :edge-class (type-of edge)
:edge-type (if (directed-edge-p edge)
(defmethod minimum-spanning-tree ((graph basic-graph)
&key
(edge-sorter #'edge-lessp-by-weight))
- (bind ((result nil))
+ (let ((result nil))
(iterate-vertexes
graph
(lambda (v)
(mst-make-set v)))
(loop for edge in (sort (edges graph) edge-sorter) do
- (bind ((v1 (source-vertex edge))
+ (let ((v1 (source-vertex edge))
(v2 (target-vertex edge)))
(unless (eq (mst-find-set v1)
(defmethod minimum-spanning-tree ((vertex-list list)
&key
(edge-sorter #'edge-lessp-by-weight))
- (bind ((result nil)
+ (let ((result nil)
(v-edges (remove-duplicates
(flatten (mapcar #'edges vertex-list)) :test #'eq)))
(mst-make-set v)))
(loop for edge in (sort v-edges edge-sorter) do
- (bind ((v1 (source-vertex edge))
- (v2 (target-vertex edge))
- (v1-set (mst-find-set v1))
- (v2-set (mst-find-set v2)))
+ (let ((v1 (source-vertex edge))
+ (v2 (target-vertex edge))
+ (v1-set (mst-find-set v1))
+ (v2-set (mst-find-set v2)))
(when (or (not v1-set)
(not v2-set))
;;; ---------------------------------------------------------------------------
#+test
-(bind ((g (make-container 'graph-container)))
+(let ((g (make-container 'graph-container)))
(add-edge-between-vertexes g :v :y :edge-type :directed)
(add-edge-between-vertexes g :u :x :edge-type :directed)
(add-edge-between-vertexes g :x :v :edge-type :directed)
(edges u)
:filter (lambda (e)
(out-edge-for-vertex-p e u))) sorter) do
- (bind ((v (other-vertex edge u)))
+ (let ((v (other-vertex edge u)))
(unless (color edge)
(setf (color edge) (color v)))
;;; ---------------------------------------------------------------------------
#+test
-(bind ((g (make-container 'graph-container)))
+(let ((g (make-container 'graph-container)))
(add-edge-between-vertexes g :v :y :edge-type :directed)
(add-edge-between-vertexes g :u :x :edge-type :directed)
(add-edge-between-vertexes g :x :v :edge-type :directed)
;;; ---------------------------------------------------------------------------
(defmethod map-over-all-combinations-of-k-vertexes ((graph basic-graph) k fn)
- (bind ((vertex-count (size graph))
+ (let* ((vertex-count (size graph))
(symbols (make-list k :initial-element vertex-count))
(vertexes (vertexes graph)))
(iterate-over-indexes
;;; ---------------------------------------------------------------------------
#+test
-(bind ((result nil)
+(let ((result nil)
(g (make-container 'graph-container)))
(add-edge-between-vertexes g :u :v :edge-type :directed)
(add-edge-between-vertexes g :u :x :edge-type :directed)
g
4
(lambda (vertex-list)
- (bind ((graph-from-vertexes (make-graph-from-vertexes vertex-list)))
+ (let ((graph-from-vertexes (make-graph-from-vertexes vertex-list)))
(when (mst-kruskal graph-from-vertexes #'identity-sorter)
(push graph-from-vertexes result)))))
result)
;;; ---------------------------------------------------------------------------
(defmethod map-over-all-combinations-of-k-edges ((graph basic-graph) k fn)
- (bind ((edge-count (edge-count graph))
+ (let* ((edge-count (edge-count graph))
(symbols (make-list k :initial-element edge-count))
(edges (edges graph)))
(print symbols)
;;; ---------------------------------------------------------------------------
(defmethod map-over-all-combinations-of-k-edges ((vertex basic-vertex) k fn)
- (bind ((edge-count (edge-count vertex))
- (symbols (make-list k :initial-element edge-count))
- (edges (edges vertex)))
- (print symbols)
+ (let* ((edge-count (edge-count vertex))
+ (symbols (make-list k :initial-element edge-count))
+ (edges (edges vertex)))
+ ;(print symbols)
(iterate-over-indexes
symbols
(lambda (edge-indexes)
&key force-new?)
(declare (ignore force-new?))
- (bind ((vertex-1 (vertex-1 edge))
+ (let ((vertex-1 (vertex-1 edge))
(vertex-2 (vertex-2 edge)))
(cond ((eq vertex-1 vertex-2)
(value-2 t)
fn
&key error-if-not-found?)
- (bind ((v1 (find-vertex graph value-1 error-if-not-found?))
+ (let ((v1 (find-vertex graph value-1 error-if-not-found?))
(v2 (find-vertex graph value-2 error-if-not-found?)))
(or (and v1 v2 (find-edge-between-vertexes-if graph v1 v2 fn))
(when error-if-not-found?
(defun generate-girvan-newman-graph (generator graph-class z-in)
(warn "This is broken!")
- (bind ((g (make-instance graph-class))
+ (let ((g (make-instance graph-class))
(group-count 4)
(group-size 32)
(edge-count 16)
(check-type from-group fixnum)
(loop
- (bind ((other-group (integer-random generator 0 (- group-count 2)))
+ (let ((other-group (integer-random generator 0 (- group-count 2)))
(other (sample-element
(item-at groups (if (= from-group other-group)
(1+ other-group)
(iterate-edges
g
(lambda (e)
- (bind ((v1 (vertex-1 e))
+ (let ((v1 (vertex-1 e))
(v2 (vertex-2 e))
(id1 (element v1))
(id2 (element v2)))
(list vertex other-kind))))
(update (kind thing)
;; handle bookkeeping for changed vertex degree
- (bind ((sampler (aref vertex-sampler kind))
+ (let ((sampler (aref vertex-sampler kind))
(node (find-node sampler thing)))
(delete-node sampler node)
(insert-item sampler thing))))
(flet ((sample-edges-for-vertex (vertex)
;(spy vertex)
(loop repeat (item-at-1 vertex-degrees vertex) do
- (bind (((edge-kind . edge) (delete-last edge-sampler)))
+ (let (((edge-kind . edge) (delete-last edge-sampler)))
(ecase edge-kind
(:source (setf (first edge) vertex))
(:target (setf (second edge) vertex)))))))
;;; ---------------------------------------------------------------------------
(defmethod initialize-instance :after ((object weighted-edge-sampler) &key)
- (bind ((generator (generator object))
+ (let ((generator (generator object))
(weighted-edge-count
(let ((result 0))
(iterate-edges (graph object) (lambda (e) (incf result (weight e))))
(defmethod generate-simple-preferential-attachment-graph
(generator graph size minimum-degree)
- (bind ((m (make-array (list (* 2 size minimum-degree)))))
+ (let ((m (make-array (list (* 2 size minimum-degree)))))
(loop for v from 0 to (1- size) do
(loop for i from 0 to (1- minimum-degree) do
- (bind ((index (* 2 (+ i (* v minimum-degree))))
+ (let ((index (* 2 (+ i (* v minimum-degree))))
(r (integer-random generator 0 index)))
(setf (item-at m index) v
(item-at m (1+ index)) (item-at m r)))))
assortativity-matrix
&key (vertex-labeler 'simple-group-id-generator)
(duplicate-edge-function :ignore))
- (bind ((kind-count (array-dimension kind-matrix 0))
+ (let ((kind-count (array-dimension kind-matrix 0))
(vertex-kinds (sample-vertexes-for-mixed-graph generator size kind-matrix))
(vertex-kind-counts (element-counts vertex-kinds :sort #'< :sort-on :values))
(edge-recorders (make-array (list kind-count)))
;; add vertexes (to ensure that we have something at which to point)
(loop for v from 0 to (1- size)
for kind in vertex-kinds do
- (bind ((edge-recorder (aref edge-recorders kind)))
+ (let ((edge-recorder (aref edge-recorders kind)))
(loop for i from 0 to (1- minimum-degree) do
- (bind ((index (* 2 (+ i (* (aref count-recorders kind) minimum-degree)))))
+ (let ((index (* 2 (+ i (* (aref count-recorders kind) minimum-degree)))))
(setf (item-at edge-recorder index)
(funcall vertex-labeler kind v)))))
(incf (aref count-recorders kind)))
(setf (aref count-recorders i) 0))
(loop for v from 0 to (1- size)
for kind in vertex-kinds do
- (bind ((edge-recorder (aref edge-recorders kind))
+ (let ((edge-recorder (aref edge-recorders kind))
(edge-sampler (aref edge-samplers kind)))
(loop for i from 0 to (1- minimum-degree) do
- (bind ((index (* 2 (+ i (* (aref count-recorders kind) minimum-degree))))
+ (let ((index (* 2 (+ i (* (aref count-recorders kind) minimum-degree))))
(other-kind (funcall edge-sampler))
(other-index (* 2 (+ i (* (min (1- (item-at vertex-kind-counts other-kind))
(aref count-recorders other-kind))
(loop for vertex across (aref edge-recorders kind)
for index = 0 then (1+ index)
when (consp vertex) do
- (bind (((other-kind other-index) vertex))
+ (let (((other-kind other-index) vertex))
#+Ignore
(when-debugging-format
generate-preferential-attachment-graph "~2D ~10D, ~A -> ~A"
(defun add-acquaintance-and-maybe-kill-something
(generator graph death-probability duplicate-edge-function)
;; add edges step
- (bind ((vertex (sample-element (graph-vertexes graph) generator))
+ (let ((vertex (sample-element (graph-vertexes graph) generator))
(neighbors (when (>= (size (vertex-edges vertex)) 2)
(sample-unique-elements
(vertex-edges vertex) generator 2))))
&key (edge-size (constantly 1)))
"Prints a summary of vertex degrees in `graph` to standard-out. Both the average degree of all vertexes and the average degree between all pairs of vertex classes \(as determined by the vertex-classifier\) will be printed. The `edge-size` parameter is passed on to `vertex-degree` to allow for weighted edges."
- (bind ((counts (node-counts graph :key vertex-classifier))
+ (let ((counts (node-counts graph :key vertex-classifier))
(kinds (collect-elements counts :transform #'first)))
(format t "~%Vertex counts: ")
(loop for (kind count) in counts do
(defun map-shortest-paths
(graph start-vertex depth fn &key (filter (constantly t)))
"Apply fn to each shortest path starting at `start-vertex` of depth `depth`. The `filter` predicate is used to remove vertexes from consideration."
- (bind ((visited (make-container 'simple-associative-container
+ (let ((visited (make-container 'simple-associative-container
:test #'equal)))
(labels ((visit (p)
(setf (item-at-1 visited p) t))
(getf (dot-attributes thing) attr))
(defmacro defpixel-inch-accessors (name attr type)
- (bind ((actual-name (form-symbol name "-IN-PIXELS")))
+ (let ((actual-name (form-symbol name "-IN-PIXELS")))
`(progn
(eval-always (export ',actual-name))
(defmethod ,actual-name ((thing ,type))
(in-package #:common-lisp-user)
(defpackage #:cl-graph
- (:use #:common-lisp #:metatilities #:cl-containers
- #:metabang.bind #+(or) #:cl-mathstats #+(or) #:moptilities)
+ (:use #:common-lisp #:metatilities #:cl-containers)
(:nicknames #:metabang.graph)
(:documentation "CL-Graph is a Common Lisp library for manipulating graphs and running graph algorithms.")
(addtest (test-test-vertex)
test-1
- (metatilities:bind ((x (float 2.1d0))
- (y (float 2.1d0))
- (g (make-container 'graph-container)))
+ (let ((x (float 2.1d0))
+ (y (float 2.1d0))
+ (g (make-container 'graph-container)))
(add-vertex g (+ x y))
(add-vertex g (+ x y))
(addtest (test-test-vertex)
test-2
- (bind ((x (float 2.1d0))
+ (let ((x (float 2.1d0))
(y (float 2.1d0))
(g (make-container 'graph-container :vertex-test #'=)))
(add-vertex g (+ x y))
projects / cl-graph.git / commitdiff