1 ;; The first three lines of this file were inserted by DrScheme. They record metadata
2 ;; about the language level of this file in a form that our tools can easily process.
3 #reader(lib "" "lang")((modname 18.1.13) (read-case-sensitive #t) (teachpacks ((lib "" "teachpack" "htdp"))) (htdp-settings #(#t constructor repeating-decimal #f #t none #f ((lib "" "teachpack" "htdp")))))
4 (define-struct child (father mother name date eyes))
6 #|
7 A child is a structure
8 (make-child fa mo na da ec)
9 where fa, mo are family-tree-nodes, name and eyes are symbol, and date is a number.
11 A family tree node (ftn) is either
12 1. empty or
13 2. (make-node fa mo na da ec)
14 where fa, mo are family-tree-nodes and na, ec are symbols, and da is a number.
16 A direction is either
17 1. the symbol 'father or
18 2. the symbol 'mother.
20 A path is either
21 1. empty or
22 2. (cons d p)
23 where d is a direction and p is a path.
25 to-blue-eyed-ancestor : ftn -> path or false
26 Return the path to a blue-eyed-ancestor, by searching out the paternal family tree first. (Given two or more blue-eyed-ancestors, the path returned will be the one that follows the paternal path in any given fork). Non-proper ancestors are returned as empty paths (a-ftn itself is counted as an ancestor).
28 |#
30 (define (to-blue-eyed-ancestor a-ftn)
31 (cond
32 [(empty? a-ftn) false]
33 [(symbol=? 'blue (child-eyes a-ftn)) empty]
34 [else (local ((define f (to-blue-eyed-ancestor (child-father a-ftn)))
35 (define m (to-blue-eyed-ancestor (child-mother a-ftn))))
36 (cond
37 [(or
38 (cons? f)
39 (empty? f)) (cons 'father f)]
40 [(or
41 (cons? m)
42 (empty? m)) (cons 'mother m)]
43 [else false]))]))
45 (define Carl (make-child empty empty 'Carl 1926 'green))
46 (define Bettina (make-child empty empty 'Bettina 1926 'green))
47 (define Adam (make-child Carl Bettina 'Adam 1950 'yellow))
48 (define Dave (make-child Carl Bettina 'Dave 1955 'black))
49 (define Eva (make-child Carl Bettina 'Eva 1965 'blue))
50 (define Fred (make-child empty empty 'Fred 1966 'pink))
51 (define Gustav (make-child Fred Eva 'Gustav 1988 'brown))