1 12687dd9 2023-08-04 jrmu ;; The first three lines of this file were inserted by DrScheme. They record metadata
 2 12687dd9 2023-08-04 jrmu ;; about the language level of this file in a form that our tools can easily process.
 3 12687dd9 2023-08-04 jrmu #reader(lib "htdp-advanced-reader.ss" "lang")((modname |32.1|) (read-case-sensitive #t) (teachpacks ((lib "draw.ss" "teachpack" "htdp") (lib "arrow.ss" "teachpack" "htdp") (lib "gui.ss" "teachpack" "htdp"))) (htdp-settings #(#t constructor repeating-decimal #t #t none #f ((lib "draw.ss" "teachpack" "htdp") (lib "arrow.ss" "teachpack" "htdp") (lib "gui.ss" "teachpack" "htdp")))))
 4 12687dd9 2023-08-04 jrmu (define-struct child (father mother name date eyes))
 5 12687dd9 2023-08-04 jrmu 
 6 12687dd9 2023-08-04 jrmu ;A ftn (family tree node) is either
 7 12687dd9 2023-08-04 jrmu ;1. empty or
 8 12687dd9 2023-08-04 jrmu ;2. (make-child f m na da ec) where f, m are ftns, na, ec are symbols, and da is a number.
 9 12687dd9 2023-08-04 jrmu ;
