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-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 12687dd9 2023-08-04 jrmu ;A parent structure is
5 12687dd9 2023-08-04 jrmu ;(make-parent children name date eyes)
6 12687dd9 2023-08-04 jrmu ;where name and eyes are symbols,
7 12687dd9 2023-08-04 jrmu ;date is a number, and children is a
8 12687dd9 2023-08-04 jrmu ;list-of-children.
10 12687dd9 2023-08-04 jrmu (define-struct parent (children name date eyes))
12 12687dd9 2023-08-04 jrmu ;A list-of-children is either
13 12687dd9 2023-08-04 jrmu ;1. an empty list or
14 12687dd9 2023-08-04 jrmu ;2. (cons p loc) where p is a parent
15 12687dd9 2023-08-04 jrmu ;and loc is a list-of-children.
17 12687dd9 2023-08-04 jrmu ;fun-for-parent: parent -> ???
19 12687dd9 2023-08-04 jrmu ;(define (fun-for-parent a-parent)
20 12687dd9 2023-08-04 jrmu ; ... (parent-children a-parent) ...
21 12687dd9 2023-08-04 jrmu ; ... (parent-name a-parent) ...
22 12687dd9 2023-08-04 jrmu ; ... (parent-date a-parent) ...
23 12687dd9 2023-08-04 jrmu ; ... (parent-eyes a-parent) ...)
26 12687dd9 2023-08-04 jrmu ;fun-for-loc : list-of-children -> ???
27 12687dd9 2023-08-04 jrmu ;(define (fun-for-loc a-loc)
29 12687dd9 2023-08-04 jrmu ; [(empty? a-loc) ...]
30 12687dd9 2023-08-04 jrmu ; [else ... (first a-loc) ...
31 12687dd9 2023-08-04 jrmu ; ... (fun-for-loc (rest a-loc)) ...]))
34 12687dd9 2023-08-04 jrmu ;Third Generation
35 12687dd9 2023-08-04 jrmu (define Gustav (make-parent empty 'Gustav 1988 'brown))
37 12687dd9 2023-08-04 jrmu ;Second Generation
38 12687dd9 2023-08-04 jrmu (define Fred (make-parent (list Gustav) 'Fred 1966 'pink))
39 12687dd9 2023-08-04 jrmu (define Eva (make-parent (list Gustav) 'Eva 1965 'blue))
40 12687dd9 2023-08-04 jrmu (define Dave (make-parent empty 'Dave 1955 'black))
41 12687dd9 2023-08-04 jrmu (define Adam (make-parent empty 'Adam 1950 'yellow))
43 12687dd9 2023-08-04 jrmu ;First Generation
44 12687dd9 2023-08-04 jrmu (define Bettina (make-parent (list Adam Dave Eva) 'Bettina 1926 'green))
45 12687dd9 2023-08-04 jrmu (define Carl (make-parent (list Adam Dave Eva) 'Carl 1926 'green))
47 12687dd9 2023-08-04 jrmu ;Test - All should return true
48 12687dd9 2023-08-04 jrmu ;(blue-eyed-descendant? Bettina)
49 12687dd9 2023-08-04 jrmu ;(blue-eyed-descendant? Eva)
50 12687dd9 2023-08-04 jrmu ;(not (blue-eyed-descendant? Gustav))
51 12687dd9 2023-08-04 jrmu ;(not (blue-eyed-descendant? Adam))
53 12687dd9 2023-08-04 jrmu ;blue-eyed-descendant? : parent -> boolean
54 12687dd9 2023-08-04 jrmu ;Given a-parent, determines whether the parent
55 12687dd9 2023-08-04 jrmu ;or any of its descendants have blue eyes.
57 12687dd9 2023-08-04 jrmu ;blue-eyed-children? : list-of-children -> boolean
58 12687dd9 2023-08-04 jrmu ;Given a-loc (list-of-children), return true if
59 12687dd9 2023-08-04 jrmu ;any parent structure within the list-of-children have blue eyes
60 12687dd9 2023-08-04 jrmu ;or if any of their descendants have blue eyes.
62 12687dd9 2023-08-04 jrmu (define (blue-eyed-descendant a-parent)
63 12687dd9 2023-08-04 jrmu (local ((define (blue-eyed-descendant? a-parent)
65 12687dd9 2023-08-04 jrmu [(symbol=? (parent-eyes a-parent) 'blue) true]
66 12687dd9 2023-08-04 jrmu [else (blue-eyed-children? (parent-children a-parent))]))
68 12687dd9 2023-08-04 jrmu (define (blue-eyed-children? a-loc)
70 12687dd9 2023-08-04 jrmu [(empty? a-loc) false]
71 12687dd9 2023-08-04 jrmu [else (or (blue-eyed-descendant? (first a-loc))
72 12687dd9 2023-08-04 jrmu (blue-eyed-children? (rest a-loc)))])))
73 12687dd9 2023-08-04 jrmu (blue-eyed-descendant a-parent)))
