HtDP2e 练习 311：家谱中的平均年龄答案

【问题标题】：HtDP2e Exercise 311: Average age in the family treeHtDP2e 练习 311：家谱中的平均年龄
【发布时间】：2020-12-07 18:49:12
【问题描述】：

练习：开发函数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))))]))

【问题讨论】：

我认为你必须被允许使用上一个练习中的count-persons。有了这个就相当容易了。
你能用local吗？
@atharva-shukla 我可以使用local，因为它在前面的章节中已经介绍过了，尽管它无助于避免创建辅助函数。
@tfb 这本书不会强迫你做什么，你可以做什么，你不能做什么。我只是想知道创建辅助函数是不可避免的还是我错过了在单个函数中完成它的一些可能性。
一个。多参数可以通过将新参数组合成一个在“正常”调用时完全出乎意料的新结构来模拟，并在每次调用时检查接收到的参数的结构，从而模拟，是的，一个辅助函数；湾。对于显式结构树，有 John McCarthy 的树旋转 gopher 技巧；但是这里隐含了树，所以你回到了选项 a。看来。

标签： functional-programming scheme binary-tree racket average

【解决方案1】：

我不太了解 HTDP 语言，或者根本不了解，所以下面的代码在成熟的 Racket 中 - 对此感到抱歉。

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

他们的年龄
加上他们父母年龄的总和，每个父母的年龄乘以父母的树上有多少人
除以他们的树中的总人数。

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

请注意，此算法假设家谱是一棵树。在现实生活中它不是：它是一个 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)))

【讨论】：

我不明白count-people 的目的是什么，因为我们可以像在我的解决方案中那样使用人们年龄列表的length。
@KonstantinKostanzhoglo：嗯，至少length 是 O(n) 并且需要构建一个大型结构，但我想这没有什么问题。但是，我认为赋予树本质上是权重（树中有多少节点）的想法通常很有用。
附注：你的第二段：太多的代词，无法理解哪个指的是什么。 matter of style。 :)
但是，如果我猜对了它的意思，难道它假设一个人的树的任何部分，在那个人之上，是共享的?这个假设肯定是无效的，并且看起来在这种情况下可能会产生无效的结果。考虑一个菱形树的退化情况。最底部节点的权重是多少？是 1/4，不是 1/5，不是吗？
@WillNess：我已经改写了第二段，这太可怕了：我希望现在少一些。（对我来说，SE 答案中没有 LaTeX 让我感到无尽的烦恼，所以你必须用文字写出数学。）。是的，我假设这棵树是一棵树，显然在现实生活中这是错误的：它是一个 DAG。我认为要正确处理 DAG，您需要进行发生检查，并且树权重技巧失败了，因为节点的权重不再是 1 + 其分支的权重，因为我认为在任何地方都可以存在共享结构。很遗憾，这个例子严重损害了我对 HTDP 的看法。

【解决方案2】：

模拟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 上循环，同时将父亲放在一边供以后处理，建立节点列表，以便我们可以在最后一步计算该列表的平均年龄。

我们使用目前看到的节点列表，以便我们可以在执行“辅助”循环处理时检查重复项，并且完全避免处理任何重复项。

这本质上只是一个图遍历。 seen-so-far 节点列表用于跳过重复项、避免循环，并且还用于最后的处理步骤。

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

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

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

【讨论】：