10 12687dd9 2023-08-04 jrmu ;all-blue-eyed-ancestors : ftn -> (listof symbol)
11 12687dd9 2023-08-04 jrmu ;Given aftree0, return a list of all blue-eyed-ancestors as a (listof symbols).
12 12687dd9 2023-08-04 jrmu 
13 12687dd9 2023-08-04 jrmu (define (all-blue-eyed-ancestors aftree0)
14 12687dd9 2023-08-04 jrmu   (local
15 12687dd9 2023-08-04 jrmu     ;accumulator represents all the blue-eyed ancestors on the mother side of tree paths
16 12687dd9 2023-08-04 jrmu     ;from [aftree0,aftree1)
17 12687dd9 2023-08-04 jrmu     ((define (all-a aftree1 accumulator)
18 12687dd9 2023-08-04 jrmu        (cond
19 12687dd9 2023-08-04 jrmu          [(empty? aftree1) accumulator]
20 12687dd9 2023-08-04 jrmu          [else
21 12687dd9 2023-08-04 jrmu           (local
22 12687dd9 2023-08-04 jrmu             ((define in-parents
23 12687dd9 2023-08-04 jrmu                (all-a (child-father aftree1)
24 12687dd9 2023-08-04 jrmu                       (all-a (child-mother aftree1)
25 12687dd9 2023-08-04 jrmu                              accumulator))))
26 12687dd9 2023-08-04 jrmu             (cond
27 12687dd9 2023-08-04 jrmu               [(symbol=? 'blue (child-eyes aftree1))
28 12687dd9 2023-08-04 jrmu                (cons (child-name aftree1)
29 12687dd9 2023-08-04 jrmu                      in-parents)]
30 12687dd9 2023-08-04 jrmu               [else in-parents]))])))
31 12687dd9 2023-08-04 jrmu     (all-a aftree0 empty)))
32 12687dd9 2023-08-04 jrmu 
33 12687dd9 2023-08-04 jrmu (define eight (make-child empty empty 'eight 1999 'blue))
34 12687dd9 2023-08-04 jrmu (define nine (make-child empty empty 'nine 1999 'blue))
35 12687dd9 2023-08-04 jrmu (define ten (make-child empty empty 'ten 1999 'blue))
36 12687dd9 2023-08-04 jrmu (define eleven (make-child empty empty 'eleven 1999 'blue))
37 12687dd9 2023-08-04 jrmu (define twelve  (make-child empty empty 'twelve 1999 'blue))
38 12687dd9 2023-08-04 jrmu (define thirteen (make-child empty empty 'thirteen 1999 'blue))
39 12687dd9 2023-08-04 jrmu (define fourteen (make-child empty empty 'fourteen 1999 'blue))
40 12687dd9 2023-08-04 jrmu (define fifteen (make-child empty empty 'fifteen 1999 'blue))
41 12687dd9 2023-08-04 jrmu (define four (make-child eight nine 'four 1999 'blue))
42 12687dd9 2023-08-04 jrmu (define five (make-child ten eleven 'five 1999 'blue))
43 12687dd9 2023-08-04 jrmu (define six (make-child twelve thirteen 'six 1999 'blue))
44 12687dd9 2023-08-04 jrmu (define seven (make-child fourteen fifteen 'seven 1999 'blue))
45 12687dd9 2023-08-04 jrmu (define two (make-child four five 'two 1999 'blue))
46 12687dd9 2023-08-04 jrmu (define three (make-child six seven 'three 1999 'blue))
47 12687dd9 2023-08-04 jrmu (define one (make-child two three 'one 1999 'blue))
48 12687dd9 2023-08-04 jrmu 
49 12687dd9 2023-08-04 jrmu (all-blue-eyed-ancestors one)
50 12687dd9 2023-08-04 jrmu 
51 12687dd9 2023-08-04 jrmu #|
52 12687dd9 2023-08-04 jrmu (define Carl (make-child empty empty 'Carl 1926 'green))
53 12687dd9 2023-08-04 jrmu (define Bettina (make-child empty empty 'Bettina 1926 'green))
54 12687dd9 2023-08-04 jrmu (define Adam (make-child Carl Bettina 'Adam 1950 'yellow))
55 12687dd9 2023-08-04 jrmu (define Dave (make-child Carl Bettina 'Dave 1955 'black))
56 12687dd9 2023-08-04 jrmu (define Eva (make-child Carl Bettina 'Eva 1965 'blue))
57 12687dd9 2023-08-04 jrmu (define Fred (make-child empty empty 'Fred 1966 'pink))
58 12687dd9 2023-08-04 jrmu (define Gustav (make-child Fred Eva 'Gustav 1988 'brown))
59 12687dd9 2023-08-04 jrmu |#
60 12687dd9 2023-08-04 jrmu 
61 12687dd9 2023-08-04 jrmu ;all-blue-eyed-ancestors2 : ftn -> (listof symbols)
62 12687dd9 2023-08-04 jrmu 
63 12687dd9 2023-08-04 jrmu (define (all-blue-eyed-ancestors2 aftree0)
64 12687dd9 2023-08-04 jrmu   (local ;the accumulator todo represents a list of nodes we have yet to process
65 12687dd9 2023-08-04 jrmu     ;counting from [aftree0,aftree1)
66 12687dd9 2023-08-04 jrmu     ((define (all-a aftree1 todo)
67 12687dd9 2023-08-04 jrmu        (cond
68 12687dd9 2023-08-04 jrmu          [(empty? aftree1)
69 12687dd9 2023-08-04 jrmu           (cond
70 12687dd9 2023-08-04 jrmu             [(empty? todo) empty]
71 12687dd9 2023-08-04 jrmu             [else (all-a (first todo) (rest todo))])]
72 12687dd9 2023-08-04 jrmu          [else (local
73 12687dd9 2023-08-04 jrmu                  ((define in-parents
74 12687dd9 2023-08-04 jrmu                     (all-a (child-father aftree1) (cons (child-mother aftree1) todo))))
75 12687dd9 2023-08-04 jrmu                  (cond
76 12687dd9 2023-08-04 jrmu                    [(symbol=? (child-eyes aftree1) 'blue)
77 12687dd9 2023-08-04 jrmu                     (cons (child-name aftree1) in-parents)]
78 12687dd9 2023-08-04 jrmu                    [else in-parents]))]))) 
79 12687dd9 2023-08-04 jrmu     (all-a aftree0 empty)))
80 12687dd9 2023-08-04 jrmu 
81 12687dd9 2023-08-04 jrmu (all-blue-eyed-ancestors2 one)