Skip to content

Commit

Permalink
graph enhancements
Browse files Browse the repository at this point in the history
  • Loading branch information
@kaveh808
kaveh808 committed Oct 16, 2023
1 parent 233e263 commit e4f5206
Show file tree
Hide file tree
Showing 5 changed files with 102 additions and 82 deletions.
11 changes: 6 additions & 5 deletions src/graphics/opengl/opengl.lisp
View file
Original file line number Diff line number Diff line change
Expand Up @@ -378,19 +378,20 @@
(gl:vertex (p:x p) (p:y p) (p:z p)))))
(gl:end)))

(defun 3d-draw-smooth-lines (points &key (highlight? nil))
(defun 3d-draw-smooth-lines (points &key (highlight? nil) (color nil))
(with-gl-enable :line-smooth
(3d-draw-lines points :highlight? highlight?)))
(3d-draw-lines points :highlight? highlight? :color color)))

(defun 3d-draw-lines (points &key (highlight? nil))
(defun 3d-draw-lines (points &key (highlight? nil) (color nil))
(with-gl-disable :lighting
(gl-set-fg-color)
(if highlight?
(progn
(gl-set-sel-color)
(gl:line-width (* 3 (line-thickness *drawing-settings*))))
(progn
(gl-set-fg-color)
(if color
(gl:color (c-red color) (c-green color) (c-blue color))
(gl-set-fg-color))
(gl:line-width (line-thickness *drawing-settings*))))
(gl:begin :lines)
(dolist (p points)
Expand Down
2 changes: 1 addition & 1 deletion src/kernel/shape.lisp
View file
Original file line number Diff line number Diff line change
@@ -1,5 +1,5 @@
(in-package #:kons-9)
(declaim (optimize debug))

;;;; shape =====================================================================

(defclass shape (scene-item)
Expand Down
34 changes: 25 additions & 9 deletions src/plugins/flex-graph.lisp
View file
Original file line number Diff line number Diff line change
Expand Up @@ -4,6 +4,7 @@

(defclass-kons-9 flex-graph (graph animator)
((num-edge-springs 0)
(num-group-springs 0)
(node-spring-probability 1.0)
(poly-strand nil)
(flex-animator nil)))
Expand Down Expand Up @@ -34,13 +35,15 @@
;; set spring attrs
;; (print (list (num-edge-springs graph) (length (springs anim))))
(do-array (i spring (springs anim))
(if (< i (num-edge-springs graph))
(progn ;attraction spring
(setf (rest-length spring) link-spring-length)
(setf (stiffness spring) link-spring-stiffness))
(progn ;repulsion spring
(setf (rest-length spring) spacing-spring-length)
(setf (stiffness spring) spacing-spring-stiffness))))
(cond ((< i (num-edge-springs graph)) ;attraction spring
(setf (rest-length spring) link-spring-length)
(setf (stiffness spring) link-spring-stiffness))
((< i (num-group-springs graph)) ;attraction spring
(setf (rest-length spring) link-spring-length)
(setf (stiffness spring) link-spring-stiffness))
(t ;repulsion spring
(setf (rest-length spring) spacing-spring-length)
(setf (stiffness spring) spacing-spring-stiffness))))
(set-flex-vertex-attr anim 'damping 0.5)
(set-flex-vertex-attr anim 'time-step 0.2)
))
Expand All @@ -67,17 +70,30 @@
(let* ((poly (make-instance 'poly-strand)))
;; build poly-strand points
(setf (points poly) (map 'vector #'node-location (graph-nodes graph)))
;; build component dependency springs
;; build node edge springs (links)
(do-array (i n1 (graph-nodes graph))
(do-array (j n2 (graph-edges n1))
(append-strand poly (graph-index n1) (graph-index n2))))
;; store number of dependencies (i.e. dependency link springs)
;; store counter of edge springs
(setf (num-edge-springs graph) (length (strands poly)))
;; build node group springs
(do-array (i n1 (graph-nodes graph))
(do-array (j n2 (graph-nodes graph))
(when (and (> j i)
(group-value n1)
(group-value n2)
(= (group-value n1) (group-value n2))) ;nodes in same group
;; (< (random 1.0) (node-spring-probability graph))) ;only for some pairs
(append-strand poly (graph-index n1) (graph-index n2)))))
;; store counter of group springs
(setf (num-group-springs graph) (length (strands poly)))
;; build inter-node springs for x% of cases
(if (or (eq :layered (layout-style graph)) (eq :tree (layout-style graph)))
(do-array (i n1 (graph-nodes graph))
(do-array (j n2 (graph-nodes graph))
(when (and (> j i)
(layer-value n1)
(layer-value n2)
(= (layer-value n1) (layer-value n2)) ;nodes in same layer only
(< (random 1.0) (node-spring-probability graph))) ;only for some pairs
(append-strand poly (graph-index n1) (graph-index n2)))))
Expand Down
87 changes: 28 additions & 59 deletions src/plugins/graph.lisp
View file
Original file line number Diff line number Diff line change
Expand Up @@ -9,7 +9,8 @@
(geometry (rotate-to (make-circle-polyhedron 1.0 16) (p! -90 0 0)))
(color (c! 1 1 1))
(graph-edges (make-array 0 :adjustable t :fill-pointer t)) ;graph-nodes this node has links to
(layer-value 0)
(layer-value nil)
(group-value nil)
))

(defmethod (setf color) :after (col (node graph-node))
Expand Down Expand Up @@ -44,8 +45,12 @@
;; graph nodes stored in group's children slot for rendering
(graph-nodes (make-array 0 :adjustable t :fill-pointer t))
(show-names? nil)
(show-links? t)
(show-edges? t)
(layout-style :2d)
;; for displaying additional edges
(show-secondary-edges? nil)
(secondary-edges-color (c! 1 0 0))
(secondary-edges (make-array 0 :adjustable t :fill-pointer t))
;; interactor (optional)
(interactor nil)))

Expand All @@ -58,8 +63,8 @@
(defmethod draw ((graph graph))
;; draw children/components
(call-next-method)
;; draw links
(when (show-links? graph)
;; draw links/edges
(when (show-edges? graph)
(let ((lines '()))
(do-array (i n1 (graph-nodes graph))
(when (is-visible? n1)
Expand All @@ -69,11 +74,18 @@
(push (node-location n1) lines)))))
(if (or (eq :layered (layout-style graph)) (eq :tree (layout-style graph)))
(3d-draw-smooth-lines lines)
(3d-draw-tapered-lines lines 1.0 0.1 2)))))
(3d-draw-tapered-lines lines 1.0 0.1 2))))
;; draw secondary edges
(when (show-secondary-edges? graph)
(let ((lines '()))
(do-array (i e (secondary-edges graph))
(push (node-location (aref e 0)) lines)
(push (node-location (aref e 1)) lines))
(3d-draw-smooth-lines lines :color (secondary-edges-color graph)))))

(defun standard-json-graph-node-fn (node-class
nodes-attr node-ref-attr node-name-attr
node-x-attr node-y-attr node-layer-attr)
node-x-attr node-y-attr node-layer-attr node-group-attr)
(lambda (g)
(do-array (i node (gethash nodes-attr (hash-data g)))
;; add nodes to graph
Expand All @@ -82,7 +94,10 @@
:graph-ref (gethash node-ref-attr node)
:layer-value (if node-layer-attr
(read-from-string (gethash node-layer-attr node))
0)
nil)
:group-value (if node-group-attr
(read-from-string (gethash node-group-attr node))
nil)
:name (gethash node-name-attr node)
:show-name? (show-names? g))))
;; put graph on XZ plane
Expand All @@ -109,78 +124,32 @@
(vector-push-extend n (graph-edges node1)))))))))

