From www@dejanews.com Sun Apr 25 13:37:22 1999
Message-ID: <7fvuir$p7j$1@nnrp1.dejanews.com>
Subject: Re: Dotted Pairs , and searching for them in trees
Date: Sun, 25 Apr 1999 20:39:55 GMT
Reply-To: oleg@pobox.com
Keywords: tree, improper list, pair, container, tree traversal, Scheme
Newsgroups: comp.lang.scheme
Organization: Deja News - The Leader in Internet Discussion
References: <371BF15D.B3F4DCBD@bigfoot.com> <371D84E7.A7EEA495@bigfoot.com> <qotu2u9ul2j.fsf@tuuri.ling.helsinki.fi>
Summary: Counting special leaves in a pair/vector tree
X-Article-Creation-Date: Sun Apr 25 20:39:55 1999 GMT
Content-Length: 3088
Status: OR


> Write a function that counts dotted pairs of the form (a . b), e.g.
>    (count-dots '(a (b . c) (d . e)))  =  2

It appears that this assignment can be given a well-defined
formulation. The problem may be posed as: given a tree of scheme
objects, count all the leaves that are other than '().

Let's define an "improper pair" -- a pair whose cdr is neither a pair
nor '(). Then we may ask how many improper pairs are reachable from a
given pair. The following function answers this question:

(define (count-dots-v1 obj)
        ; Return the old-count plus the number of the improper
        ; pairs reachable from obj
  (define (count-improper-pairs obj old-count)
    (if (not (pair? obj)) old-count
        (let ((car-count (count-improper-pairs (car obj) old-count)))
          (cond
           ((pair? (cdr obj))
                (count-improper-pairs (cdr obj) car-count))
           ((null? (cdr obj)) car-count)
           (else (+ 1 car-count))))))
  (count-improper-pairs obj 0))

(count-dots-v1 '())             ==> 0
(count-dots-v1 '(1 2 3))        ==> 0
(count-dots-v1 '(1 2 . 3))      ==> 1
(count-dots-v1 '(a (b . c) (d . e)))    ==> 2
(count-dots-v1 '(((1) (2 . 3) . 4) ((3) (4) (5)) . 6)) ==> 3

We haven't done a thorough job however. The initial well-defined
formulation talked about trees of scheme objects. (Non-trivial) trees
arise whenever there is a container into which we can place at least
two objects (including other containers). Scheme has two such generic
containers - pairs and vectors. Function count-dots-v1 has to be
generalized to traverse vectors as well, in its search for improper
pairs.

(define (count-dots obj)
        ; Each of these function return the old-count incremented
        ; by the number of improper pairs they found
  (define (traverse-pair a-pair old-count)
    (let ((car-count (traverse-tree (car a-pair) old-count)))
      (cond
       ((pair? (cdr a-pair)) (traverse-pair (cdr a-pair) car-count))
       ((null? (cdr a-pair)) car-count)
       (else (traverse-tree (cdr a-pair) (+ 1 car-count))))))

  (define (traverse-tree obj old-count)
    (cond
     ((pair? obj) (traverse-pair obj old-count))
     ((vector? obj) (traverse-vector obj old-count))
     (else old-count)))

  (define (traverse-vector v old-count)
    (let loop ((i 0) (count old-count))
      (if (>= i (vector-length v)) count
          (loop (+ 1 i) (traverse-tree (vector-ref v i) count)))))

  (traverse-tree obj 0))

(define (test obj)
  (write obj) (display ": #dots = ") (display (count-dots obj)) (newline))

> (test '(a (b . c) (d . e)))
(a (b . c) (d . e)): #dots = 2
> (test (vector 1 2 3))
#(1 2 3): #dots = 0
> (test (vector 1 2 (cons 5 6) 7))
#(1 2 (5 . 6) 7): #dots = 1
> (test (vector (cons "." #\.)))
#(("." . #\.)): #dots = 1
> (test '(1 2 (3 . 4) . #("1.b" (1 . b) 4 #(1 2 () (1 . (2 . 3))))))
(1 2 (3 . 4) . #("1.b" (1 . b) 4 #(1 2 () (1 2 . 3)))): #dots = 4

Note, traverse-tree effectively counts the number of "singular dots"
in a written representation of an obj (sans dots as character
constants and dots in character strings).