HtDP2e锻炼311:家谱平均年龄

Question

练习:开发功能average-age。它消耗了一棵家谱和今年。它产生家谱中所有child结构的平均年龄。

显然，这个练习应该在一个函数中解决，但是还没有引入累加器，所以我想知道如何不用表示中间结果的额外参数或创建辅助函数来解决这个问题。

这是我的解决方案：

(define CURRENT-YEAR 2020)

(define-struct no-parent [])
(define NP (make-no-parent))
(define-struct child [father mother name date eyes])
;; An FT (short for family tree) is one of:
;; - NP
;; - (make-child FT FT String Number String)
;; interp. a child in an ancestor family tree with father, mother, name, year of birth and color of eyes

;; Oldest generation:
(define Carl (make-child NP NP "Carl" 1926 "green"))
(define Bettina (make-child NP NP "Bettina" 1926 "green"))

;; Middle generation:
(define Adam (make-child Carl Bettina "Adam" 1950 "hazel"))
(define Dave (make-child Carl Bettina "Dave" 1955 "black"))
(define Eva (make-child Carl Bettina "Eva" 1965 "blue"))
(define Fred (make-child NP NP "Fred" 1966 "pink"))

;; Youngest generation:
(define Gustav (make-child Eva Fred "Gustav" 1988 "brown"))

;; Exercise 311
;; FT Number -> Number
;; Given ftree and current year, produce average age of all the child structures in the tree
;; ASSUME: the tree is not empty
(check-expect (average-age CURRENT-YEAR Carl)
              (/ (- CURRENT-YEAR (child-date Carl)) 1))
(check-expect (average-age CURRENT-YEAR Eva)
              (/ (+ (- CURRENT-YEAR (child-date Eva))
                                           (- CURRENT-YEAR (child-date Carl))
                                           (- CURRENT-YEAR (child-date Bettina)))
                                        3))
(check-expect (average-age CURRENT-YEAR Gustav)
              (/ (+ (- CURRENT-YEAR (child-date Gustav))
                    (- CURRENT-YEAR (child-date Eva))
                    (- CURRENT-YEAR (child-date Carl))
                    (- CURRENT-YEAR (child-date Bettina))
                    (- CURRENT-YEAR (child-date Fred)))
                 5))

;(define (average-age current-year ftree) 0)

(define (average-age current-year ftree)
  (mean (child-ages current-year ftree)))

;; ListOfNumber -> Number
;; calculates statistical mean for the given list of numbers, produces 0 for empty list
(check-expect (mean empty) 0)
(check-expect (mean (list 100 200 600)) 300)

;(define (mean lon) 0)

(define (mean lon)
  (cond [(empty? lon) 0]
        [else (/ (foldl + 0 lon)
                 (length lon))]))

;; Number FT -> Number
;; produces list of ages in the ftree by subtracting everyone's age from current year
(check-expect (child-ages CURRENT-YEAR Carl) (list (- CURRENT-YEAR (child-date Carl))))
(check-expect (child-ages CURRENT-YEAR Eva) (list (- CURRENT-YEAR (child-date Eva))
                                          (- CURRENT-YEAR (child-date Carl))
                                          (- CURRENT-YEAR (child-date Bettina))))

;(define (child-ages current-year ftree) empty)
(define (child-ages current-year ftree)
  (cond [(no-parent? ftree) empty]
        [else (cons (- current-year (child-date ftree))
                    (append (child-ages current-year (child-father ftree))
                            (child-ages current-year (child-mother ftree))))]))

Answer 1

模拟CPS样式，使用具体化的显式堆栈，使用在“正常”调用中不可能使用的特殊打包参数来模拟助手函数，

(define (average-age node current-year)
   (cond
      ((pair? node)
          ;; helper function emulation
          .... )
      ((is-no-parent? node) (error "N/A"))
      ((is-child? node)
         (average-age       ; repackage for the helper, and start looping
              (list (list node)          ; emulated helper's 1st arg
                    (child-mother node)  ; emulated helper's rest of arguments
                    (child-father node))
              current-year))))

也许你能从这里看到解决办法？你甚至不需要知道"CPS“是什么意思。只需遵循路径；在每个节点的mother上循环，同时将父节点放在一边进行以后的处理，构建节点列表，以便在最后一步计算该列表的平均年龄。

