#lang racket (provide hours sorted? iterate prefix? remove-all indexed-map replace subexp subexpressions) ; ******************************************************** ; Name: YOUR NAME HERE ; Email address: YOUR EMAIL HERE ; ******************************************************** ; This file may be loaded into DrRacket. ; Lines beginning with semicolons are Racket comments. ; If you are asked to write a procedure, please ; make sure it has the specified name and arguments, ; because your procedures will be tested automatically. ; You may write auxiliary procedures in addition to ; the requested one(s) -- for each of your auxiliary ; procedures, please include a comment explaining what ; it does. You may also use procedures you have written ; elsewhere in this assignment. ; Please use the predicate equal? to test equality ; of values that may not be numbers. You can use ; the predicate = for numbers. For instance: ; (= 3 4) evaluates to #f ; (equal? "hello" (string-append "he" "llo")) evaluates to #t ; ; For this assignment, please *do not* use list functions ; like `filter` and `append` from the Racket core. ; You should need *only* `cons`, `car`, `cdr`, `empty?`, `equal?`, ; `list?`, and `list`. ; If you would like to use the functionality supplied by functions ; such as `map` and `filter`, you may implement a version of the ; function yourself using recursion. ; [NOTE: the autograder does not check this criterion; we will check ; manually before finalizing grades.] ; Please submit this to Gradescope using the filename "hw1.rkt". ; ******************************************************** ; ** problem 0 ** (1 easy point) ; replace the definition of hours below to indicate ; how many hours you spent doing this assignment (define hours 0) ; ******************************************************** ; ** problem 1 ** (14 points) ; Write a procedure (sorted? lst compare?) ; which takes a list lst and returns true if the top-level items are sorted ; according to the given comparison operator, compare?. ; Examples: ; (sorted? '(1 2 3 4) <) => #t ; (sorted? '(1 2 3 4) >) => #f ; (sorted? '(1 2 3 4 4) <) => #f ; (sorted? '(1 1 1 1) =) => #t ; (sorted? '(1 1 1 1) <) => #f ; (sorted? '(1 1 1 1) <=) => #t ; (sorted? '("a" "b" "c") string<=?) => #t ; (sorted? '((1) (1 2) (1 2 3) (1 2 3 4)) (lambda (x y) (<= (length x) (length y)))) => #t ; (sorted? '((1) (1 2) (1 2 3) (1 2 3 4) (1)) (lambda (x y) (<= (length x) (length y)))) => #f ; sorted : (list-of A) (A A -> boolean) -> boolean (define sorted? empty) ; ******************************************************** ; ** problem 2 ** (14 points) ; Write a procedure (iterate start proc n) ; which executes the function proc n times, beginning with the argument ; start, and using the result of the previous function as the argument ; for the next call. It returns a list of all the results. ; (define (add5 x) (+ x 5)) ; (iterate 2 add5 10) => '(7 12 17 22 27 32 37 42 47 52) ; (iterate 0 (lambda (x) (+ x 1)) 3) => '(1 2 3) ; (iterate 1 (lambda (n) (* n 2)) 10) => '(2 4 8 16 32 64 128 256 512 1024) ; (iterate 1 (lambda (x) (* x -2)) 10) => '(-2 4 -8 16 -32 64 -128 256 -512 1024) ; (iterate 10 (lambda (n) (- n 1)) 10) => '(9 8 7 6 5 4 3 2 1 0) ; (iterate 3 (lambda (n) (+ n 2)) 10) => '(5 7 9 11 13 15 17 19 21 23) ; (iterate "a" (lambda (x) (string-append x "h")) 5) => '("ah" "ahh" "ahhh" "ahhhh" "ahhhhh") ; iterate : A (A -> A) number -> (list-of A) (define iterate empty) ; ******************************************************** ; ** problem 3 ** (14 points) ; Write a procedure (prefix? lst1 lst2) ; that takes two lists lst1 and lst2 ; and returns #t if lst1 can be obtained ; by dropping zero or more elements from ; the end of lst2. ; Otherwise, #f is returned. ; Examples: ; (prefix? '("a" "b") '("a" "b" "c")) => #t ; (prefix? '("b" "c") '("a" "b" "c")) => #f ; (prefix? '() '()) => #t ; (prefix? '() '(1 2 3)) => #t ; (prefix? '(("a" "b") ("b" "c")) '(("a" "b") ("b" "c") ("c" "d"))) => #t ; prefix : list list -> boolean (define prefix? empty) ; ******************************************************** ; ** problem 4 ** (14 points) ; Write a procedure (remove-all item lst) ; that takes an item `item` and a list `lst` ; and returns a list equal to lst with ; every top-level occurrence of item removed. ; Examples ; (remove-all 1 '(1 2 3)) => '(2 3) ; (remove-all 1 '((2 1) (4 5) (7 6))) => '((2 1) (4 5) (7 6)) ; (remove-all "a" '("f" "a" "f" "a" "b" "e" "b" "a")) => '("f" "f" "b" "e" "b") ; (remove-all '(2 1) '((3 4) (2 1) (1 2))) => '((3 4) (1 2)) ; remove-all : any list -> list (define remove-all empty) ; ******************************************************** ; ** problem 5 (14 points) ; Write a procedure (indexed-map f xs) that ; takes in a procedure (f i x) and a list xs, ; and returns a new list containing the result of calling ; (f i x) for each item x in xs, where i is the ; index at which x appears in xs (0 for the first element, ; 1 for the second, and so on). ; Examples: ; (indexed-map (lambda (n x) n) (list #t #t #t #t #t)) => '(0 1 2 3 4) ; (indexed-map + '(1 5 3)) => '(1 6 5) ; (indexed-map * '(4 5 4)) => '(0 5 8) ; (indexed-map ; (lambda (n s) (string-append (number->string (+ 1 n)) ": " s)) ; '("the" "words" "form" "a" "sentence")) => '("1: the" "2: words" "3: form" "4: a" "5: sentence") ; (indexed-map (lambda (n item) (* 2 item)) '(1 2 3)) => '(2 4 6) ; (indexed-map (lambda (n item) 0) '()) => '() ; indexed-map : (number A -> B) (list-of A) -> (list-of B) (define indexed-map empty) ; ******************************************************** ; For the following two problems, we define ; "permitted expressions" inductively as follows. ; 1) a string is a permitted expression ; 2) a list of (zero or more) permitted expressions is ; a permitted expression. ; Thus, examples of permitted expressions are ; '(), "apple", '("this" "is" "an" "expression"), '(() "apple" ("the" "apple") ("eat" ("the" "apple"))) ; ******************************************************** ; ** problem 6 ** (14 points) ; Write a procedure (replace exp1 exp2 exp3) ; that takes permitted expressions exp1, exp2 and exp3 ; and returns a permitted expression obtained by replacing ; EVERY (not just top-level) occurrence of exp1 by exp2 in exp3 ; Examples ; (replace "a" "b" '()) => () ; (replace '() "hi" '()) => "hi" ; (replace "hello" "bonjour" "hello") => "bonjour" ; (replace "a" "b" '("f" "a" "f" "a" "b" "e" "b" "a")) => '("f" "b" "f" "b" "b" "e" "b" "b") ; (replace "a" "b" '(("f" "a") ("f" ("a")))) => '(("f" "b") '("f" ("b"))) ; (replace "apple" '("red" "apple") '("big" ("round" "apple"))) => '("big" ("round" ("red" "apple"))) ; (replace "z" "a" '("f" "a" "a" "b" "e" "b")) => '("f" "a" "a" "b" "e" "b") ; (replace '("f" "a") "h" '(("f" "a") (("f" "a")) ((("f" "a"))))) => '("h" ("h") (("h"))) ; replace : permitted-expression permitted-expression permitted-expression -> permitted-expression (define replace empty) ; ******************************************************** ; ** problem 7 (14 points) ; Write a procedure (subexpressions exp) ; that takes a permitted expression exp ; and returns a list of all its "subexpressions". (struct subexp (expr location) #:transparent) ; A subexpression of a permitted expression `exp` ; is another permitted expression that can be found ; inside `exp`. The "location" of a subexpression ; is a (possibly empty) list of non-negative integers, ; identifying *where* inside `exp` the subexpression ; can be found. For example, if `exp` is the expression ; '(("the" "day") "is" (("much" "too") "short")) ; then it has many subexpressions at the following locations: ; - At location '(), we have the entire expression: '(("the" "day") "is" (("much" "too") "short")) ; - At location '(0), we have the first subexpression: '("the" "day") ; - At location '(1), we have the second subexpression: "is" ; - At location '(2), we have the third subexpression: '(("much" "too") "short") ; - At location '(0 0), we have the first subexpression of the first subexpression: "the" ; - At location '(0 1), we have the second subexpression of the first subexpression: "day" ; - At location '(2 0), we have the first subexpression of the third subexpression: '("much" "too") ; - At location '(2 1), we have the second subexpression of the third subexpression: "short" ; - At location '(2 0 0), we have the first subexpression of the first subexpression of the third subexpression: "much" ; - At location '(2 0 1), we have the second subexpression of the first subexpression of the third subexpression: "too" ; All these subexpressions can be packaged together into a list, as follows: ; (list ; (subexp '(("the" "day") "is" (("much" "too") "short")) '()) ; (subexp '("the" "day") '(0)) ; (subexp "is" '(1)) ; (subexp '(("much" "too") "short") '(2)) ; (subexp "the" '(0 0)) ; (subexp "day" '(0 1)) ; (subexp '("much" "too") '(2 0)) ; (subexp "short" '(2 1)) ; (subexp "much" '(2 0 0)) ; (subexp "too" '(2 0 1))) ; The goal of your procedure (subexpressions exp) is to take in an ; expression exp and produce such a list of `subexp` structs, recording ; the subexpression and its location within exp. ; Please also leave a comment explaining how your procedure works. ; Examples ; (Your procedure may return its answers in a different order.) ; (subexpressions '()) => (list (subexp '() '())) ; (subexpressions "apple") => (list (subexp "apple" '())) ; (subexpressions '("apple")) => (list (subexp '("apple") '()) ; (subexp "apple" '(0))) ; (subexpressions '("a" ("b" "c"))) => ; (list (subexp '("a" ("b" "c")) '()) ; (subexp "a" '(0)) ; (subexp '("b" "c") '(1)) ; (subexp "b" '(1 0)) ; (subexp "c" '(1 1))) ; subexpressions : permitted-expression -> (list-of subexp) (define subexpressions empty) ; ******************************************************** ; ******** testing, testing. 1, 2, 3 .... ; ******************************************************** ; Press Run in DrRacket, and then type (runtests) in the ; Interactions area to run automated tests on your code. (define (format-expected-actual expected actual) (format "Correct answer should be ~a. Your answer was: ~a." expected actual)) (define (approx=? a b [eps 1e-9]) (and (real? a) (real? b) (<= (abs (- (exact->inexact a) (exact->inexact b))) eps))) (struct test-result (name ok? got expected output) #:transparent) (define (test name got-thunk expected [expected-text #f]) (define expected-display (cond [expected-text expected-text] [(procedure? expected) "a value satisfying the expected predicate"] [else expected])) (with-handlers ([exn:fail? (lambda (e) (test-result name #f (list 'error (exn-message e)) expected-display (format "Error while running: ~a" (exn-message e))))]) (define got (got-thunk)) (define ok? (if (procedure? expected) (with-handlers ([exn:fail? (lambda (_e) #f)]) (expected got)) (equal? got expected))) (test-result name ok? got expected-display (format-expected-actual expected-display got)))) (define (print-test-result r) (define status (if (test-result-ok? r) "OK" "FAIL")) (printf "[~a] ~a\n" status (test-result-name r)) (when (not (test-result-ok? r)) (printf " expected: ~a\n" (test-result-expected r)) (printf " got: ~a\n" (test-result-got r)) (printf " ~a\n" (test-result-output r)))) ; helper to compare two lists disregarding order. (define (same-elements? xs ys) (and (list? xs) (list? ys) (= (length xs) (length ys)) (andmap (lambda (x) (member x ys)) xs) (andmap (lambda (y) (member y xs)) ys))) (define (runtests) (define results (list (test 'hours (lambda () hours) (lambda (x) (and (number? x) (> x 0))) "a positive number") ;; problem 1: sorted? (test 'sorted?-ascending (lambda () (sorted? '(1 2 3 4) <)) #t) (test 'sorted?-descending (lambda () (sorted? '(4 3 2 1) >)) #t) (test 'sorted?-non-strict (lambda () (sorted? '(1 2 3 4 4) <)) #f) (test 'sorted?-equal (lambda () (sorted? '(1 1 1 1) =)) #t) (test 'sorted?-lt-equal (lambda () (sorted? '(1 1 1 1) <)) #f) (test 'sorted?-strings (lambda () (sorted? '("a" "b" "c") string<=?)) #t) (test 'sorted?-list-lengths-ok (lambda () (sorted? '((1) (1 2) (1 2 3) (1 2 3 4)) (lambda (x y) (<= (length x) (length y))))) #t) (test 'sorted?-list-lengths-fail (lambda () (sorted? '((1) (1 2) (1 2 3) (1 2 3 4) (1)) (lambda (x y) (<= (length x) (length y))))) #f) (test 'sorted?-empty (lambda () (sorted? '() <)) #t) (test 'sorted?-single (lambda () (sorted? '(42) <)) #t) (test 'sorted?-two-unsorted (lambda () (sorted? '(2 1) <)) #f) (test 'sorted?-always-false (lambda () (sorted? '(1 2 3) (lambda (_a _b) #f))) #f) ;; problem 2: iterate (test 'iterate-add5 (lambda () (iterate 2 (lambda (x) (+ x 5)) 10)) '(7 12 17 22 27 32 37 42 47 52)) (test 'iterate-inc (lambda () (iterate 0 (lambda (x) (+ x 1)) 3)) '(1 2 3)) (test 'iterate-times2 (lambda () (iterate 1 (lambda (n) (* n 2)) 10)) '(2 4 8 16 32 64 128 256 512 1024)) (test 'iterate-times-neg2 (lambda () (iterate 1 (lambda (x) (* x -2)) 10)) '(-2 4 -8 16 -32 64 -128 256 -512 1024)) (test 'iterate-dec (lambda () (iterate 10 (lambda (n) (- n 1)) 10)) '(9 8 7 6 5 4 3 2 1 0)) (test 'iterate-plus2 (lambda () (iterate 3 (lambda (n) (+ n 2)) 10)) '(5 7 9 11 13 15 17 19 21 23)) (test 'iterate-strings (lambda () (iterate "a" (lambda (x) (string-append x "h")) 5)) '("ah" "ahh" "ahhh" "ahhhh" "ahhhhh")) (test 'iterate-zero (lambda () (iterate 99 add1 0)) '()) ;; problem 3: prefix? (test 'prefix?-true (lambda () (prefix? '("a" "b") '("a" "b" "c"))) #t) (test 'prefix?-false (lambda () (prefix? '("b" "c") '("a" "b" "c"))) #f) (test 'prefix?-empty1 (lambda () (prefix? '() '())) #t) (test 'prefix?-empty2 (lambda () (prefix? '() '(1 2 3))) #t) (test 'prefix?-same (lambda () (prefix? '(1 2 3) '(1 2 3))) #t) (test 'prefix?-nested (lambda () (prefix? '(("a" "b") ("b" "c")) '(("a" "b") ("b" "c") ("c" "d")))) #t) (test 'prefix?-mid-diff (lambda () (prefix? '(1 2 4) '(1 2 3 4))) #f) (test 'prefix?-longer-than-list (lambda () (prefix? '(1 2 3 4 5) '(1 2 3))) #f) ;; problem 4: remove-all (test 'remove-all-simple (lambda () (remove-all 1 '(1 2 3))) '(2 3)) (test 'remove-all-nested (lambda () (remove-all 1 '((2 1) (4 5) (7 6)))) '((2 1) (4 5) (7 6))) (test 'remove-all-strings (lambda () (remove-all "a" '("f" "a" "f" "a" "b" "e" "b" "a"))) '("f" "f" "b" "e" "b")) (test 'remove-all-lists (lambda () (remove-all '(2 1) '((3 4) (2 1) (1 2)))) '((3 4) (1 2))) (test 'remove-all-empty (lambda () (remove-all 1 '())) '()) (test 'remove-all-none (lambda () (remove-all 'z '(1 2 3))) '(1 2 3)) ;; problem 5: indexed-map (test 'indexed-map-idx (lambda () (indexed-map (lambda (n x) n) (list #t #t #t #t #t))) '(0 1 2 3 4)) (test 'indexed-map-plus (lambda () (indexed-map + '(1 5 3))) '(1 6 5)) (test 'indexed-map-mult (lambda () (indexed-map * '(4 5 4))) '(0 5 8)) (test 'indexed-map-strings (lambda () (indexed-map (lambda (n s) (string-append (number->string (+ 1 n)) ": " s)) '("the" "words" "form" "a" "sentence"))) '("1: the" "2: words" "3: form" "4: a" "5: sentence")) (test 'indexed-map-double (lambda () (indexed-map (lambda (n item) (* 2 item)) '(1 2 3))) '(2 4 6)) (test 'indexed-map-empty (lambda () (indexed-map (lambda (n item) 0) '())) '()) (test 'indexed-map-single (lambda () (indexed-map (lambda (n x) (list n x)) '(7))) '((0 7))) ;; problem 6: replace (test 'replace-empty (lambda () (replace "a" "b" '())) '()) (test 'replace-empty-to-hi (lambda () (replace '() "hi" '())) "hi") (test 'replace-self (lambda () (replace "hello" "bonjour" "hello")) "bonjour") (test 'replace-flat (lambda () (replace "a" "b" '("f" "a" "f" "a" "b" "e" "b" "a"))) '("f" "b" "f" "b" "b" "e" "b" "b")) (test 'replace-nested (lambda () (replace "a" "b" '(("f" "a") ("f" ("a"))))) '(("f" "b") ("f" ("b")))) (test 'replace-list-key (lambda () (replace '("f" "a") "h" '(("f" "a") (("f" "a")) ((("f" "a")))))) '("h" ("h") (("h")))) (test 'replace-apple (lambda () (replace "apple" '("red" "apple") '("big" ("round" "apple")))) '("big" ("round" ("red" "apple")))) (test 'replace-missing (lambda () (replace "z" "a" '("f" "a" "a" "b" "e" "b"))) '("f" "a" "a" "b" "e" "b")) (test 'replace-same (lambda () (replace "a" "a" '("a" "b" "a"))) '("a" "b" "a")) ;; problem 7: subexpressions (test 'subexpr-empty (lambda () (subexpressions '())) (lambda (xs) (same-elements? xs (list (subexp '() '())))) "a list of subexp structs for '()") (test 'subexpr-string (lambda () (subexpressions "apple")) (lambda (xs) (same-elements? xs (list (subexp "apple" '())))) "a list of subexp structs for a string") (test 'subexpr-single-list (lambda () (subexpressions '("apple"))) (lambda (xs) (same-elements? xs (list (subexp '("apple") '()) (subexp "apple" '(0))))) "subexpressions for a single-element list") (test 'subexpr-longer (lambda () (subexpressions '(("the" "day") "is" (("much" "too") "short")))) (lambda (xs) (same-elements? xs (list (subexp '(("the" "day") "is" (("much" "too") "short")) '()) (subexp '("the" "day") '(0)) (subexp "is" '(1)) (subexp '(("much" "too") "short") '(2)) (subexp "the" '(0 0)) (subexp "day" '(0 1)) (subexp '("much" "too") '(2 0)) (subexp "short" '(2 1)) (subexp "much" '(2 0 0)) (subexp "too" '(2 0 1))))) "longer nested subexpressions example") (test 'subexpr-nested-empty (lambda () (subexpressions '(("x") (() "y")))) (lambda (xs) (same-elements? xs (list (subexp '(("x") (() "y")) '()) (subexp '("x") '(0)) (subexp "x" '(0 0)) (subexp '(() "y") '(1)) (subexp '() '(1 0)) (subexp "y" '(1 1))))) "subexpressions including empty list child") (test 'subexpr-nested (lambda () (subexpressions '("a" ("b" "c")))) (lambda (xs) (same-elements? xs (list (subexp '("a" ("b" "c")) '()) (subexp "a" '(0)) (subexp '("b" "c") '(1)) (subexp "b" '(1 0)) (subexp "c" '(1 1))))) "a list of subexp structs with correct locations"))) (displayln "Running tests...") (for-each print-test-result results) (define passed (length (filter test-result-ok? results))) (printf "\nPassed ~a / ~a tests.\n" passed (length results)))