问题描述
练习：开发功能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语言，或者根本不了解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)))
使用改良的显式堆栈模拟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”循环处理时可以检查是否存在重复项，并且完全避免处理任何重复项。
这本质上只是图的遍历。需要 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))
....... )))))
..... ))
如果我在这里犯了一个错误（并且我确实犯了），请纠正它，但这是一般性的想法。