我们使用到目前为止看到的节点列表，以便在执行"helper“循环处理时检查副本，并且完全避免处理任何重复的节点。

这本质上只是一个图遍历。到目前为止，要跳过重复的节点列表，避免循环，还需要在最后的处理步骤中使用所见节点列表。

若要在解决方案组合中再添加一个步骤，

(define (average-age node current-year)
   (cond
      ((pair? node)
          ;; helper function emulation
          ;; here we get the arguments as we've prepared them
          (let* ( (args        node)        ; it's not a _node_, here
                  (seen-so-far (car args)) 
                  (nodes       (cdr args)))
             (if (null? nodes)
                   ;; nothing more to do, return the result
               (the-result  seen-so-far)
                   ;; otherwise continue working
               (let ( (this-node  (car nodes))
                      (more-nodes (cdr nodes)))
                 (cond
                   ((or      ;; this-node is a dup, or none
                          (seen-before?  this-node  seen-so-far)
                          (is-no-parent? this-node))
                             ;; skip it
                      (average-age 
                          (cons  seen-so-far  more-nodes)
                          current-year))
                   ((is-child?  this-node)
                      ;; go on processing
                      (average-age 
                          (cons  seen-so-far     ; interim accumulator value
                            (cons  (child-mother this-node)   ; a TO_DO
                              (cons  (child-father this-node) ;  FIFO list
                                     more-nodes)))
                          current-year))
                   ....... )))))
    ..... ))

如果我在这里犯了一个错误(我确实犯了)，纠正它，但这是一般的想法。

Answer 2

我对HTDP语言不太了解，或者根本不懂，所以下面的代码是完全成熟的，对此我很抱歉。

然而，要解决这个问题，一个简单的技巧就是要认识到，一个人的平均年龄是

• 他们的年龄
• 加上父母年龄之和，每个父母的年龄乘以父母树上的人数
• 除以树上的总人数。

因此，在这之前的练习中的功能非常有帮助。

注意，此算法假定家族树是一棵树。在现实生活中并非如此:它是一个DAG。

因此，对于人们来说，这是一个稍微不同的结构:人们只是有一个父母列表，这避免了很多烦人的代码和假设，还有两个函数：count-people计算一个人的树中的人数，average-age计算一个人的平均年龄，给定count-people。

(struct person
  (name
   born
   parents)
  #:transparent)

;;; This is just to make it easier to type in family trees
;;;
(define/match (desc->person desc)
  (((list* name born parents))
   (person name born (map desc->person parents))))

(define joe
  (desc->person '("joe" 2000
                        ("emily" 1975
                                 ("john" 1950)
                                 ("joan" 1950))
                        ("lucy" 1970
                                ("anne" 1945
                                        ("arabella" 1910))
                                ("erik" 1946)))))

(define (count-people p)
  (foldl + 1 (map count-people (person-parents p))))

(define (average-age when p)
  (/ (foldl + (- when (person-born p))
            (map (λ (pp)
                   (* (count-people pp)
                      (average-age when pp)))
                 (person-parents p)))
     (count-people p)))

很明显，这对count-people的调用非常多，而且是重复的，因此，一个更好的定义可以回溯它：

(define count-people
  (let ([cache (make-weak-hasheqv)])
    (λ (p)
      (hash-ref! cache p
                 (thunk
                  (+ 1 (foldl + 0 (map count-people (person-parents p)))))))))

当然，可以将人的计数存储在树本身中，这意味着计算总是即时的：

(struct person
  (name
   born
   parents
   count)
  #:transparent)

(define (make-person name born parents)
  (person name born parents
          (+ 1 (for/sum ([p (in-list parents)])
                 (person-count p)))))

;;; This is just to make it easier to type in family trees
;;;
(define/match (desc->person desc)
  (((list* name born parents))
   (make-person name born (map desc->person parents))))

(define joe
  (desc->person '("joe" 2000
                        ("emily" 1975
                                 ("john" 1950)
                                 ("joan" 1950))
                        ("lucy" 1970
                                ("anne" 1945
                                        ("arabella" 1910))
                                ("erik" 1946)))))

(define (average-age when p)
  (/ (+ (- when (person-born p))
        (for/sum ([pp (in-list (person-parents p))])
          (* (person-count pp)
             (average-age when pp))))
     (person-count p)))