(defun make-json-graph (filename &key (graph-class 'graph) (node-class 'graph-node)
(show-names? nil) (show-links? t)
(show-names? nil) (show-edges? t)
nodes-attr node-ref-attr node-name-attr
node-x-attr node-y-attr node-layer-attr
node-x-attr node-y-attr node-layer-attr node-group-attr
edges-attr edge-from-attr edge-to-attr
(edge-to-is-array nil))
(let ((graph (make-instance graph-class
:hash-data (load-json filename)
:show-links? show-links?
:show-edges? show-edges?
:show-names? show-names?)))
(build-graph-from-json graph
:node-fn (standard-json-graph-node-fn node-class
nodes-attr node-ref-attr node-name-attr
node-x-attr node-y-attr node-layer-attr)
node-x-attr node-y-attr node-layer-attr node-group-attr)
:edge-fn (standard-json-graph-edge-fn edges-attr edge-from-attr edge-to-attr edge-to-is-array))
(set-graph-attributes graph)
graph))

(defun make-json-graph-SAV (filename &key (graph-class 'graph) (node-class 'graph-node)
(show-names? nil) (show-links? t)
nodes-attr node-ref-attr node-name-attr
node-x-attr node-y-attr node-layer-attr
edges-attr edge-from-attr edge-to-attr
(edge-to-is-array nil))
(let ((graph (make-instance graph-class
:hash-data (load-json filename)
:show-links? show-links?
:show-names? show-names?)))
(build-graph-from-json graph
:node-fn (lambda (g) ;build nodes
(do-array (i node (gethash nodes-attr (hash-data g)))
;; add nodes to graph
(let ((gnode (make-instance node-class
:hash-data node
:graph-ref (gethash node-ref-attr node)
:layer-value (if node-layer-attr
(read-from-string (gethash node-layer-attr node))
0)
:name (gethash node-name-attr node)
:show-name? (show-names? g))))
;; put graph on XZ plane
(when (and node-x-attr node-y-attr)
(translate-to gnode (p! (gethash node-x-attr node) 0.0 (gethash node-y-attr node))))
(vector-push-extend gnode (graph-nodes g)))))
:edge-fn (lambda (g) ;set node edges/links
(if (not edge-to-is-array)
;; single link
(do-array (i edge (gethash edges-attr (hash-data g)))
(let ((node1 (find-node g (gethash edge-from-attr edge)))
(node2 (find-node g (gethash edge-to-attr edge))))
(when (and node1 node2)
(vector-push-extend node2 (graph-edges node1)))))
;; array of links
(do-array (i edge (gethash edges-attr (hash-data g)))
(let ((node1 (find-node g (gethash edge-from-attr edge)))
(nodes-to (remove-if #'null (map 'vector (lambda (ref) (find-node g ref))
(gethash edge-to-attr edge)))))
(when (and node1 (> (length nodes-to) 0))
(do-array (j n nodes-to)
(vector-push-extend n (graph-edges node1)))))))))
(set-graph-attributes graph)
graph))


