Menu
▾
▴
[Maxima-commits] CVS: maxima/share/contrib/graphs spring_embedding.lisp, 1.5, 1.6 draw_graph.mac, 1.13, 1.14
|
From: Andrej V. <an...@us...> - 2008-10-30 16:22:22
|
Update of /cvsroot/maxima/maxima/share/contrib/graphs In directory 23jxhf1.ch3.sourceforge.com:/tmp/cvs-serv10275/share/contrib/graphs Modified Files: spring_embedding.lisp draw_graph.mac Log Message: Implemented spring_embedding in 3d. Index: spring_embedding.lisp =================================================================== RCS file: /cvsroot/maxima/maxima/share/contrib/graphs/spring_embedding.lisp,v retrieving revision 1.5 retrieving revision 1.6 diff -u -d -r1.5 -r1.6 --- spring_embedding.lisp 9 Mar 2008 12:30:50 -0000 1.5 +++ spring_embedding.lisp 30 Oct 2008 16:22:15 -0000 1.6 @@ -1,7 +1,7 @@ ;;; ;;; GRAPHS - graph theory package for Maxima ;;; -;;; Copyright (C) 2007 Andrej Vodopivec <and...@gm...> +;;; Copyright (C) 2007-2008 Andrej Vodopivec <and...@gm...> ;;; ;;; This program is free software; you can redistribute it and/or modify ;;; it under the terms of the GNU General Public License as published by @@ -47,13 +47,10 @@ (/ (* *optimal-distance* *optimal-distance*) d 100))) (defun distance (p1 p2) - (let ((dx (- (first p1) - (first p2))) - (dy (- (second p1) - (second p2)))) - (sqrt (+ (* dx dx) (* dy dy))))) + (let ((d (mapcar #'- p1 p2))) + (sqrt (apply #'+ (mapcar #'* d d))))) -(defun random-positions (v-list) +(defun random-positions (v-list dimension) (when *fixed-vertices* (let ((n (length *fixed-vertices*))) (dotimes (i (length *fixed-vertices*)) @@ -65,18 +62,21 @@ (dolist (v v-list) (unless (member v *fixed-vertices*) (let* ((x (- *frame-width* (random (* 2 *frame-width*)))) - (y (- *frame-width* (random (* 2 *frame-width*))))) + (y (- *frame-width* (random (* 2 *frame-width*)))) + (z (- *frame-width* (random (* 2 *frame-width*))))) (setf (gethash v *vertex-position*) - (list x y)))))) + (if (= dimension 3) + (list x y z) + (list x y))))))) -(defun $spring_embedding (g depth &optional fixed-vertices) +(defun $spring_embedding (g depth fixed-vertices dimension) (let ((*vertex-position* (make-hash-table)) (vertex-displacement (make-hash-table)) (*fixed-vertices* (cdr fixed-vertices)) (*optimal-distance* (/ (* 2 *frame-width*) (sqrt ($graph_size g))))) - (random-positions (vertices g)) + (random-positions (vertices g) dimension) (let* ((step (/ *frame-width* 5)) (d-step (/ step (1+ depth)))) @@ -84,10 +84,10 @@ (setq step (- step d-step)) (dolist (v (vertices g)) - (setf (gethash v vertex-displacement) (list 0 0))) + (setf (gethash v vertex-displacement) (if (= dimension 2) (list 0 0) (list 0 0 0)))) ;; calculate repulsive forces - (when (null (cdr fixed-vertices)) + (when (null *fixed-vertices*) (let ((v-vrt (vertices g))) (loop while v-vrt do (let* ((v (car v-vrt)) @@ -96,67 +96,58 @@ (loop while u-vrt do (let* ((u (car u-vrt)) (u-pos (gethash u *vertex-position*)) - (delta (list (- (first v-pos) (first u-pos)) - (- (second v-pos) (second u-pos)))) + (delta (mapcar #'- v-pos u-pos)) (delta-abs (distance v-pos u-pos)) (force (repulsive-force delta-abs)) - (x (* (/ (first delta) (max delta-abs *epsilon-distance*)) - force)) - (y (* (/ (second delta) (max delta-abs *epsilon-distance*)) - force)) + (vu-disp (mapcar + #'(lambda (u) (* (/ u (max delta-abs *epsilon-distance*)) force)) + delta)) (v-disp (gethash v vertex-displacement)) (u-disp (gethash u vertex-displacement))) (setf (gethash v vertex-displacement) - (list (+ (first v-disp) x) - (+ (second v-disp) y)) + (mapcar #'+ v-disp vu-disp) (gethash u vertex-displacement) - (list (- (first u-disp) x) - (- (second u-disp) y))) + (mapcar #'- u-disp vu-disp)) (setq u-vrt (cdr u-vrt))))) (setq v-vrt (cdr v-vrt))))) ;; calculate attractive forces (dolist (e (edges g)) - (let* ((v (first e)) (u (second e)) + (let* ((v (first e)) + (u (second e)) (v-pos (gethash v *vertex-position*)) (u-pos (gethash u *vertex-position*)) - (delta (list (- (first v-pos) (first u-pos)) - (- (second v-pos) (second u-pos)))) + (delta (mapcar #'- v-pos u-pos)) (delta-abs (distance v-pos u-pos)) (v-disp (gethash v vertex-displacement)) (u-disp (gethash u vertex-displacement)) (force (attractive-force delta-abs)) - (x (* (/ (first delta) (max delta-abs *epsilon-distance*)) - force)) - (y (* (/ (second delta) (max delta-abs *epsilon-distance*)) - force))) + (vu-disp (mapcar + #'(lambda (u) + (* (/ u (max delta-abs *epsilon-distance*)) force)) + delta))) (setf (gethash v vertex-displacement) - (list (- (first v-disp) x) - (- (second v-disp) y))) - (setf (gethash u vertex-displacement) - (list (+ (first u-disp) x) - (+ (second u-disp) y))))) + (mapcar #'- v-disp vu-disp) + (gethash u vertex-displacement) + (mapcar #'+ u-disp vu-disp)))) ;; Limit the displacement (dolist (v (vertices g)) (unless (member v *fixed-vertices*) (let* ((v-disp (gethash v vertex-displacement)) (v-disp (mapcar #'(lambda (u) (/ u 2)) v-disp)) - (v-disp-abs (distance (list 0 0) v-disp)) + (v-disp-abs (sqrt (apply #'+ (mapcar #'* v-disp v-disp)))) (v-pos (gethash v *vertex-position*))) (if (> v-disp-abs step) - (setq v-pos (list (+ (first v-pos) - (* (/ (first v-disp) v-disp-abs) step)) - (+ (second v-pos) - (* (/ (second v-disp) v-disp-abs) step)))) - (setq v-pos (list (+ (first v-pos) (first v-disp)) - (+ (second v-pos) (second v-disp))))) - (setq v-pos (list (min *frame-width* (max (first v-pos) - (- *frame-width*))) - (min *frame-width* (max (second v-pos) - (- *frame-width*))))) - (setf (gethash v *vertex-position*) v-pos)))) )) - + (setq v-pos (mapcar #'(lambda (u v) + (+ u (* (/ v v-disp-abs) step))) + v-pos v-disp)) + (setq v-pos (mapcar #'+ v-pos v-disp))) + (setq v-pos (mapcar #'(lambda (u) (min *frame-width* (max u (- *frame-width*)))) + v-pos)) + (setf (gethash v *vertex-position*) v-pos)))) + )) + (let (result) (maphash #'(lambda (vrt pos) (setq result Index: draw_graph.mac =================================================================== RCS file: /cvsroot/maxima/maxima/share/contrib/graphs/draw_graph.mac,v retrieving revision 1.13 retrieving revision 1.14 diff -u -d -r1.13 -r1.14 --- draw_graph.mac 21 Oct 2008 10:48:59 -0000 1.13 +++ draw_graph.mac 30 Oct 2008 16:22:15 -0000 1.14 @@ -114,7 +114,8 @@ edge_partition : [], edge_coloring : [], edge_types : [], - edge_widths : [] + edge_widths : [], + dimension : 2 ], if not(is_graph(G)) and not(is_digraph(G)) then @@ -142,7 +143,7 @@ if member(program, ['neato, 'dot, 'twopi, 'fdp, 'circo]) then v_pos : graphviz_positions(G, program) else if program = 'spring_embedding then - v_pos : spring_embedding(G, spring_embedding_depth, fixed_vertices) + v_pos : spring_embedding(G, spring_embedding_depth, fixed_vertices, dimension) else if program = 'planar_embedding then block( [embedding : planar_embedding(G), c], if embedding=false then @@ -151,24 +152,26 @@ c : embedding[1], for i:2 thru length(embedding) do ( if length(embedding[i])>length(c) then c:embedding[i]), - v_pos : spring_embedding(G, spring_embedding_depth, c))) + v_pos : spring_embedding(G, spring_embedding_depth, c, 2))) else v_pos : circular_positions(G), - set_positions(v_pos, G)), + set_positions(v_pos, G)) + else dimension : length(second(first(v_pos))), /* Normalize positions into [-1,1]x[-1,1] */ - if length(v_pos)>1 then ( - x_max : lmax(map(lambda([u], part(u, 2, 1)), v_pos)), - x_min : lmin(map(lambda([u], part(u, 2, 1)), v_pos)), - y_max : lmax(map(lambda([u], part(u, 2, 2)), v_pos)), - y_min : lmin(map(lambda([u], part(u, 2, 2)), v_pos)), + if length(v_pos)>1 then block( + [xyz_min, xyz_max, xyz], + xyz : args(transpose(apply(matrix, map(second, v_pos)))), + xyz_max : map(lmax, xyz), + xyz_min : map(lmin, xyz), v_pos : map( lambda([u], - [part(u, 1), - [2*(part(u, 2, 1) - (x_min+x_max)/2)/(x_max-x_min), - 2*(part(u, 2, 2) - (y_min+y_max)/2)/(y_max-y_min)]]), - v_pos)), - + [u[1], + map(lambda([xx, xx_max, xx_min], + 2*(xx - (xx_min, xx_max)/2) / (xx_max - xx_min)), + u[2], xyz_max, xyz_min)]), + v_pos)), + /* Setup edges */ if show_edges#[] then ( for e in edges(G) do @@ -264,7 +267,10 @@ edge_weights : [apply(label, edge_weights)], /* Check if we are in wxmaxima */ - if terminal='wxmaxima then command : wxdraw2d else command : draw2d, + if terminal='wxmaxima then ( + if dimension=3 then command : wxdraw3d else command : wxdraw2d) + else ( + if dimension=3 then command : draw3d else command : draw2d), if terminal#'wxmaxima then gp_options : ['terminal = terminal, 'file_name = file_name] |