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 "htdp-intermediate-reader.ss" "lang")((modname 18.1.13) (read-case-sensitive #t) (teachpacks ((lib "draw.ss" "teachpack" "htdp"))) (htdp-settings #(#t constructor repeating-decimal #f #t none #f ((lib "draw.ss" "teachpack" "htdp")))))
4 (define-struct child (father mother name date eyes))
5 
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.
10 
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.
15 
16 A direction is either
17 1. the symbol 'father or
18 2. the symbol 'mother.
19 
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.
24 
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).
27 
28 |#
29 
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]))]))
44 
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))
52