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.10) (read-case-sensitive #t) (teachpacks ((lib "draw.ss" "teachpack" "htdp") (lib "arrow.ss" "teachpack" "htdp"))) (htdp-settings #(#t constructor repeating-decimal #f #t none #f ((lib "draw.ss" "teachpack" "htdp") (lib "arrow.ss" "teachpack" "htdp")))))
4 ;A parent structure is
5 ;(make-parent children name date eyes)
6 ;where name and eyes are symbols,
7 ;date is a number, and children is a
8 ;list-of-children.
9 
10 (define-struct parent (children name date eyes))
11 ;
12 ;A list-of-children is either
13 ;1. an empty list or
14 ;2. (cons p loc) where p is a parent
15 ;and loc is a list-of-children.
16 
17 ;fun-for-parent: parent -> ???
18 ;Template
19 ;(define (fun-for-parent a-parent)
20 ;  ... (parent-children a-parent) ...
21 ;  ... (parent-name a-parent) ...
22 ;  ... (parent-date a-parent) ...
23 ;  ... (parent-eyes a-parent) ...)
24 
25 ;
26 ;fun-for-loc : list-of-children -> ???
27 ;(define (fun-for-loc a-loc)
28 ;  (cond
29 ;    [(empty? a-loc) ...]
30 ;    [else ... (first a-loc) ...
31 ;          ... (fun-for-loc (rest a-loc)) ...]))
32 
33 
34 ;Third Generation
35 (define Gustav (make-parent empty 'Gustav 1988 'brown))
36 
37 ;Second Generation
38 (define Fred (make-parent (list Gustav) 'Fred 1966 'pink))
39 (define Eva (make-parent (list Gustav) 'Eva 1965 'blue))
40 (define Dave (make-parent empty 'Dave 1955 'black))
41 (define Adam (make-parent empty 'Adam 1950 'yellow))
42 
43 ;First Generation
44 (define Bettina (make-parent (list Adam Dave Eva) 'Bettina 1926 'green))
45 (define Carl (make-parent (list Adam Dave Eva) 'Carl 1926 'green))
46 
47 ;Test - All should return true
48 ;(blue-eyed-descendant? Bettina)
49 ;(blue-eyed-descendant? Eva)
50 ;(not (blue-eyed-descendant? Gustav))
51 ;(not (blue-eyed-descendant? Adam))
52 
53 ;blue-eyed-descendant? : parent -> boolean
54 ;Given a-parent, determines whether the parent
55 ;or any of its descendants have blue eyes.
56 
57 ;blue-eyed-children? : list-of-children -> boolean
58 ;Given a-loc (list-of-children), return true if
59 ;any parent structure within the list-of-children have blue eyes
60 ;or if any of their descendants have blue eyes.
61 
62 (define (blue-eyed-descendant a-parent)
63   (local ((define (blue-eyed-descendant? a-parent)
64             (cond
65               [(symbol=? (parent-eyes a-parent) 'blue) true]
66               [else (blue-eyed-children? (parent-children a-parent))]))
67           
68           (define (blue-eyed-children? a-loc)
69             (cond
70               [(empty? a-loc) false]
71               [else (or (blue-eyed-descendant? (first a-loc))
72                         (blue-eyed-children? (rest a-loc)))])))
73     (blue-eyed-descendant a-parent)))