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> 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).