From: hWnd
Subject: HtDP, Excersise 14.1.4 (average-age)
Date: 
Message-ID: <1148935298.698506.86100@u72g2000cwu.googlegroups.com>
I can't figure out how to do excersise 14.1.4
(http://htdp.org/2003-09-26/Book/curriculum-Z-H-19.html#node_sec_14.1):

Develop the function average-age. It consumes a family tree node and
the current year. It produces the average age of all people in the
family tree.

---code---

(define-struct child (father mother name date eyes))

;; Oldest Generation
(define Carl (make-child empty empty 'Carl 2001 'green))
(define Bettina (make-child empty empty 'Bettina 2001 'green))

;; Middle Generation
(define Adam (make-child Carl Bettina 'Adam 2004 'yellow))
(define Dave (make-child Carl Bettina 'Dave 1955 'black))
(define Eva (make-child Carl Bettina 'Eva 1965 'blue))
(define Fred (make-child empty empty 'Fred 1966 'pink))

;; Youngest Generation
(define Gustav (make-child Fred Eva 'Gustav 1988 'brown))

;;Here's the template:

;;14.1.4
;; average-age : ftn number -> number
;; produces the average age of all people in the family tree
(define (average-age a-ftn now)
  (cond
    [(empty? a-ftn) 0]
    [else  (- now (child-date a-ftn))
           (average-age (child-father a-ftn) now)
           (average-age (child-father a-ftn) now)
           ...]))

(average-age Adam 2006)

---code end---

I can accomplish the task with a set of auxiliary functions
(count-persons, total-age, and average-age), but I can't invent a
single function to do this.

p.s.: Please, use only the stuff HtDP has introduced so far (chapter
14)!

From: Abdulaziz Ghuloum
Subject: Re: HtDP, Excersise 14.1.4 (average-age)
Date: 
Message-ID: <e5fndo$e1a$1@rainier.uits.indiana.edu>
hWnd wrote:
> [...]
> I can accomplish the task with a set of auxiliary functions
> (count-persons, total-age, and average-age), but I can't invent a
> single function to do this.

And what's wrong with using a set of auxilary functions?  This is
exactly the right approach: divide a big problem that you cannot
solve in one step into smaller problems that you can solve.

Aziz,,,
From: hWnd
Subject: Re: HtDP, Excersise 14.1.4 (average-age)
Date: 
Message-ID: <1148979640.241883.235340@g10g2000cwb.googlegroups.com>
The authors of the book want only one function.
From: Pascal Bourguignon
Subject: Re: HtDP, Excersise 14.1.4 (average-age)
Date: 
Message-ID: <87slmrzr83.fsf@thalassa.informatimago.com>
"hWnd" <······@smilyanov.net> writes:

> The authors of the book want only one function.

Don't be silly!

When you have a function calling another function, you can basically
substitute the other in the body of the first!  Some care should be
took about the renaming (see beta-, alpha-, eta- substitutions in any
lambda calculus introduction).


Ok, I'll be silly for you.
------------------------------------------------------------------------
(define (collect-duplicate-persons ftree collection)
  (if (empty? ftree) 
      collection
      (collect-duplicate-persons 
       (child-father ftree)
       (collect-duplicate-persons (child-mother ftree)
                                  (cons ftree collection)))))

(define (contains? element list equal?)
  (cond ((null? list) #f)
        ((equal? element (car list)) #t)
        (else (contains? element (cdr list) equal?))))

(define (delete-duplicates-i list uniques equal?)
  (cond ((null? list) 
         uniques)
        ((contains? (car list) uniques equal?)
         (delete-duplicates-i (cdr list) uniques equal?))
        (else
         (delete-duplicates-i (cdr list) (cons (car list) uniques) equal?))))

(define (delete-duplicates list equal?)
  (delete-duplicates-i list '() equal?))

(define (collect-unique-persons ftree)
  (delete-duplicates (collect-duplicate-persons ftree '()) equal?))

(define (count-persons ftree)
  (length (collect-unique-persons ftree)))

(define (reduce f l i)
  (if (null? l) 
      i
      (f (car l) (reduce f (cdr l) i))))


(define (child-age x y)
  (- y (child-date x)))

(define (average-age ftree year)
  (let ((persons (collect-unique-persons ftree)))
    (/ (reduce + (map (lambda (p) (child-age p year)) persons) 0)
       (length persons))))

------------------------------------------------------------------------
(Warning: only the last form has been tested).

Lets start with:

(define (average-age ftree year)
  (let ((persons (collect-unique-persons ftree)))
    (/ (reduce + (map (lambda (p) (child-age p year)) persons) 0)
       (length persons))))

and:

(define (child-age x y)
  (- y (child-date x)))

This defines child-age as a function: (lambda (x y) (- y (child-date x)))

So we can substitute it inside average-age:

(define (average-age ftree year)
  (let ((persons (collect-unique-persons ftree)))
    (/ (reduce + (map (lambda (p) ((lambda (x y) (- y (child-date x))) p year))
                       persons) 0)
       (length persons))))

Let's go on.


(define (reduce f l i)
  (if (null? l) 
      i
      (f (car l) (reduce f (cdr l) i))))

Note that we could have just written:
(define reduce (lambda (f l i)
                  (if (null? l) 
                      i
                      (f (car l) (reduce f (cdr l) i)))))
in the first place.

But since reduce is a recursive function, we need to transform it to
use the Z combinator:

    (lambda (f l i)
             (if (null? l) 
                i
                (f (car l) (reduce f (cdr l) i))))

We add a parameter for the function itself:

    (lambda (r f l i)
             (if (null? l) 
                i
                (f (car l) (r r f (cdr l) i))))

The Z combinator is:        (lambda (g) (g g))
We adapt it for our reduce: (lambda (g f l i) (g g f l i))
And now we can call reduce recursively without naming it:

((lambda (g f l i) (g g f l i))
 (lambda (r f l i)
              (if (null? l) 
                 i
                 (f (car l) (r r f (cdr l) i))))
 f l i)

So we get:

(define (average-age ftree year)
  (let ((persons (collect-unique-persons ftree)))
    (/ ((lambda (g f l i) (g g f l i))
         (lambda (r f l i)
                      (if (null? l) 
                         i
                         (f (car l) (r r f (cdr l) i))))
           +
           (map (lambda (p) ((lambda (x y) (- y (child-date x))) p year))
                       persons)
           0)
       (length persons))))

Now with:
(define (collect-unique-persons ftree)
  (delete-duplicates (collect-duplicate-persons ftree '()) equal?))
it's simple:

(define (average-age ftree year)
  (let ((persons (delete-duplicates
                      (collect-duplicate-persons ftree '()) equal?)))
    (/ ((lambda (g f l i) (g g f l i))
         (lambda (r f l i)
                      (if (null? l) 
                         i
                         (f (car l) (r r f (cdr l) i))))
           +
           (map (lambda (p) ((lambda (x y) (- y (child-date x))) p year))
                       persons)
           0)
       (length persons))))

Then delete-duplicates:

(define (average-age ftree year)
  (let ((persons (delete-duplicates-i 
                    (collect-duplicate-persons ftree '()) '() equal?)))
    (/ ((lambda (g f l i) (g g f l i))
         (lambda (r f l i)
                      (if (null? l) 
                         i
                         (f (car l) (r r f (cdr l) i))))
           +
           (map (lambda (p) ((lambda (x y) (- y (child-date x))) p year))
                       persons)
           0)
       (length persons))))


Now, delete-duplicates-i is also a recursive function, so same as with
reduce above:


(define (average-age ftree year)
  (let ((persons
         ((lambda (g l u e) (g g l u e))
           (lambda (d list uniques equal?)
             (cond
              ((null? list) 
               uniques)
              ((contains? (car list) uniques equal?)
               (d d (cdr list) uniques equal?))
              (else
               (d d (cdr list) (cons (car list) uniques) equal?)))) 
          (collect-duplicate-persons ftree '()) '() equal?)))
    (/ ((lambda (g f l i) (g g f l i))
         (lambda (r f l i)
                      (if (null? l) 
                         i
                         (f (car l) (r r f (cdr l) i))))
           +
           (map (lambda (p) ((lambda (x y) (- y (child-date x))) p year))
                       persons)
           0)
       (length persons))))

Same with contains?

((lambda (g x l e) (g g x l e))
 (lambda (c element list equal?)
   (cond ((null? list) #f)
         ((equal? element (car list)) #t)
         (else (c c element (cdr list) equal?))))
  x l e)


(define (average-age ftree year)
  (let ((persons
         ((lambda (g l u e) (g g l u e))
           (lambda (d list uniques equal?)
             (cond
              ((null? list) 
               uniques)
              (((lambda (g x l e) (g g x l e))
                 (lambda (c element list equal?)
                   (cond ((null? list) #f)
                         ((equal? element (car list)) #t)
                         (else (c c element (cdr list) equal?))))
                (car list) uniques equal?)
               (d d (cdr list) uniques equal?))
              (else
               (d d (cdr list) (cons (car list) uniques) equal?)))) 
          (collect-duplicate-persons ftree '()) '() equal?)))
    (/ ((lambda (g f l i) (g g f l i))
         (lambda (r f l i)
                      (if (null? l) 
                         i
                         (f (car l) (r r f (cdr l) i))))
           +
           (map (lambda (p) ((lambda (x y) (- y (child-date x))) p year))
                       persons)
           0)
       (length persons))))



And finally collect-duplicate-persons:

(define (average-age ftree year)
  (let ((persons
         ((lambda (g l u e) (g g l u e))
          (lambda (d list uniques equal?)
            (cond
             ((null? list) 
              uniques)
             (((lambda (g x l e) (g g x l e))
               (lambda (c element list equal?)
                 (cond ((null? list) #f)
                       ((equal? element (car list)) #t)
                       (else (c c element (cdr list) equal?))))
               (car list) uniques equal?)
              (d d (cdr list) uniques equal?))
             (else
              (d d (cdr list) (cons (car list) uniques) equal?)))) 
          ((lambda (cdp f c) (cdp cdp f c))
           (lambda (cdp ftree collection)
             (if (empty? ftree) 
                 collection
                 (cdp cdp
                      (child-father ftree)
                      (cdp cdp (child-mother ftree)
                           (cons ftree collection)))))
           ftree '())
          '()
          equal?)))
    (/ ((lambda (g f l i) (g g f l i))
        (lambda (r f l i)
          (if (null? l) 
              i
              (f (car l) (r r f (cdr l) i))))
        +
        (map (lambda (p) ((lambda (x y) (- y (child-date x))) p year))
             persons)
        0)
       (length persons))))

(average-age Gustav 2006) --> 29/5

Happy?  So what have we learned?  Just a boring couple of
substitutions that can be done automatically and that don't help us a
lot: now we cannot debug, test, and maintain this big blob function,
and we cannot reuse the hard work we did to implement all these nifty
utility functions such as reduce, delete-duplicates, etc.  We lost!


If you really want to learn something, you could implement these
transformations.  

-- 
__Pascal Bourguignon__                     http://www.informatimago.com/

"This statement is false."            In Lisp: (defun Q () (eq nil (Q)))
From: hWnd
Subject: Re: HtDP, Excersise 14.1.4 (average-age)
Date: 
Message-ID: <1148991736.083921.299030@j73g2000cwa.googlegroups.com>
Ok, according to you average-age and average-age1 should produce the
same result:

(define (count-persons a-ftn)
  (cond
    [(empty? a-ftn) 0]
    [else (+ 1
             (count-persons (child-father a-ftn))
             (count-persons (child-mother a-ftn)))]))

(define (total-age a-ftn now)
  (cond
    [(empty? a-ftn) 0]
    [else (+ (- now (child-date a-ftn))
             (total-age (child-father a-ftn) now)
             (total-age (child-mother a-ftn) now))]))

(define (average-age1 a-ftn now)
  (/ (total-age a-ftn now)
     (count-persons a-ftn)))

(define (average-age a-ftn now)
  (cond
    [(empty? a-ftn) 0]
    [else   (/ (+ (- now (child-date a-ftn))
                  (average-age (child-father a-ftn) now)
                  (average-age (child-mother a-ftn) now))
               3)]))

(average-age Adam 2006)    ;1.7
(average-age1 Adam 2006)   ;4
;(total-age Adam 2006)     ;12
;(count-persons Adam)      ;3
From: Pascal Bourguignon
Subject: Re: HtDP, Excersise 14.1.4 (average-age)
Date: 
Message-ID: <87fyirz6w6.fsf@thalassa.informatimago.com>
"hWnd" <······@smilyanov.net> writes:

> Ok, according to you average-age and average-age1 should produce the
> same result:

What sentence of mine made you think that?

> (define (count-persons a-ftn)
>   (cond
>     [(empty? a-ftn) 0]
>     [else (+ 1
>              (count-persons (child-father a-ftn))
>              (count-persons (child-mother a-ftn)))]))
>
> (define (total-age a-ftn now)
>   (cond
>     [(empty? a-ftn) 0]
>     [else (+ (- now (child-date a-ftn))
>              (total-age (child-father a-ftn) now)
>              (total-age (child-mother a-ftn) now))]))
>
> (define (average-age1 a-ftn now)
>   (/ (total-age a-ftn now)
>      (count-persons a-ftn)))
>
> (define (average-age a-ftn now)
>   (cond
>     [(empty? a-ftn) 0]
>     [else   (/ (+ (- now (child-date a-ftn))
>                   (average-age (child-father a-ftn) now)
>                   (average-age (child-mother a-ftn) now))
>                3)]))

Think about it!  Isn't it totally crazy?

How can you call this:
            (/ (+ (- now (child-date a-ftn))
                   (average-age (child-father a-ftn) now)
                   (average-age (child-mother a-ftn) now))
                3)
an "average"?

-- 
__Pascal Bourguignon__                     http://www.informatimago.com/

"Logiciels libres : nourris au code source sans farine animale."
From: ggem
Subject: Re: HtDP, Excersise 14.1.4 (average-age)
Date: 
Message-ID: <1149017947.853033.18950@j55g2000cwa.googlegroups.com>
Pascal Bourguignon wrote:
> Think about it!  Isn't it totally crazy?

Not really.  I mean, not _totally_ crazy.

> How can you call this:
>             (/ (+ (- now (child-date a-ftn))
>                    (average-age (child-father a-ftn) now)
>                    (average-age (child-mother a-ftn) now))
>                 3)
> an "average"?

it's a weighted average, where the weight of each node
is inversely proportional to its distance to the root.

But I agree that nobody said average-age and average-age1
should produce the same result, and exercise 14.1.4 is asking
for average-age1 (average), not average-age (weighted average).

-ggem.
From: Pascal Bourguignon
Subject: Re: HtDP, Excersise 14.1.4 (average-age)
Date: 
Message-ID: <873bes1ri7.fsf@thalassa.informatimago.com>
"hWnd" <······@smilyanov.net> writes:

> I can't figure out how to do excersise 14.1.4
> (http://htdp.org/2003-09-26/Book/curriculum-Z-H-19.html#node_sec_14.1):
>
> Develop the function average-age. It consumes a family tree node and
> the current year. It produces the average age of all people in the
> family tree.

This has been discussed recently.

http://groups.google.com/group/comp.lang.scheme/browse_thread/thread/2c6c70711e67a32c/e57f827a7ef11584?lnk=st&q=average-age+group%3Acomp.lang.lisp+author%3APascal+author%3ABourguignon&rnum=1&hl=en#e57f827a7ef11584


-- 
__Pascal Bourguignon__                     http://www.informatimago.com/
The rule for today:
Touch my tail, I shred your hand.
New rule tomorrow.
From: ggem
Subject: Re: HtDP, Excersise 14.1.4 (average-age)
Date: 
Message-ID: <1149019255.555797.135140@i40g2000cwc.googlegroups.com>
hWnd wrote:
> I can't figure out how to do excersise 14.1.4

> Develop the function average-age. It consumes a family tree node and
> the current year. It produces the average age of all people in the
> family tree.
> [ ... ]
> I can accomplish the task with a set of auxiliary functions
> (count-persons, total-age, and average-age), but I can't invent a
> single function to do this.

How about this:

(define (average-age ft now)
  (case now
    ((-1)                               ; returns (add-birthdates ft)
     (if (empty? ft)
         0
         (+ (child-date ft)
           (average-age (child-father ft) now)
           (average-age (child-mother ft) now))))
    ((-2)                               ; returns (count-persons ft)
     (if (empty? ft)
         0
         (+ 1
           (average-age (child-father ft) now)
           (average-age (child-mother ft) now))))
    (else
      (- now (/ (average-age ft -1) (average-age ft -2))))))

Not tested.  Also, it assumes now is never -1 or -2 (easy
to fix to remove that assumption)

-ggem.

p.s.  I agree this is silly.  You should be able to define a helper
function.
From: ggem
Subject: Re: HtDP, Excersise 14.1.4 (average-age)
Date: 
Message-ID: <1149020872.807711.208100@38g2000cwa.googlegroups.com>
I wrote:
> (define (average-age ft now)
>   (case now
>     ((-1) (if [ ... ] ))
>     ((-2) (if [ ... ] ))
>     (else [ ... ] )))

sorry.  I forgot you are supposed to use only COND.

(define (average-age ft now)
  (cond
    ((= now -1)
     (cond
       ((empty? ft) 0)
       (else (+ (child-date ft)
               (average-age (child-father ft) now)
               (average-age (child-mother ft) now)))))
    ((= now -2)
     (cond
       ((empty? ft) 0)
       (else (+ 1
               (average-age (child-father ft) now)
               (average-age (child-mother ft) now)))))
    (else (- now (/ (average-age ft -1) (average-age ft -2))))))

-ggem.
From: Wade Humeniuk
Subject: Re: HtDP, Excersise 14.1.4 (average-age)
Date: 
Message-ID: <1G4fg.6115$JX1.4909@edtnps82>
hWnd wrote:
> I can't figure out how to do excersise 14.1.4
> (http://htdp.org/2003-09-26/Book/curriculum-Z-H-19.html#node_sec_14.1):
> 

In CL

(defstruct child father mother name date eyes)

;; Oldest Generation
(defparameter Carl (make-child :father nil :mother nil :name 'Carl :date 2001 :eyes 'green))
(defparameter Bettina (make-child :father nil :mother nil :name 'Bettina :date 2001 :eyes 
'green))
;; Middle Generation
(defparameter Adam (make-child :father Carl :mother Bettina :name 'Adam :date 2004 :eyes 
'yellow))
(defparameter Dave (make-child :father Carl :mother Bettina :name 'Dave :date 1955 :eyes 
'black))
(defparameter Eva (make-child :father Carl :mother Bettina :name 'Eva :date 1965 :eyes 'blue))
(defparameter Fred (make-child :father nil :mother nil :name 'Fred :date 1966 :eyes 'pink))

;; Youngest Generation
(defparameter Gustav (make-child :father Fred :mother Eva :name 'Gustav :date 1988 :eyes 
'brown))

;;Here's the template:

;;14.1.4
;; average-age : ftn number -> number
;; produces the average age of all people in the family tree

(defun average-age (root-child now)
   (let ((children (list root-child))
         (queue (list root-child)))
     (loop for child = (pop queue)
           while child do
           (when (child-father child)
             (pushnew (child-father child) children)
             (push (child-father child) queue))
           (when (child-mother child)
             (pushnew (child-mother child) children)
             (push (child-mother child) queue)))
     (/ (reduce #'+ (mapcar (lambda (child) (- now (child-date child))) children))
        (length children))))

(average-age Adam 2006)

CL-USER 3 > (average-age adam 2006)
4

CL-USER 4 > (average-age carl 2006)
5
From: ggem
Subject: Re: HtDP, Excersise 14.1.4 (average-age)
Date: 
Message-ID: <1149096581.569307.129050@u72g2000cwu.googlegroups.com>
Wade Humeniuk wrote:
>
> In CL
>
> (defun average-age (root-child now)
>    (let ((children (list root-child))
>          (queue (list root-child)))
>      (loop for child = (pop queue)
>            while child do
>            (when (child-father child)
>              (pushnew (child-father child) children)
>              (push (child-father child) queue))
>            (when (child-mother child)
>              (pushnew (child-mother child) children)
>              (push (child-mother child) queue)))
>      (/ (reduce #'+ (mapcar (lambda (child) (- now (child-date child))) children))
>         (length children))))

Is this really the way people would do it in CL?

It looks like a weird mixture of imperative and functional.
If you are going to use side effects, why not go all the way?

(defun average-age (root-child now)
   (let ((count 0)
         (date-sum 0)
         (queue (list root-child)))
     (loop for child = (pop queue)
           while child do
           (when (child-father child)
             (push (child-father child) queue))
           (when (child-mother child)
             (push (child-mother child) queue))
           (set! count (+ count 1))
           (set! date-sum (+ date-sum (child-date child))))
     (- now (/ date-sum count))))

-ggem.
From: ggem
Subject: Re: HtDP, Excersise 14.1.4 (average-age)
Date: 
Message-ID: <1149096850.029799.295310@j55g2000cwa.googlegroups.com>
ggem wrote:
>            (set! count (+ count 1))
>            (set! date-sum (+ date-sum (child-date child))))

oops,  sorry for the scheme code in there.  But you get the idea.

-ggem.

p.s.  I'd think it would be easier in CL without helper
functions (like push or reduce) by using multiple values.
From: Pascal Bourguignon
Subject: Re: HtDP, Excersise 14.1.4 (average-age)
Date: 
Message-ID: <87bqtex814.fsf@thalassa.informatimago.com>
"ggem" <······@hotmail.com> writes:

> Wade Humeniuk wrote:
>>
>> In CL
>>
>> (defun average-age (root-child now)
>>    (let ((children (list root-child))
>>          (queue (list root-child)))
>>      (loop for child = (pop queue)
>>            while child do
>>            (when (child-father child)
>>              (pushnew (child-father child) children)
>>              (push (child-father child) queue))
>>            (when (child-mother child)
>>              (pushnew (child-mother child) children)
>>              (push (child-mother child) queue)))
>>      (/ (reduce #'+ (mapcar (lambda (child) (- now (child-date child))) children))
>>         (length children))))
>
> Is this really the way people would do it in CL?

I would do it rather exactly like I did it in scheme. Only more
easily, since the utility functions are already provided by
COMMON-LISP:

(defun collect-duplicate-persons (ftree collection)
  (if (emptyp ftree)
      collection
      (collect-duplicate-persons
       (child-father ftree)
       (collect-duplicate-persons (child-mother ftree)
                                  (cons ftree collection)))))

(define (collect-unique-persons ftree)
  (delete-duplicates (collect-duplicate-persons ftree '()) 
                     :test (function equalp)?))

(defun child-age (child y) (- y (child-date child)))

(defun average-age (ftree year)
  (let ((persons (collect-unique-persons ftree)))
    (/ (reduce (function +) 
               (mapcar (lambda (p) (child-age p year)) persons) 
               :initial-value 0)
       (length persons)))) 



-- 
__Pascal Bourguignon__                     http://www.informatimago.com/

CAUTION: The mass of this product contains the energy equivalent of
85 million tons of TNT per net ounce of weight.
From: Wade Humeniuk
Subject: Re: HtDP, Excersise 14.1.4 (average-age)
Date: 
Message-ID: <EYpfg.6211$JX1.1338@edtnps82>
ggem wrote:

> 
> Is this really the way people would do it in CL?
> 
> It looks like a weird mixture of imperative and functional.
> If you are going to use side effects, why not go all the way?
> 
> (defun average-age (root-child now)
>    (let ((count 0)
>          (date-sum 0)
>          (queue (list root-child)))
>      (loop for child = (pop queue)
>            while child do
>            (when (child-father child)
>              (push (child-father child) queue))
>            (when (child-mother child)
>              (push (child-mother child) queue))
>            (set! count (+ count 1))
>            (set! date-sum (+ date-sum (child-date child))))
>      (- now (/ date-sum count))))
> 
> -ggem.
> 

Well....., you missed getting duplicate entries
in the ancestral tree.  Grandma may appear twice because she
gave birth to siblings who gave birth to first cousins who married
and had a child.  So you have to take care not to include her
age twice.

Anyways, weird or not, this is just a toy program that meets the
needs of the original poster.  The interesting part in it is the
queue.

Wade
From: ggem
Subject: Re: HtDP, Excersise 14.1.4 (average-age)
Date: 
Message-ID: <1149247965.968099.247830@c74g2000cwc.googlegroups.com>
Wade Humeniuk wrote:
> [ ... ]  Grandma may appear twice because she
> gave birth to siblings who gave birth to first
> cousins who married and had a child. [ ... ]

My pure and innocent mind is incapable of even
considering an incestuos situation.  Now that
you put that thought in my mind, I must go
flagellate myself. :)

In my defense, it's called a family _tree_, not a
family _graph_.

Here is a single function that uses only what's
been covered in HtDP at that point and allows
a family graph.  Now I'm convinced they didn't
mean "a single function"

  (define (average-age ft now)
    (cond
      ((list? now)
       (cond
         ((empty? ft) now)
         (else (average-age (child-father ft)
                 (average-age (child-mother ft)
                   (cond
                     ((memq ft now) now)
                     (else (cons ft now))))))))
      ((= now -1)
       (cond
         ((empty? ft) 0)
         (else (+ (child-date (car ft)) (average-age (cdr ft) now)))))
      ((= now -2)
       (cond
         ((empty? ft) 0)
         (else (+ 1 (average-age (cdr ft) now)))))
      (else
        (- now
          (/ (average-age (average-age ft empty) -1)
            (average-age (average-age ft empty) -2))))))

-ggem.
From: Pascal Bourguignon
Subject: Re: HtDP, Excersise 14.1.4 (average-age)
Date: 
Message-ID: <87irnjl5v8.fsf@thalassa.informatimago.com>
"ggem" <······@hotmail.com> writes:

> Wade Humeniuk wrote:
>> [ ... ]  Grandma may appear twice because she
>> gave birth to siblings who gave birth to first
>> cousins who married and had a child. [ ... ]
>
> My pure and innocent mind is incapable of even
> considering an incestuos situation.  Now that
> you put that thought in my mind, I must go
> flagellate myself. :)

We all descend from Adam & Eve.  We're really in a DAG! 

> In my defense, it's called a family _tree_, not a
> family _graph_.

But it's really a family graph.

-- 
__Pascal Bourguignon__                     http://www.informatimago.com/

READ THIS BEFORE OPENING PACKAGE: According to certain suggested
versions of the Grand Unified Theory, the primary particles
constituting this product may decay to nothingness within the next
four hundred million years.
From: Rob Warnock
Subject: Re: HtDP, Excersise 14.1.4 (average-age)
Date: 
Message-ID: <t9edndFfQdDUSx3ZRVn-qg@speakeasy.net>
Pascal Bourguignon  <···@informatimago.com> wrote:
+---------------
| "ggem" <······@hotmail.com> writes:
| > My pure and innocent mind is incapable of even
| > considering an incestuos situation. ...
| 
| We all descend from Adam & Eve.  We're really in a DAG! 
+---------------

And if we ever invent time travel, maybe not even a DAG!
[See Robert Heinlein's short story, "All You Zombies",
in which the protagonist is his own father & mother...]


-Rob

-----
Rob Warnock			<····@rpw3.org>
627 26th Avenue			<URL:http://rpw3.org/>
San Mateo, CA 94403		(650)572-2607