;; The first three lines of this file were inserted by DrRacket. They record metadata
;; about the language level of this file in a form that our tools can easily process.
#reader(lib "htdp-intermediate-lambda-reader.ss" "lang")((modname week7_m_full) (read-case-sensitive #t) (teachpacks ((lib "image.ss" "teachpack" "htdp"))) (htdp-settings #(#t constructor repeating-decimal #f #t none #f ((lib "image.ss" "teachpack" "htdp")))))
;Descendant trees:
;+-----------+  +--------------+
;|Carl (1926)|  |Bettina (1926)|
;|Eyes: Green|  |Eyes: Green   |
;+-----------+  +--------------+
;     
;+------------+  +-----------+  +-----------+  +-----------+
;|Adam (1950) |  |Dave (1955)|  |Eva  (1965)|  |Fred (1966)|
;|Eyes: Yellow|  |Eyes: Black|  |Eyes: Blue |  |Eyes: Pink |
;+------------+  +-----------+  +-----------+  +-----------+
;
;                                    +---------------+
;                                    | Gustav (1988) |
;                                    | Eyes: brown   |
;                                    +---------------+

;Gustav -> Eva
;Gustav -> Fred
;Eva -> Carl
;Eva -> Bettina
;Dave -> Carl
;Dave -> Bettina
;Adam -> Carl
;Adam -> Bettina

; a family-tree is:
;   (make-parent list-of-family-tree symbol number symbol)
(define-struct parent (children name date eyes))

; a list-of-family-tree is either:
;  - empty
;  - (cons family-tree list-of-family-tree)


(define gustav (make-parent empty 'gustav 1988 'brown))
(define adam (make-parent empty 'adam 1950 'yellow))
(define dave (make-parent empty 'dave 1965 'black))
(define eva (make-parent (list gustav) 'eva 1965 'blue))
(define fred (make-parent (list gustav) 'fred 1966 'pink))
(define carl (make-parent (list adam dave eva fred)
                          'carl
                          1926
			  'green))
(define bettina (make-parent (list adam dave eva fred)
               	             'bettina
                	     1926
			     'green))

;ft-blue-eyed-descendant : family-tree -> boolean
;returns whether the family tree has a blue-eyed member
(define (ft-blue-eyed-descendant ft)
  (or (symbol=? 'blue (parent-eyes ft))
      (lft-blue-eyed-descendant (parent-children ft))))

;lft-blue-eyed-descendant : list-of-family-tree -> boolean
;returns whether any of the list of family trees has a blue-eyed member
(define (lft-blue-eyed-descendant lft)
  (cond
   [(empty? lft) false]
   [else 
    (or (ft-blue-eyed-descendant (first lft))
        (lft-blue-eyed-descendant (rest lft)))]))

(check-expect (ft-blue-eyed-descendant bettina) true)
(check-expect (ft-blue-eyed-descendant gustav) false)

;ft-satisfies : family-tree (family-tree -> boolean) -> boolean
;returns whether the family tree contains an element satisfying a given criteria
(define (ft-satisfies ft p?)
  (or (p? ft)
      (lft-satisfies (parent-children ft) p?)))

;lft-satisfies : list-of-family-tree (family-tree -> boolean) -> boolean
;returns whether any of the list of family trees contains an element satisfying a given criteria
(define (lft-satisfies lft p?)
  (cond
   [(empty? lft) false]
   [else 
    (or (ft-satisfies (first lft) p?)
        (lft-satisfies (rest lft) p?))]))

(check-expect (ft-satisfies bettina (lambda (ft) (symbol=? 'blue (parent-eyes ft)))) true)
(check-expect (ft-satisfies gustav (lambda (ft) (symbol=? 'blue (parent-eyes ft)))) false)
(check-expect (ft-satisfies bettina (lambda (ft) (<= 1980 (parent-date ft)))) true)
(check-expect (ft-satisfies dave (lambda (ft) (<= 1980 (parent-date ft)))) false)
(check-expect (ft-satisfies adam (lambda (ft) (<= 1980 (parent-date ft)))) false)
(check-expect (ft-satisfies eva (lambda (ft) (<= 1980 (parent-date ft)))) true)