;; -*- mode: scheme -*- ;; ;; basic layout attmepts ;; ;; copyright (C) 2004 FoAM vzw ;; You are granted the rights to distribute and use this software ;; under the terms of the GNU Lesser General Public License as ;; published by the Free Software Foundation; either version 2.1 of ;; the License, or (at your option) any later version. The LGPL is ;; distributed with this code (see: LICENCE) and available online ;; at http://www.gnu.org/copyleft/lesser.html ;; authors ;; - nik gaffney ;; requirements ;; - ;; commentary ;; - wobble -> heirarchical rectangular spread ;; - shuffle -> randomise positions ;; - relax -> pseudo stabilisation using edge lengths ;; - shadowpi -> variation on circular parent-centric splay ;; changes ;; 2006-09-11 ;; - scraped into coherence from various sources ;; 2006-11-12 ;; - mottled shadows, multiple beginings (module layout mzscheme (require (lib "misc.ss" "swindle") (lib "class.ss") (lib "list.ss") (lib "math.ss") "scritch.scm" "snipets.scm" "graph.scm") (provide wobble-tree shuffle-tree relax-tree shadowpi-tree) ;;;;;; ; ; ;; ;;;; ;; ; ;; ;; ;; traverse from a node, and s p r e a d ;; ;;;;; ; ; ; ; ; (define (wobble-tree node pb) (let* ([parents (reverse (send node get-parents))] [n (length parents)] [x1 50] [y1 30]) (debug 2 "~% node.~a " node) (debug 2 "~% parents.~a " parents) (send pb move node x1 y1) (do ((i 0 (+ i 1))) ((= i n)) (debug 2 ".~a." i) (let* ([parent (list-ref parents i)] [nx (box 0)] [ny (box 0)] [loco (send pb get-snip-location node nx ny)]) (debug 2 ".[~a,~a]." (unbox nx) (unbox ny)) (send pb move-to parent (+ (* i x1) (/ (unbox nx) n)) (+ y1 (unbox ny))) (wobble-tree parent pb))))) ;;;;;;;;;;; ;; ; ;; ; ;; ;; autoslonk ;; ;;;;; ; ;; ;; ; ; (define (shuffle-tree node pb x y) (let ([parents (send node get-parents)] [x1 200] [y1 200]) (debug 2 "shuffling: ~a ~%" parents) (send pb move node (random x1) (random y1)) (cond ((= 1 (length parents)) (shuffle-tree (car parents) pb (random x1) (random y1))) ((< 1 (length parents)) (for-each (lambda (parent) (shuffle-tree parent pb (random x1) (random y1))) parents))))) ;;;;; ;;;;;; ;; ; ;; ; ;; ;; energy stabilisation ;; - single itteration only, call as reqd. ;; - local epsilon & delta only ;; ;;;;; ; ;;; ; ; (define (relax-tree node pb x y) (let ([parents (send node get-parents)]) (debug 2 "minimising: ~a ~%" node) ;; move given node (send pb move node x y) ;; stabilise distance between siblings (if (not (empty? parents)) (for-each (lambda (parent) (let ([siblings (send parent get-children)]) (if(< 1 (length siblings)) (send pb move node (shuffle-x node (random-ref siblings)) (shuffle-y node (random-ref siblings)))))) parents)) ;; stabilise distance betwen node and parents (cond ((= 1 (length parents)) (debug 1 "distance between ~a and ~a is ~a~%" node (car parents) (distance node (car parents))) (let ([parent (car parents)]) (relax-tree parent pb (shuffle-x node parent) (shuffle-y node parent)))) ((< 1 (length parents)) (for-each (lambda (parent) (debug 1 "distance between ~a and ~a is ~a~%" node parent (distance node parent)) (relax-tree parent pb (shuffle-x node parent) (shuffle-y node parent))) parents))))) (define (random-ref l) (list-ref l (random (length l)))) (define (shuffle-x n1 n2) (let ([x1 (snip-x n1)] [x2 (snip-x n2)] [epsilon 100] [d 10]) (if (> epsilon (distance n1 n2)) (if (= x2 (max x1 x2)) ;; move outward (random d) (-ve (random d))) (if (= x2 (max x1 x2)) ;; move inward (-ve (random d)) (random d))))) (define (shuffle-y n1 n2) (let ([y1 (snip-y n1)] [y2 (snip-y n2)] [epsilon 100] [d 10]) (if (> epsilon (distance n1 n2)) (if (= y2 (max y1 y2)) ;; move outward (random d) (-ve (random d))) (if (= y2 (max y1 y2)) ;; move inward (-ve (random d)) (random d))))) (define (distance n1 n2) (let ([x1 (snip-x n1)] [x2 (snip-x n2)] [y1 (snip-y n1)] [y2 (snip-y n2)]) (sqrt (+ (sq (abs (- x1 x2))) (sq (abs (- y1 y2))))))) (define (sq n) (* n n)) (define (-ve n) (- 0 n)) ;;;;;;;;;;; ;; ; ;; ; ;; ;; circular parent centric layout, in the shade of twopi ;; ;; ref: arxiv:cs.HC/0606007 v1 -> "A parent-centered radial layout algorithm ;; for interactive graph visualization and animation" by Andrew Pavlo, ;; Christopher Homan & Jonathan Schull ;; ;; - since each node may have any number of parents, yet only a single child, ;; thi sinterpretation of the algorithm is essentially the same, if 'children' ;; is read as 'parents' ;; ;;;;; ; ;;; ; ; (define twopi (* 2 pi)) (define (shadowpi-tree node pb x y r) (let* ([parents (reverse (send node get-parents))] [n (length parents)] [xi (snip-x node)] [yi (snip-y node)] (phi 0.85)) ;; distribute parents of given node evenly along a containment circle ;; centered on the node. (dotimes (i n) (let ((parent (list-ref parents i)) (x1 (* r (cos (* (/ 1 pi) (- (/ n 2) (+ 1 i)))))) (y1 (* r (sin (* (/ 1 pi) (- (/ n 2) (+ 1 i))))))) (send pb move-to parent (+ xi x1) (+ yi y1)) ;; draw circles around the node’s parents and evenly distribute their ;; parents along containment arcs. (shadowpi-tree parent pb (+ xi x1) (+ yi y1) (* r phi)) ;; this proceeds recursively, so that successively distant descendants of ;; the goven node are positioned on successively smaller containment arcs. )))) ) ;; end of module