added circles-tree
This commit is contained in:
parent
81cf7afeee
commit
4e59527e08
2 changed files with 37 additions and 1 deletions
|
@ -96,7 +96,43 @@
|
|||
(shuffle-tree parent pb (random x1) (random y1)))
|
||||
parents)))))
|
||||
|
||||
;;;;;;;;;;; ;; ; ;; ;
|
||||
;;
|
||||
;; circles-tree
|
||||
;;
|
||||
;; renders nodes on concentric circles centred on the root node.
|
||||
;; each node is given a section of the circle with which to divide
|
||||
;; between its parents. same algorithm used in fastbreeder for
|
||||
;; visualising code trees generated by genetic programming
|
||||
;;
|
||||
;;;;; ; ;; ;; ; ;
|
||||
|
||||
(define (circles-tree node pb x y angle-start angle-end radius)
|
||||
; loop over all parents for this node
|
||||
(define (parent-loop parents n angle-per-parent)
|
||||
; calculate the section of angles for this node, and call circles-tree for it
|
||||
(let ([parent-start (+ angle-start (* angle-per-parent n))])
|
||||
(circles-tree (car parents) pb x y parent-start (+ parent-start angle-per-parent) (+ radius 50)))
|
||||
(if (null? (cdr parents))
|
||||
0
|
||||
(parent-loop (cdr parents) (+ n 1) angle-per-parent)))
|
||||
|
||||
; position this in the middle of the range of angles we've been given
|
||||
(send pb move node
|
||||
(* (sin (+ angle-start (/ (- angle-end angle-start) 2))) radius)
|
||||
(* (cos (+ angle-start (/ (- angle-end angle-start) 2))) radius))
|
||||
|
||||
; now call parent-loop for the parents if we have any parents
|
||||
(let ([parents (send node get-parents)])
|
||||
(cond
|
||||
((null? parents)
|
||||
0)
|
||||
(else
|
||||
(let ([angle-per-parent (/ (- angle-end angle-start) (length parents))])
|
||||
(parent-loop parents 0 angle-per-parent))))))
|
||||
|
||||
|
||||
|
||||
;;;;; ;;;;;; ;; ; ;; ;
|
||||
;;
|
||||
;; energy stabilisation
|
||||
|
|
|
@ -77,7 +77,7 @@
|
|||
(draw-parse-tree input 1 1 node pasteboard)
|
||||
(eval-tree node)
|
||||
;(set-node-text node (eval input))
|
||||
(wobble-tree n1 p))))
|
||||
(circles-tree n1 p 100 100 0 6.28 10))))
|
||||
|
||||
;; textmode input,. .
|
||||
(define input (new text-field%
|
||||
|
|
Loading…
Reference in a new issue