HtDP2e 练习 311：家谱中的平均年龄
HtDP2e Exercise 311: Average age in the family tree
练习：开发函数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))))]))
我不太了解 HTDP 语言，或者根本不了解，所以下面的代码在 fully-fledged Racket 中 – 抱歉。
然而，解决这个问题的一个简单技巧是认识到一个人的平均年龄是
- 他们的年龄
- 加上他们parent的年龄总和，每个parent的年龄乘以parent的树
中的人数
- 除以他们树中的总人数。
因此，之前练习中的函数很有帮助。
请注意，此算法假定家谱是一棵树。在现实生活中它不是：它是一个 DAG。
所以对于人们来说这里有一个稍微不同的结构：人们只是有一个 parent 的列表，它避免了很多烦人的代码和假设，还有两个函数：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)))
模拟 CPS 风格，具有具体化的显式堆栈，模拟带有 specially-packaged 个参数的辅助函数，在“正常”调用时是不可能的，
(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))
....... )))))
..... ))
如果我在这里犯了错误（我确实犯了），请更正，但这是一般的想法。
练习：开发函数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))))]))
我不太了解 HTDP 语言，或者根本不了解，所以下面的代码在 fully-fledged Racket 中 – 抱歉。
然而，解决这个问题的一个简单技巧是认识到一个人的平均年龄是
- 他们的年龄
- 加上他们parent的年龄总和，每个parent的年龄乘以parent的树 中的人数
- 除以他们树中的总人数。
因此，之前练习中的函数很有帮助。
请注意，此算法假定家谱是一棵树。在现实生活中它不是：它是一个 DAG。
所以对于人们来说这里有一个稍微不同的结构：人们只是有一个 parent 的列表，它避免了很多烦人的代码和假设，还有两个函数：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)))
模拟 CPS 风格，具有具体化的显式堆栈，模拟带有 specially-packaged 个参数的辅助函数，在“正常”调用时是不可能的，
(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))
....... )))))
..... ))
如果我在这里犯了错误（我确实犯了），请更正，但这是一般的想法。