Asp Forum - Re: HtDP, Excersise 14.1.4 (average-age

William James

4/9/2015 3:26:00 AM

Wade Humeniuk 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#nod...):
> >
>
> 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

Gauche Scheme:

(use gauche.record)

(define-record-type person #t #t father mother name date eyes)

(define Carl (make-person #f #f 'Carl 1955 'green))
(define Bettina (make-person #f #f 'Bettina 1960 'green))

(define Adam (make-person Carl Bettina 'Adam 1980 'blue))
(define Dave (make-person Carl Bettina 'Dave 1984 'brown))
(define Eva (make-person Carl Bettina 'Eva 1990 'green))
(define Fred (make-person #f #f 'Fred 1990 'brown))

(define Gustav (make-person Fred Eva 'Gustav 2012 'brown))

(define (child-and-ancestors child)
(if child
(cons child (append (child-and-ancestors (person-father child))
(child-and-ancestors (person-mother child))))
'()))

(define (average-age child now)
(let1 people (child-and-ancestors child)
(/. (apply + (map (^p (- now (person-date p))) people))
(length people))))

(average-age Gustav 2015)

===>
33.6

comp.lang.lisp

Re: HtDP, Excersise 14.1.4 (average-age

William James

x Login to ForumsZone