(defun make-json-graph-fns (filename &key (graph-class 'graph)
(show-names? nil) (show-links? t)
(show-names? nil) (show-edges? t)
(node-fn nil) (edge-fn nil) (layer-fn nil))
(when (not (and node-fn edge-fn))
(error "Missing NODE-FN and/or EDGE-FN arguments"))
(let ((graph (make-instance graph-class
:hash-data (load-json filename)
:show-names? show-names?
:show-links? show-links?)))
:show-edges? show-edges?)))
(build-graph-from-json graph
:node-fn node-fn
:edge-fn edge-fn
Expand Down
50 changes: 42 additions & 8 deletions test/demo-graph.lisp
View file
Original file line number Diff line number Diff line change
Expand Up @@ -13,7 +13,6 @@
:node-name-attr "name"
:node-x-attr "x"
:node-y-attr "y"
:node-layer-attr "group"
:edges-attr "edges"
:edge-from-attr "_from"
:edge-to-attr "_to")))
Expand All @@ -34,7 +33,6 @@
:node-name-attr "name"
:node-x-attr "x"
:node-y-attr "y"
:node-layer-attr "group"
:edges-attr "edges"
:edge-from-attr "_from"
:edge-to-attr "_to")))
Expand Down Expand Up @@ -71,7 +69,6 @@
(let ((gnode (make-instance 'graph-node
:hash-data node
:graph-ref (gethash "_id" node)
:layer-value (read-from-string (gethash "group" node))
:name (gethash "name" node)
:show-name? t)))
;; put graph on XZ plane
Expand Down Expand Up @@ -101,7 +98,6 @@
:node-name-attr "name"
:node-x-attr "x"
:node-y-attr "y"
:node-layer-attr "group"
:edges-attr "edges"
:edge-from-attr "_from"
:edge-to-attr "_to")))
Expand Down Expand Up @@ -143,7 +139,7 @@
(add-shape *scene* graph)
(setf (interactor *scene*) (interactor graph))))

;;; Demo 05 -- graph with single link data =====================================
;;; Demo 05 -- 2d flex-graph with single link data =============================

(with-clear-scene
(let ((graph (make-json-graph *demo-graph-filename*
Expand All @@ -152,9 +148,47 @@
:nodes-attr "nodes"
:node-ref-attr "_id"
:node-name-attr "name"
:node-x-attr "x"
:node-y-attr "y"
:node-layer-attr "group"
:node-group-attr "group"
:edges-attr "edges"
:edge-from-attr "_from"
:edge-to-attr "_to")))
(setup-graph-dynamics graph :layout-style :2d
:link-spring-length 10.0
:link-spring-stiffness 0.25
:spacing-spring-length 40.0
:spacing-spring-stiffness 0.01)
(apply-nodes graph (lambda (n) (scale-to n 5.0)))
;; color nodes by layer value
(apply-nodes graph
(lambda (n)
(set-point-colors (geometry n)
(case (read-from-string (get-json-attr n "group"))
(1 (c! 1 0 0))
(2 (c! 0 .8 0))
(3 (c! .3 .3 1))
(4 (c! 1 1 0))
(5 (c! 0 1 1))
(6 (c! 1 0 1))
(7 (c! 1 .5 0))
(8 (c! .5 1 .5))
(9 (c! .5 .5 .5))
(10 (c! .5 .5 0))
(otherwise (c! 1 1 1))))))
(add-shape *scene* graph)
(add-motion *scene* graph)
(setf (end-frame *scene*) 10000)
(update-scene *scene* 1000)))

;;; Demo 06 -- 3d flex-graph with single link data =============================

(with-clear-scene
(let ((graph (make-json-graph *demo-graph-filename*
:graph-class 'flex-graph
:show-names? t
:nodes-attr "nodes"
:node-ref-attr "_id"
:node-name-attr "name"
:node-group-attr "group"
:edges-attr "edges"
:edge-from-attr "_from"
:edge-to-attr "_to")))
Expand Down

0 comments on commit e4f5206

Please sign in to comment.