;; 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-reader.ss" "lang")((modname 13-mutual-rec) (read-case-sensitive #t) (teachpacks ()) (htdp-settings #(#t constructor repeating-decimal #f #t none #f () #f))) ;; Mutual recursion (require 2htdp/image) (require 2htdp/universe) ; We had alpaca pedigrees: ; A Sex is one of: ; - "female" ; - "male" ; A Date is (make-date Year Month Day) ; where ; Year is an Integer in [1900, 2010] ; Month is an Integer in [1, 12] ; Day is an Integer in [1, 31] (define-struct date (year month day)) ; An Alpaca is one of: ; - (make-alpaca String Sex Date Color Alpaca Alpaca) ; - "unknown" (define-struct alpaca (name sex dob color sire dam)) ;; These keep track of on alpaca and its *ancestors*. We can also ;; make "descendant trees" to keep track of an alpaca and its ;; descendants. This is a non-trivially different problem, because ;; while each alpaca has exactly two parents, an alpaca may have an ;; arbitrary number of children. ;; Let's use this new data definition (unrelated to the old one): ; An AlpDT is (make-alpdt String Year Sex Color [List-of AlpDT]) ; interp. (make-alpdt n y s c l) represents an alpaca named n, born ; in y, with sex s and color c, whose children are in l. (define-struct alpdt (name dob sex color offspring)) ;; Remember what [List-of AlpDT] means: ; A [List-of AlpDT] is one of: ; - '() ; - (cons AlpDT [List-of AlpDT]) ;; Example AlpDTs: (define georgep (make-alpdt "George" 1976 "male" "black" '())) (define noelle (make-alpdt "Noelle" 1977 "female" "brown" '())) (define john (make-alpdt "John" 1983 "male" "black" '())) (define barbara (make-alpdt "Barbara" 1981 "female" "brown" '())) (define jenna (make-alpdt "Jenna" 1981 "female" "blonde" '())) (define george (make-alpdt "George" 1946 "male" "brown" (list barbara jenna))) (define jeb (make-alpdt "Jeb" 1953 "male" "brown" (list georgep noelle john))) (define neil (make-alpdt "Neil" 1955 "male" "brown" '())) (define marvin (make-alpdt "Marvin" 1956 "male" "brown" '())) (define dorothy (make-alpdt "Dorothy" 1959 "female" "red" '())) (define georgehw (make-alpdt "George" 1924 "male" "brown" (list george jeb neil marvin dorothy))) ;; This is new -- in addition to the self references, we have cycles ;; of references: AlpDT refers to [List-of AlpDT] which refers back to AlpDT. ;; This leads us to a new form of templates that also refer to each other: #; (define (process-alpdt alp) ... (alpdt-name alp) ... ... (alpdt-dob alp) ... ... (alpdt-sex alp) ... ... (alpdt-color alp) ... ... (process-loa (alpdt-offspring alp)) ...) #; (define (process-loa loa) (cond [(empty? loa) ...] [else ... (process-alpdt (first loa)) ... ... (process-loa (rest loa)) ...])) ;; Now, when we need to design a function that involves AlpDT, we base ;; it on the pair of templates, with one template turning into a main ;; function and the other a helper function: ; count-descendants : AlpDT -> Natural ; Counts all the descendants (self included) of an alpaca. ; Examples: (check-expect (count-descendants neil) 1) (check-expect (count-descendants jeb) 4) (check-expect (count-descendants georgehw) 11) ; Strategy: struct decomp (define (count-descendants alp) (add1 (count-descendants/list (alpdt-offspring alp)))) ; count-descendants/list : LoA -> Natural ; Counts all the alpacas and their descendants in a list of alpacas. ; Strategy: struct decomp (define (count-descendants/list loa) (cond [(empty? loa) 0] [else (+ (count-descendants (first loa)) (count-descendants/list (rest loa)))])) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ; red-fleeced-descendant? : AlpDT -> Boolean ; Does the given alpaca have a descendant (self included) with a red ; fleece? ; Examples: (check-expect (red-fleeced-descendant? barbara) false) (check-expect (red-fleeced-descendant? george) false) (check-expect (red-fleeced-descendant? georgehw) true) (check-expect (red-fleeced-descendant? dorothy) true) ; Strategy: struct decomp (define (red-fleeced-descendant? alp) (or (string=? (alpdt-color alp) "red") (red-fleeced-descendant/list? (alpdt-offspring alp)))) ; red-fleeced-descendant/list? : LoA -> Boolean ; Does any alpaca in the list have a red fleece or red-fleeced descendant? ; Strategy: struct decomp (define (red-fleeced-descendant/list? loa) (cond [(empty? loa) false] [else (or (red-fleeced-descendant? (first loa)) (red-fleeced-descendant/list? (rest loa)))])) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ; count-named-after : AlpDT -> Natural ; Counts all the proper descendants of the given alpaca that share ; its name. ; Examples: (check-expect (count-named-after barbara) 0) (check-expect (count-named-after george) 0) (check-expect (count-named-after georgehw) 2) ; Strategy: struct decomp (define (count-named-after alp) (count-named/list (alpdt-name alp) (alpdt-offspring alp))) ; count-named : String AlpDT -> Natural ; Counts all alpacas in the tree with the given name. ; Strategy: struct decomp (define (count-named name alp) (if (string=? name (alpdt-name alp)) (add1 (count-named/list name (alpdt-offspring alp))) (count-named/list name (alpdt-offspring alp)))) ; count-named/list : String LoA -> Natural ; Counts all alpacas in the forest with the given name. ; Strategy: struct decomp (define (count-named/list name loa) (cond [(empty? loa) 0] [else (+ (count-named name (first loa)) (count-named/list name (rest loa)))])) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ; A Drawing is (make-rect Natural Natural Color Contents) ; A Contents is a [List-of Element] ; An Element is (make-element Shape Natural Natural) ; A Shape is one of: ; - (make-circ Natural Color) ; - Drawing (define-struct rect (width height color contents)) (define-struct circ (radius color)) (define-struct element (shape x y)) ;; example drawings (and friends): (define sh1 (make-circ 10 "blue")) (define dr2 (make-rect 20 10 "yellow" empty)) (define dr3 (make-rect 100 30 "yellow" (list (make-element sh1 20 15) (make-element sh1 50 15) (make-element sh1 80 15)))) (define dr4 (make-rect 120 120 "red" (list (make-element dr3 60 60) (make-element dr2 20 15) (make-element dr2 20 30) (make-element dr2 50 15) (make-element dr2 50 30) (make-element dr2 80 15) (make-element dr2 80 30) (make-element dr2 40 90) (make-element dr2 40 105) (make-element dr2 70 90) (make-element dr2 70 105) (make-element dr2 100 90) (make-element dr2 100 105)))) #; (define (process-drawing dr ...) (... (rect-width dr) ... ... (rect-height dr) ... ... (rect-color dr) ... ... (process-contents (rect-contents dr) ...) ...)) #; (define (process-contents elts ...) (cond [(empty? elts) ...] [else (... (process-element (first elts) ...) ... ... (process-contents (rest elts) ...) ...)])) #; (define (process-element elt ...) (... (process-shape (element-shape elt) ...) ... ... (element-x elt) ... ... (element-y elt) ...)) #; (define (process-shape sh ...) (cond [(circ? sh) (... (circ-radius sh) ... ... (circ-color sh) ...)] [else ... (process-drawing sh ...) ...])) ; drawing->scene : Drawing -> Scene ; To render a Drawing. (define (drawing->scene dr) (add-contents-to-scene (rect-contents dr) (rectangle (rect-width dr) (rect-height dr) "solid" (rect-color dr)))) ; add-contents-to-scene : Contents Scene -> Scene ; To add each element in the contents of a scene to the scene. (define (add-contents-to-scene elts scene) (cond [(empty? elts) scene] [else (add-element-to-scene (first elts) (add-contents-to-scene (rest elts) scene))])) ; add-element-to-scene : Element Scene -> Scene ; To add one element to a scene. (define (add-element-to-scene elt scene) (place-image (shape->image (element-shape elt)) (element-x elt) (element-y elt) scene)) ; shape->image : Shape -> Image ; To render one shape. (define (shape->image sh) (cond [(circ? sh) (circle (circ-radius sh) "solid" (circ-color sh))] [else (drawing->scene sh)])) (check-expect (image-width (drawing->scene dr4)) 120) ; count-circles : Drawing -> Natural ; The number of circles in a drawing. (define (count-circles drawing) (count-circles/contents (rect-contents drawing))) (define (count-circles/contents contents) (cond [(empty? contents) 0] [else (+ (count-circles/element (first contents)) (count-circles/contents (rest contents)))])) (define (count-circles/element element) (count-circles/shape (element-shape element))) (define (count-circles/shape shape) (cond [(circ? shape) 1] [else (count-circles shape)])) (check-expect (count-circles dr4) 3) ; scale-drawing : Number Drawing -> Drawing ; Scales a drawing by the given factor. ; Example: ; (scale-drawing 2 {a 3-by-4 rectangle}) => {a 6-by-8 rectangle} ; Strategy: struct decomp (define (scale-drawing factor drawing) (make-rect (* factor (rect-width drawing)) (* factor (rect-height drawing)) (rect-color drawing) (scale-contents factor (rect-contents drawing)))) ; scale-contents : Number Contents -> Contents (define (scale-contents factor contents) (local [(define (scale-each element) (scale-element factor element))] (map scale-each contents))) ; scale-element : Number Element -> Element (define (scale-element factor element) (make-element (scale-shape factor (element-shape element)) (* factor (element-x element)) (* factor (element-y element)))) ; scale-shape : Number Shape -> Shape (define (scale-shape factor shape) (cond [(circ? shape) (make-circ (* factor (circ-radius shape)) (circ-color shape))] [else (scale-drawing factor shape)])) #; (define (scale-contents/no-la factor contents) (cond [(empty? contents) '()] [else (cons (scale-element factor (first contents)) (scale-contents factor (rest contents)))])) (check-expect (image-width (drawing->scene (scale-drawing 3 dr4))) 360)