Visualize arbitrary tree in Racket using tree-layout

Question

How to visualise arbitrary tree?

for example: (define T1 '(and (or x1 x2)(or x3 x4 x5)))

or one generated with:

(define functions '(not if and or))
(define terminals '(A0 A1 A2 D0 D1))
(define functions&terminals (append terminals functions ))

(define (pick-one list)
  (list-ref list (random (length list))))

(define arities '((if . 3)(and . 2)(or . 2)(not . 1)))

(define (terminal? symbol)
  (find (lambda (x)(eq? x symbol)) terminals))

(define (function? symbol)
  (find (lambda (x)(eq? x symbol)) functions))

(define (arity non-terminal)
  (let ((arity (find (lambda (x)(eq? non-terminal (car x))) arities)))
    (if arity
        (cdr arity)
        0)))

(define (numbers n)
  (if (= n 0) 
      '()
      (cons n (numbers (- n 1)))))

(define (gen-tree) 
  (let ((node (pick-one functions&terminals))) 
    (if (terminal? node) 
        node 
        (cons node (map (lambda (x) (gen-tree)) (numbers (arity 
node)))))))

> (gen-tree)
'(or (if A1 (and A1 (not (if D1 (and A0 A0) (or A0 A0)))) (or A0 A0)) D0)

Racket seems to have: https://docs.racket-lang.org/pict/Tree_Layout.html

is it enough to visualise trees of functions with the name of the function and params in the circle?

Answer 1

You can do something like this to visualize arbitrarily sized trees:

(require pict
         pict/tree-layout)

(define (draw tree)
  (define (viz tree)
    (cond
      ((null? tree) #f)
      ((not (pair? tree))
       (tree-layout #:pict (cc-superimpose
                            (disk 30 #:color "white")
                            (text (symbol->string tree)))))
      ((not (pair? (car tree)))
       (apply tree-layout (map viz (cdr tree))
              #:pict (cc-superimpose
                      (disk 30 #:color "white")
                      (text (symbol->string (car tree))))))))
  (if (null? tree)
      #f
      (naive-layered (viz tree))))

For example, using the lists you provided:

(define t1 '(and (or x1 x2) (or x3 x4 x5)))
(define t2 '(or (if A1 (and A1 (not (if D1 (and A0 A0) (or A0 A0)))) (or A0 A0)) D0))

Answer 2

I think improvements can be made to assefamaru's answer -

• Separate list traversal from individual node rendering
• Simplify case analysis of input
  1. If the input is null (base case), return empty tree, #f
  2. Otherwise (inductive) the input is not null. If the input is a list, Create a tree-layout of op and recursively apply draw to args
  3. Otherwise (inductive) the input is not null and the input is not a list. Create a tree-layout of atom a

Numbered lines above correspond to comments below -

(require pict
         pict/tree-layout)

(define (my-node a)
  (cc-superimpose
   (disk 30 #:color "white")
   (text (symbol->string a))))

(define (draw atom->pict a)
  (cond ((null? a) #f)                                 ;; 1
        ((list? a) (match a                            ;; 2
                     ((cons op args)
                      (apply tree-layout
                             #:pict (atom->pict op)
                             (map (curry draw atom->pict) args)))
                     (_ #f)))
        (else (tree-layout #:pict (atom->pict a)))))   ;; 3

(define my-tree
  '(or (if A1 (and A1 (not (if D1 (and A0 A0) (or A0 A0)))) (or A0 A0)) D0))

(naive-layered (draw my-node my-tree))