#lang plai ;; 21. Specific check-range function for determining whether a list ;; of temperatures is between 5 and 95 degrees (inclusive). ;; Written using foldl. (define (check-range1 temp-list) (foldl (lambda (temp acc) (and acc (<= 5 temp) (<= temp 95))) true temp-list)) (test (check-range1 empty) true) (test (check-range1 '(20 32 55 90)) true) (test (check-range1 '(20 32 97 90)) false) ;; 22. Function which converts a list of digits to the ;; corresponding number, using foldr. (define (convert1 list-digits) (foldr (lambda (digit acc) (+ (* 10 acc) digit)) 0 list-digits)) (test (convert1 empty) 0) (test (convert1 '(3 4 5)) 543) ;; 23. Functions which together compute the agerage of a ;; list of prices. (define (count lotp) (foldl (lambda (item acc) (+ 1 acc)) 0 lotp)) (define (sum lotp) (foldl (lambda (item acc) (+ item acc)) 0 lotp)) (define (average-price lotp) (if (empty? lotp) (error "division by zero") (/ (sum lotp) (count lotp)))) (test/exn (average-price empty) "by zero") (test (average-price '(3 4)) 3.5) (test (average-price '(1 2 3 4 5 6)) 3.5) ;; 24. Function for converting a list of Farenheit temperatures ;; to a list of Celsius temperatures using the map function. (define (convertFC list-Ftemps) (map (lambda (tempF) (* (/ 5 9) (- tempF 32))) list-Ftemps)) (test (convertFC empty) empty) (test (convertFC '(32 212 98.6)) '(0 100 37.0)) ;; 25. Function which uses the filter function to remove all toys ;; with a price greater then [value] from a list of toy prices. (define (eliminate-exp lotp value) (filter (lambda (item) (<= item value)) lotp)) (test (eliminate-exp '(1 2 3 4 5 6 5 4 3 2 1 20) 4) '(1 2 3 4 4 3 2 1)) ;; 26. Function which creates a function representing the ;; composition of two functions (define (compose-func f g) (lambda (x) (f (g x)))) (test ((compose-func add1 convert1) '(3 4 5)) 544) ;; 27. Two versions, one using foldr and one without, of a function ;; to convert a list of sublists of numbers to a list of numbers. (define (flatten list-of-lists) (if (empty? list-of-lists) empty (append (first list-of-lists) (flatten (rest list-of-lists))))) (test (flatten '((1 2 3) (4 5) (6 7 8))) '(1 2 3 4 5 6 7 8)) (define (flatten-foldr list-of-lists) (foldr append empty list-of-lists)) (test (flatten-foldr '((1 2 3) (4 5) (6 7 8))) '(1 2 3 4 5 6 7 8)) ;; 28. Function using foldr to divide a list into sublists which ;; are composed of adjacent equal numbers. (define (bucket alon) (foldr (lambda (item acc) (cond [(or (empty? acc) (not (= (first (first acc)) item))) (cons (cons item empty) acc)] [else (cons (cons item (first acc)) (rest acc))])) empty alon)) (test (bucket '(1 1)) '((1 1))) (test (bucket '(1 1 2 2 2 3 1 1 1 2 3 3)) '((1 1) (2 2 2) (3) (1 1 1) (2) (3 3))) ;; 29. Function which applied a function [f] to the name of every ;; person in the family-tree. (define-type family-tree [unknown] [person (name string?) (birth-year number?) (eye-color symbol?) (mother family-tree?) (father family-tree?)]) (define example-tree (person "Dave" 1977 'brown (person "Ken" 1945 'brown (unknown) (unknown)) (person "Mary Ellen" 1946 'brown (unknown) (unknown)))) (define test-tree (person "me" 1983 'blue (person "mom" 1964 'blue (unknown) (person "morgentaler" 1960 'brown (unknown) (unknown))) (unknown))) (define (tree-map tree f) (type-case family-tree tree [unknown () (unknown)] [person (n birth eye mom dad) (person (f n) birth eye (tree-map mom f) (tree-map dad f))])) (test (tree-map example-tree (lambda (s) (substring s 0 3))) (person "Dav" 1977 'brown (person "Ken" 1945 'brown (unknown) (unknown)) (person "Mar" 1946 'brown (unknown) (unknown)))) ;; 30. Function which uses tree-map to add a list name to every ;; person in a family tree. (define (add-last-name tree last-name) (tree-map tree (lambda (name) (format "~a ~a" name last-name)))) (test (add-last-name example-tree "Smith") (person "Dave Smith" 1977 'brown (person "Ken Smith" 1945 'brown (unknown) (unknown)) (person "Mary Ellen Smith" 1946 'brown (unknown) (unknown))))