;; 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-beginner-abbr-reader.ss" "lang")((modname week4_tu_full) (read-case-sensitive #t) (teachpacks ((lib "image.ss" "teachpack" "2htdp"))) (htdp-settings #(#t constructor repeating-decimal #f #t none #f ((lib "image.ss" "teachpack" "2htdp"))))) ; a list-of-numbers is either: ; - empty, or ; - (cons number list-of-numbers) ; Q1: write the following function: ; double-list: list-of-numbers -> list-of-numbers ; inserts a duplicate of each list element x immediately following x (define (double-list lon) (cond [(empty? lon) empty] [else (append (list (first lon) (first lon)) (double-list (rest lon))) ]) ) (check-expect (double-list (list 1 2 3)) (list 1 1 2 2 3 3)) (check-expect (double-list (list 1 1)) (list 1 1 1 1)) ; A ftn is either ; - empty ; - (make-child name date eyes mom dad) ; where a child is ; - symbol name ; - number date (a year) ; - symbol eyes (a color) ; - ftn mom ; - ftn dad (define-struct child (name date eyes mom dad)) ; template: ; (define (fun-for-ftn f) ; (cond ; [(empty? f) ...] ; [else ; ... (child-name f) ... ; ... (child-date f) ... ; ... (child-eyes f) ... ; ... (fun-for-ftn (child-dad f)) ... ; ... (fun-for-ftn (child-mom f)) ... ;])) ; examples: ;; Grandparents (define Dave (make-child 'Dave 1937 'black empty empty)) (define Eva (make-child 'Eva 1934 'blue empty empty)) (define Fred (make-child 'Fred 1930 'pink empty empty)) (define Greta (make-child 'Greta 1933 'brown empty empty)) ;; Parents (define Carl (make-child 'Carl 1967 'green Eva Dave)) (define Bettina (make-child 'Bettina 1966 'green Greta Fred)) ;; Youngest Generation: (define Adam (make-child 'Adam 1990 'yellow Bettina Carl)) ; Q2: write the following function: ; tree-size: ftn -> number ; returns the total number of people in a tree (define (tree-size f) (cond [(empty? f) 0] [else (+ 1 (tree-size (child-dad f)) (tree-size (child-mom f))) ])) (check-expect (tree-size Dave) 1) (check-expect (tree-size Adam) 7) ; Q3: Write the following function: ; forget-history: ftn number -> ftn ; returns the same family tree but with all ancestors before given year removed (define (forget-history f n) (cond [(empty? f) empty] [else (cond [(< (child-date f) n) empty] [else (make-child (child-name f) (child-date f) (child-eyes f) (forget-history (child-mom f) n) (forget-history (child-dad f) n ))])])) (check-expect (forget-history Adam 1989) (make-child 'Adam 1990 'yellow empty empty)) (check-expect (forget-history Adam 1900) Adam)