This Text file is old! In a 🏛️Museum, an unsorted archive of (user-)pages. (Saved from Geocities in Oct-2009. The archival story: oocities.org)
--------------------------------------- (To 🚫report any bad content: archivehelp @ gmail.com)

; treebinua.scm - binary tree upwards accumulation 
; (based on Jeremy Gibbons, Generic Downwards Accumulations)

(define (leaf? node) (null? (cdr node)))
(define (interior? node) (not (null? (cdr node))))
(define (interior-make val left right) (list val left right))
(define (interior-val node) (car node))
(define (interior-left node) (cadr node))
(define (interior-right node) (caddr node))
(define (leaf-val node) (car node))
(define (leaf-make val) (list val))

(define (root node)
   (cond
      ((leaf? node) (leaf-val node))
      ((interior? node) (interior-val node)) ))

; binary tree upwards accumulations

(define (ua-tree f g node)
   (cond
      ((leaf? node) (leaf-make (f (leaf-val node))) )
      ((interior? node) 
         (let ((t1 (ua-tree f g (interior-left node)))
               (u1 (ua-tree f g (interior-right node)))) 
                  (interior-make 
                     (g (interior-val node) (root t1) (root u1)) t1 u1) )) ))

; count the descendants of every node:

(define (sizes tree)    
   (letrec
      ((one (lambda (a) 1))
       (plus (lambda (a m n) (+ 1 (+ m n))) ) )
   (ua-tree one plus tree) ))

(define (sum tree)    
   (letrec
      ((leaf (lambda (a) a))
       (node (lambda (a m n) (+ a (+ m n))) ) )
   (ua-tree leaf node tree) ))

(define bintree1 '(1 (2 (3) (4)) (5 (6) (7))) )
(sizes bintree1)
(sum bintree1)