[mcclim-devel] question about layout-graph-nodes

[rpgoldman at real-time.com]

I managed to persuade format-graph-from-roots to crash, and it did so
inside the WALK local function in layout-graph-nodes.  Alas, this
isn't too easy to debug, even with my beloved Allegro, because of all
of the closures....  But I was wondering about the following piece of
layout-graph-nodes.  Perhaps I'm missing something, but there seems to
be a call to MAX whose return is never harvested.


(labels (...
         (walk (node depth)
           (unless (graph-node-minor-size node)
             (when (>= depth (length generation-sizes))
               (setf generation-sizes (adjust-array generation-sizes (ceiling (* depth 1.2)))))
             (setf (aref generation-sizes depth)
               (max (aref generation-sizes depth) (node-major-dimension node)))
             (setf (graph-node-minor-size node) 0)
**           (max (node-minor-dimension node)
                  (setf (graph-node-minor-size node)
                    (let ((sum 0) (n 0))
                      (map nil (lambda (child)
                                 (let ((x (walk child (+ depth 1))))
                                   (when x
                                     (incf sum x)
                                     (incf n))))
                           (graph-node-children node))
                      (+ sum
                         (* (max 0 (- n 1)) within-generation-separation))))))))
  (map nil #'(lambda (x) (walk x 0)) root-nodes)
  ...)

I confess that I am not a big user of MAP, nor do I fully grok what's
going on here, but it seems like the MAX on the starred line does not
serve any purpose.  That suggests to me that the code mgiht be garbled
somehow....

Any suggestions?  For reference, I attach the full defmethod at the end of
the message.

BTW, the error occurring somehwere in here is a 'NIL' is not of
expected type REAL error, which suggests to me that one of the
comparisons has gone bad...  I think it's because at generation 10,
the array gets resized, and the initial value is NIL instead of 0...

Thanks,
R

(defmethod layout-graph-nodes ((graph-output-record tree-graph-output-record)
                               stream arc-drawer arc-drawing-options)
  ;; work in progress! --GB 2002-08-14
  (declare (ignore arc-drawer arc-drawing-options))
  (with-slots (orientation center-nodes generation-separation within-generation-separation root-nodes) graph-output-record
    (check-type orientation (member :horizontal :vertical)) ;xxx move to init.-inst.
    ;; here major dimension is the dimension in which we grow the
    ;; tree.
    (let ((within-generation-separation (parse-space stream within-generation-separation
                                                     (case orientation
                                                       (:horizontal :vertical)
                                                       (:vertical :horizontal))))
          (generation-separation (parse-space stream generation-separation orientation)))
      (let ((generation-sizes (make-array 10 :adjustable t :initial-element 0)))
        (labels ((node-major-dimension (node)
                   (if (eq orientation :vertical)
                       (bounding-rectangle-height node)
                       (bounding-rectangle-width node)))
                 (node-minor-dimension (node)
                   (if (eq orientation :vertical)
                       (bounding-rectangle-width node)
                       (bounding-rectangle-height node)))
                 (walk (node depth)
                   (unless (graph-node-minor-size node)
                     (when (>= depth (length generation-sizes))
                       (setf generation-sizes (adjust-array generation-sizes (ceiling (* depth 1.2)))))
                     (setf (aref generation-sizes depth)
                           (max (aref generation-sizes depth) (node-major-dimension node)))
                     (setf (graph-node-minor-size node) 0)
                     (max (node-minor-dimension node)
                          (setf (graph-node-minor-size node)
                                (let ((sum 0) (n 0))
                                  (map nil (lambda (child)
                                             (let ((x (walk child (+ depth 1))))
                                               (when x
                                                 (incf sum x)
                                                 (incf n))))
                                       (graph-node-children node))
                                  (+ sum
                                     (* (max 0 (- n 1)) within-generation-separation))))))))
          (map nil #'(lambda (x) (walk x 0)) root-nodes)
          (let ((hash (make-hash-table :test #'eq)))
            (labels ((foo (node majors u0 v0)
                       (cond ((gethash node hash)
                              v0)
                             (t
                              (setf (gethash node hash) t)
                              (let ((d (- (node-minor-dimension node)
                                          (graph-node-minor-size node))))
                                (let ((v (+ v0 (/ (min 0 d) -2))))
                                  (setf (output-record-position node)
                                        (if (eq orientation :vertical)
                                            (transform-position (medium-transformation stream) v u0)
                                            (transform-position (medium-transformation stream) u0 v)))
                                  (add-output-record node graph-output-record))
                                ;;
                                (let ((u (+ u0 (car majors)))
                                      (v (+ v0 (max 0 (/ d 2))))
                                      (firstp t))
                                  (map nil (lambda (q)
                                             (unless (gethash q hash)
                                               (if firstp
                                                   (setf firstp nil)
                                                   (incf v within-generation-separation))
                                               (setf v (foo q (cdr majors)
                                                            u v))))
                                           (graph-node-children node)))
                                ;;
                                (+ v0 (max (node-minor-dimension node)
                                           (graph-node-minor-size node))))))))
              ;;
              (let ((majors (mapcar (lambda (x) (+ x generation-separation))
                                    (coerce generation-sizes 'list))))
                (let ((u (+ 0 (car majors)))
                      (v 0))
                  (maplist (lambda (rest)
                             (setf v (foo (car rest) majors u v))
                             (unless (null rest)
                               (incf v within-generation-separation)))
                           (graph-root-nodes graph-output-record)))))))))))