├── .gitignore ├── 1-7 Fixed-Size Data ├── 2-functions and programs.rkt ├── 3-39-41.rkt ├── 3-43.rkt ├── 3-44.rkt ├── 3-47.rkt ├── 3-how to design programs.rkt ├── 4-51.rkt ├── 4-53-57.rkt ├── 4-59.rkt ├── 4-62.rkt ├── 5-74.rkt ├── 5-81.rkt ├── 5-82.rkt ├── 5-chameleon.rkt ├── 5-graphical editor 2.rkt ├── 5-graphical editor.rkt ├── 6-107-2.rkt ├── 6-107.rkt ├── 6-108.rkt ├── 6-109.rkt ├── 6-space invader game 2.rkt └── 6-space invader game.rkt ├── 14-18 Abstraction ├── 14-235-236.rkt ├── 14-238.rkt ├── 14-245.rkt ├── 14-250-252.rkt ├── 16-257-258.rkt ├── 16-262.rkt ├── 16-267-269.rkt ├── 16-270-271.rkt ├── 16-272-274.rkt ├── 17-285-291.rkt ├── 17-292-295.rkt ├── 17-299.rkt ├── for-loop.rkt └── pattern.rkt ├── 19-24 Intertwined Data ├── 310-315.rkt ├── 316-321.rkt ├── 322-327.rkt ├── 330-336.rkt ├── 338-344.rkt ├── 345-355.rkt ├── 356-359.rkt ├── 360-362.rkt ├── 363-369.rkt ├── 370-377.rkt ├── 378-383.rkt ├── 384-386.rkt ├── 387-389.rkt ├── 393-395.rkt ├── 396.rkt ├── 397-401.rkt ├── 403-409.rkt ├── 410-411.rkt └── 412.rkt ├── 25-30 Generative Recursion ├── 422-423.rkt ├── 426-430.rkt ├── 432-442.rkt ├── 445-451.rkt ├── 453-454.rkt ├── 471-473.rkt └── 479-482.rkt ├── 31-34 Accumulators ├── 490-493.rkt ├── 499.rkt ├── 500-503.rkt ├── 504-508.rkt ├── 509-510.rkt ├── 511.rkt ├── 513-518.rkt ├── 514-517.rkt ├── 522.rkt ├── 523-525.rkt ├── 526-527.rkt ├── 528.rkt └── 529.rkt ├── 8-13 Arbitrarily Large Data ├── 10-163-165.rkt ├── 10-166.rkt ├── 10-167-168-169.rkt ├── 10-170.rkt ├── 10-172.rkt ├── 10-173.rkt ├── 10-174.rkt ├── 10-175.rkt ├── 10-176.rkt ├── 10-179.rkt ├── 11-181-184.rkt ├── 11-186.rkt ├── 11-187.rkt ├── 11-188.rkt ├── 11-189.rkt ├── 11-190.rkt ├── 11-193.rkt ├── 11-194.rkt ├── 12-195-198.rkt ├── 12-199-204.rkt ├── 12-205-208.rkt ├── 12-209-211.rkt ├── 12-212-214.rkt ├── 12-215-219.rkt ├── 12-220-223.rkt ├── 12-226.228.rkt ├── 9-137-138.rkt ├── 9-140.rkt ├── 9-141.rkt ├── 9-142.rkt ├── 9-145-146.rkt ├── 9-147.rkt ├── 9-150-151.rkt ├── 9-152-153.rkt ├── 9-154.rkt ├── 9-158.rkt ├── 9-159.rkt ├── 9-160.rkt └── itunes.xml ├── LICENSE.txt ├── README.org ├── _config.yml └── prologue.rkt /.gitignore: -------------------------------------------------------------------------------- 1 | **/**/*~ 2 | **/**/*# 3 | **/**/#* 4 | -------------------------------------------------------------------------------- /1-7 Fixed-Size Data/2-functions and programs.rkt: -------------------------------------------------------------------------------- 1 | ;; The first three lines of this file were inserted by DrRacket. They record metadata 2 | ;; about the language level of this file in a form that our tools can easily process. 3 | #reader(lib "htdp-beginner-reader.ss" "lang")((modname 2function) (read-case-sensitive #t) (teachpacks ()) (htdp-settings #(#t constructor repeating-decimal #f #t none #f () #f))) 4 | (require 2htdp/image) 5 | 6 | ; exercise 11 7 | (define (distance x y) 8 | (sqrt (+ (sqr x) 9 | (sqr y)))) 10 | 11 | ; exercise 12 12 | (define (cvolume length) 13 | (* length length length)) 14 | (define (csurface length) 15 | (* length length 6)) 16 | 17 | ; exercise 13 18 | (define (string-first str) 19 | (substring str 0 1)) 20 | 21 | ;exercise 14 22 | (define (string-last str) 23 | (substring str (- (string-length str) 1) (string-length str))) 24 | 25 | ;exercise 15 26 | (define (==> sunny friday) 27 | (if (or (not sunny) friday) 28 | #true 29 | #false)) 30 | 31 | ;exercise 16 32 | (define (image-area image) 33 | (* (image-width image) 34 | (image-height image))) 35 | 36 | ;exercise 17 37 | (define (image-classify image) 38 | (cond 39 | [(< (image-height image) (image-width image)) "wide"] 40 | [(> (image-height image) (image-width image)) "tall"] 41 | [else "square"])) 42 | 43 | ;exercise 18 44 | 45 | (define (string-join x y) 46 | (string-append x "_" y)) 47 | 48 | ; exercise 19 49 | (define (string-insert str i) 50 | (string-append 51 | (substring str 0 i) 52 | "_" 53 | (substring str i (string-length str)))) 54 | 55 | ;exercise 20 56 | (define (string-delete str i) 57 | (string-append 58 | (substring str 0 i) 59 | (substring str (+ i 1) (string-length str)))) 60 | 61 | 62 | 63 | ;exercise 29 64 | (define AVR-ATTEND 120) 65 | (define AVR-PRICE 5) 66 | (define PRICE-OVER-ATTEND 150) 67 | (define DYNAMIC-COST 1.5) 68 | (define (attendees ticket-price) 69 | (- AVR-ATTEND 70 | (* (- ticket-price AVR-PRICE) 71 | PRICE-OVER-ATTEND))) 72 | (define (revenue ticket-price) 73 | (* ticket-price (attendees ticket-price))) 74 | (define (cost ticket-price) 75 | (* DYNAMIC-COST 76 | (attendees ticket-price))) 77 | (define (profit ticket-price) 78 | (- (revenue ticket-price) 79 | (cost ticket-price))) -------------------------------------------------------------------------------- /1-7 Fixed-Size Data/3-39-41.rkt: -------------------------------------------------------------------------------- 1 | ;; The first three lines of this file were inserted by DrRacket. They record metadata 2 | ;; about the language level of this file in a form that our tools can easily process. 3 | #reader(lib "htdp-beginner-reader.ss" "lang")((modname 3-39-40) (read-case-sensitive #t) (teachpacks ()) (htdp-settings #(#t constructor repeating-decimal #f #t none #f () #f))) 4 | (require 2htdp/image) 5 | (require 2htdp/universe) 6 | 7 | 8 | 9 | ;car 10 | (define WHEEL-RADIUS 5) 11 | (define WHEEL-DISTANCE (* WHEEL-RADIUS 4)) 12 | (define WHEEL (circle WHEEL-RADIUS "solid" "black")) 13 | (define BOTH-WHEELS 14 | (overlay/xy WHEEL 15 | (* 4 WHEEL-RADIUS) 16 | 0 17 | WHEEL)) 18 | (define CAR-MIDDLE 19 | (rectangle WHEEL-DISTANCE 20 | (* 3 WHEEL-RADIUS) "solid" "red")) 21 | (define CAR-BOTTOM 22 | (rectangle (* 8 WHEEL-RADIUS) 23 | (* 2 WHEEL-RADIUS) 24 | "solid" "red")) 25 | (define CAR-BODY 26 | (overlay/xy CAR-MIDDLE 27 | (- (* 2 WHEEL-RADIUS)) 28 | WHEEL-RADIUS 29 | CAR-BOTTOM)) 30 | (define CAR 31 | (overlay/xy BOTH-WHEELS 32 | (- WHEEL-RADIUS) 33 | (- (* WHEEL-RADIUS 2)) 34 | CAR-BODY)) 35 | 36 | 37 | ;background 38 | (define TREE 39 | (underlay/xy (circle WHEEL-RADIUS "solid" "green") 40 | (* 9/10 WHEEL-RADIUS) 41 | (* 3/2 WHEEL-RADIUS) 42 | (rectangle 43 | (/ WHEEL-RADIUS 5) (* 2 WHEEL-RADIUS) "solid" "brown"))) 44 | (define LAND 45 | (rectangle (* 50 WHEEL-RADIUS) 46 | (* 5 WHEEL-RADIUS) 47 | "outline" "black")) 48 | (define BACKGROUND 49 | (overlay/xy TREE 50 | (- (* 2/3 (image-width LAND))) 51 | (- (- (image-height LAND) (image-height TREE))) 52 | LAND)) 53 | 54 | 55 | ; the relevant position of the car 56 | (define Y-CAR (* 3 WHEEL-RADIUS)) 57 | 58 | ; speed 59 | (define SPEED 5) 60 | 61 | 62 | ; A WorldState is a Number. 63 | ; interpretation the number of pixels between 64 | ; the left border of the scene and the car 65 | 66 | ; WorldState -> Image 67 | ; places the image of the car ws pixels from 68 | ; the left margin of the BACKGROUND image 69 | (define (render ws) 70 | (place-image CAR ws Y-CAR BACKGROUND)) 71 | 72 | ; WorldState -> WorldState 73 | ; moves the car by 3 pixels for every clock tick 74 | ; given 20, expect 23 75 | ; given 78, expect 81 76 | (define (tock ws) 77 | (+ SPEED ws)) 78 | 79 | ; key-stroke-handler 80 | ; WorldState String -> WorldState 81 | ; for each key stroke, re-initiate the world to 0 82 | (define (stroke ws ke) 83 | 0) 84 | 85 | ; mouse-event-handler 86 | 87 | ; WorldState -> Boolean 88 | ; when the car has disappeared on the right side 89 | ; stop the animation 90 | (define (end? ws) 91 | (> (- ws (/ (image-width CAR) 2)) 92 | (image-width BACKGROUND))) 93 | 94 | 95 | ; main 96 | ; WorldState -> WorldState 97 | ; launches the program from some initial state 98 | (define (main ws) 99 | (big-bang ws 100 | [on-tick tock] 101 | [to-draw render] 102 | [on-key stroke] 103 | [stop-when end?])) -------------------------------------------------------------------------------- /1-7 Fixed-Size Data/3-43.rkt: -------------------------------------------------------------------------------- 1 | ;; The first three lines of this file were inserted by DrRacket. They record metadata 2 | ;; about the language level of this file in a form that our tools can easily process. 3 | #reader(lib "htdp-beginner-reader.ss" "lang")((modname 3-42) (read-case-sensitive #t) (teachpacks ()) (htdp-settings #(#t constructor repeating-decimal #f #t none #f () #f))) 4 | (require 2htdp/image) 5 | (require 2htdp/universe) 6 | 7 | 8 | 9 | ;car 10 | (define WHEEL-RADIUS 5) 11 | (define WHEEL-DISTANCE (* WHEEL-RADIUS 4)) 12 | (define WHEEL (circle WHEEL-RADIUS "solid" "black")) 13 | (define BOTH-WHEELS 14 | (overlay/xy WHEEL 15 | (* 4 WHEEL-RADIUS) 16 | 0 17 | WHEEL)) 18 | (define CAR-MIDDLE 19 | (rectangle WHEEL-DISTANCE 20 | (* 3 WHEEL-RADIUS) "solid" "red")) 21 | (define CAR-BOTTOM 22 | (rectangle (* 8 WHEEL-RADIUS) 23 | (* 2 WHEEL-RADIUS) 24 | "solid" "red")) 25 | (define CAR-BODY 26 | (overlay/xy CAR-MIDDLE 27 | (- (* 2 WHEEL-RADIUS)) 28 | WHEEL-RADIUS 29 | CAR-BOTTOM)) 30 | (define CAR 31 | (overlay/xy BOTH-WHEELS 32 | (- WHEEL-RADIUS) 33 | (- (* WHEEL-RADIUS 2)) 34 | CAR-BODY)) 35 | 36 | 37 | ;background 38 | (define TREE 39 | (underlay/xy (circle WHEEL-RADIUS "solid" "green") 40 | (* 9/10 WHEEL-RADIUS) 41 | (* 3/2 WHEEL-RADIUS) 42 | (rectangle 43 | (/ WHEEL-RADIUS 5) (* 2 WHEEL-RADIUS) "solid" "brown"))) 44 | (define LAND 45 | (rectangle (* 50 WHEEL-RADIUS) 46 | (* 5 WHEEL-RADIUS) 47 | "outline" "black")) 48 | (define BACKGROUND 49 | (overlay/xy TREE 50 | (- (* 2/3 (image-width LAND))) 51 | (- (- (image-height LAND) (image-height TREE))) 52 | LAND)) 53 | 54 | 55 | ; speed 56 | (define SPEED 3) 57 | 58 | ; Number -> Number 59 | ; obtains the x-distance between the car 60 | ; and the left margin of the background, 61 | ; given the clock ticks T 62 | ; given 3, expected (* 3 SPEED) 63 | (define (x-distance t) 64 | (* SPEED t)) 65 | 66 | ; Number -> Number 67 | ; obtains the y-distance between the car 68 | ; and the top margin of the background, 69 | ; given the clock ticks T 70 | (define (y-distance t) 71 | (- (/ (image-height BACKGROUND) 2) 72 | (sin t))) 73 | 74 | ; A AnimationState is a Number. 75 | ; interpretation the number of clock ticks 76 | ; since the animation started 77 | 78 | ; WorldState -> Image 79 | ; places the image of the car ws pixels from 80 | ; the left margin of the BACKGROUND image 81 | (define (render t) 82 | (place-image CAR (x-distance t) (y-distance t) BACKGROUND)) 83 | 84 | ; key-stroke-handler 85 | ; AnimationState String -> WorldState 86 | ; for each key stroke, re-initiate the world to 0 87 | (define (stroke t ke) 88 | 0) 89 | 90 | ; AnimationState -> AnimationState 91 | ; obtains the next AnimationState for every clock tick 92 | ; given 34, expected 35 93 | (define (tock t) 94 | (+ 1 t)) 95 | 96 | ; AnimationState -> Boolean 97 | ; when the car has disappeared on the right side 98 | ; stop the animation 99 | (define (end? t) 100 | (> (- (x-distance t) (/ (image-width CAR) 2)) 101 | (image-width BACKGROUND))) 102 | 103 | 104 | ; main 105 | ; AnimationState -> AnimationState 106 | ; launches the program from some initial state 107 | (define (main t) 108 | (big-bang t 109 | [on-tick tock] 110 | [to-draw render] 111 | [on-key stroke] 112 | [stop-when end?])) -------------------------------------------------------------------------------- /1-7 Fixed-Size Data/3-44.rkt: -------------------------------------------------------------------------------- 1 | ;; The first three lines of this file were inserted by DrRacket. They record metadata 2 | ;; about the language level of this file in a form that our tools can easily process. 3 | #reader(lib "htdp-beginner-reader.ss" "lang")((modname 3-44) (read-case-sensitive #t) (teachpacks ()) (htdp-settings #(#t constructor repeating-decimal #f #t none #f () #f))) 4 | (require 2htdp/image) 5 | (require 2htdp/universe) 6 | 7 | 8 | 9 | ;car 10 | (define WHEEL-RADIUS 5) 11 | (define WHEEL-DISTANCE (* WHEEL-RADIUS 4)) 12 | (define WHEEL (circle WHEEL-RADIUS "solid" "black")) 13 | (define BOTH-WHEELS 14 | (overlay/xy WHEEL 15 | (* 4 WHEEL-RADIUS) 16 | 0 17 | WHEEL)) 18 | (define CAR-MIDDLE 19 | (rectangle WHEEL-DISTANCE 20 | (* 3 WHEEL-RADIUS) "solid" "red")) 21 | (define CAR-BOTTOM 22 | (rectangle (* 8 WHEEL-RADIUS) 23 | (* 2 WHEEL-RADIUS) 24 | "solid" "red")) 25 | (define CAR-BODY 26 | (overlay/xy CAR-MIDDLE 27 | (- (* 2 WHEEL-RADIUS)) 28 | WHEEL-RADIUS 29 | CAR-BOTTOM)) 30 | (define CAR 31 | (overlay/xy BOTH-WHEELS 32 | (- WHEEL-RADIUS) 33 | (- (* WHEEL-RADIUS 2)) 34 | CAR-BODY)) 35 | 36 | 37 | ;background 38 | (define TREE 39 | (underlay/xy (circle WHEEL-RADIUS "solid" "green") 40 | (* 9/10 WHEEL-RADIUS) 41 | (* 3/2 WHEEL-RADIUS) 42 | (rectangle 43 | (/ WHEEL-RADIUS 5) (* 2 WHEEL-RADIUS) "solid" "brown"))) 44 | (define LAND 45 | (rectangle (* 50 WHEEL-RADIUS) 46 | (* 5 WHEEL-RADIUS) 47 | "outline" "black")) 48 | (define BACKGROUND 49 | (overlay/xy TREE 50 | (- (* 2/3 (image-width LAND))) 51 | (- (- (image-height LAND) (image-height TREE))) 52 | LAND)) 53 | 54 | 55 | ; the relevant position of the car 56 | (define Y-CAR (* 3 WHEEL-RADIUS)) 57 | 58 | ; speed 59 | (define SPEED 2) 60 | 61 | 62 | ; A WorldState is a Number. 63 | ; interpretation the number of pixels between 64 | ; the left border of the scene and the car 65 | 66 | ; WorldState -> Image 67 | ; places the image of the car ws pixels from 68 | ; the left margin of the BACKGROUND image 69 | (define (render ws) 70 | (place-image CAR ws Y-CAR BACKGROUND)) 71 | 72 | ; WorldState -> WorldState 73 | ; moves the car by 3 pixels for every clock tick 74 | ; given 20, expect 23 75 | ; given 78, expect 81 76 | (define (tock ws) 77 | (+ SPEED ws)) 78 | 79 | ; key-stroke-handler 80 | ; WorldState String -> WorldState 81 | ; for each key stroke, re-initiate the world to 0 82 | (define (stroke ws ke) 83 | 0) 84 | 85 | ; mouse-event-handler 86 | ; WorldState Number Number String -> WorldState 87 | ; places the car at the x-coordinate 88 | ; if the given me is "button-down" 89 | ; given 21 10 20 "enter", expected 21 90 | ; given 42 10 20 "button-down", expected 10 91 | ; given 42 10 20 "move", expected 42 92 | (define (hyper x-coordinate x-mouse y-mouse me) 93 | (if (string=? me "button-down") 94 | x-mouse 95 | x-coordinate)) 96 | 97 | ; WorldState -> Boolean 98 | ; when the car has disappeared on the right side 99 | ; stop the animation 100 | (define (end? ws) 101 | (> (- ws (/ (image-width CAR) 2)) 102 | (image-width BACKGROUND))) 103 | 104 | 105 | ; main 106 | ; WorldState -> WorldState 107 | ; launches the program from some initial state 108 | (define (main ws) 109 | (big-bang ws 110 | [on-tick tock] 111 | [to-draw render] 112 | [on-key stroke] 113 | [on-mouse hyper] 114 | [stop-when end?])) -------------------------------------------------------------------------------- /1-7 Fixed-Size Data/3-47.rkt: -------------------------------------------------------------------------------- 1 | ;; The first three lines of this file were inserted by DrRacket. They record metadata 2 | ;; about the language level of this file in a form that our tools can easily process. 3 | #reader(lib "htdp-beginner-reader.ss" "lang")((modname 3-47) (read-case-sensitive #t) (teachpacks ()) (htdp-settings #(#t constructor repeating-decimal #f #t none #f () #f))) 4 | (require 2htdp/image) 5 | (require 2htdp/universe) 6 | 7 | ; scene 8 | (define FRAME 9 | (rectangle 10 100 "outline" "black")) 10 | (define BAR 11 | (rectangle 10 100 "solid" "red")) 12 | 13 | ; Happiness -> Image 14 | ; places the happiness bar by hp pixels from 15 | ; the bottom of the frame (to the top of the bar) 16 | (define (render hp) 17 | (place-image BAR 18 | 5 19 | (- 150 hp) 20 | FRAME)) 21 | 22 | ; Happiness -> Happiness 23 | ; decreases the score by 0.1 for every clock tick 24 | ; but never falls below 0 25 | ; given 1.2, expected 1.1 26 | (define (tock hp) 27 | (if (< hp 0.1) 28 | 0 29 | (- hp 0.1))) 30 | 31 | ; Happiness String -> Happiness 32 | ; -------------------------------------------------------------------------------- /1-7 Fixed-Size Data/3-how to design programs.rkt: -------------------------------------------------------------------------------- 1 | ;; The first three lines of this file were inserted by DrRacket. They record metadata 2 | ;; about the language level of this file in a form that our tools can easily process. 3 | #reader(lib "htdp-beginner-reader.ss" "lang")((modname |3-how to design programs|) (read-case-sensitive #t) (teachpacks ()) (htdp-settings #(#t constructor repeating-decimal #f #t none #f () #f))) 4 | (require 2htdp/image) 5 | 6 | ; exercise 34 7 | ; String -> String 8 | ; returns the first character of a string str 9 | ; given: "ada", expected: "a" 10 | ; given: "world", expected: "w" 11 | (define (string-first str) 12 | (substring str 0 1)) 13 | 14 | ; exercise 35 15 | ; String -> String 16 | ; returns the last character of a string str 17 | ; given: "ada", expected: "a" 18 | ; given: "world", expected: "d" 19 | (define (string-last str) 20 | (substring str (- (string-length str) 1) (string-length str))) 21 | 22 | ; exercise 36 23 | ; Image -> Number 24 | ; returns the numbers of pixels in a given image img 25 | ; given: (circle 5 "solid" "red"), expected: 100 26 | ; given: (rectangle 20 20 "solid" "red"), expected: 400 27 | (define (image-area img) 28 | (* (image-width img) (image-height img))) 29 | 30 | ; exercise 37 31 | ; String -> String 32 | ; retursn the rest of a string str with the first character removed 33 | ; given: "ada", expected: "da" 34 | ; given: "world", expected: "orld" 35 | (define (string-rest str) 36 | (substring str 1 (string-length str))) 37 | 38 | ; exercise 38 39 | ; String -> String 40 | ; returns the rest of a string str with the last character removed 41 | ; given: "ada", expected: "ad" 42 | ; given: "world", expected: "worl" 43 | (define (string-remove-last str) 44 | (substring str 0 (- (string-length str) 1))) -------------------------------------------------------------------------------- /1-7 Fixed-Size Data/4-51.rkt: -------------------------------------------------------------------------------- 1 | ;; The first three lines of this file were inserted by DrRacket. They record metadata 2 | ;; about the language level of this file in a form that our tools can easily process. 3 | #reader(lib "htdp-beginner-reader.ss" "lang")((modname 4-51) (read-case-sensitive #t) (teachpacks ()) (htdp-settings #(#t constructor repeating-decimal #f #t none #f () #f))) 4 | (require 2htdp/image) 5 | (require 2htdp/universe) 6 | 7 | ; A TrafficLight is one of the following Strings: 8 | ; - "red" 9 | ; - "green" 10 | ; - "yellow" 11 | ; interpretation the three strings represent the three 12 | ; possible states that a traffic light may assume 13 | 14 | ; TrafficLight -> TrafficLight 15 | ; yields the next state given current state s 16 | (define (traffic-light-next s) 17 | (cond 18 | [(string=? "red" s) "green"] 19 | [(string=? "green" s) "yellow"] 20 | [(string=? "yellow" s) "red"])) 21 | 22 | ; TrafficLight -> Image 23 | (define (render s) 24 | (circle 10 "solid" s)) 25 | 26 | ; main 27 | ; simulation of traffic lights 28 | (define (traffic-light s) 29 | (big-bang s 30 | [to-draw render] 31 | [on-tick traffic-light-next])) -------------------------------------------------------------------------------- /1-7 Fixed-Size Data/4-53-57.rkt: -------------------------------------------------------------------------------- 1 | ;; The first three lines of this file were inserted by DrRacket. They record metadata 2 | ;; about the language level of this file in a form that our tools can easily process. 3 | #reader(lib "htdp-beginner-reader.ss" "lang")((modname 4-53-57) (read-case-sensitive #t) (teachpacks ()) (htdp-settings #(#t constructor repeating-decimal #f #t none #f () #f))) 4 | (require 2htdp/image) 5 | (require 2htdp/universe) 6 | 7 | (define HEIGHT 300); distance in pixels 8 | (define WIDTH 100) 9 | (define YDELTA 30) 10 | 11 | (define BACKG (empty-scene WIDTH HEIGHT)) 12 | (define ROCKET (rectangle 5 30 "solid" "red")) 13 | 14 | (define CENTER (- HEIGHT (/ (image-height ROCKET ) 2)) 15 | ) 16 | ; A LRCD (for launching rocket count down) is one of: 17 | ; - "resting" 18 | ; - a Number between -3 and -1 19 | ; - a Nonnegativenumber 20 | ; interpretation a grounded rocket, 21 | ; a number denotes the number of pixels between the 22 | ; bottom of the canvas and the rocket (its height) 23 | 24 | ; Number -> Image 25 | ; places the rocket (- CENTER n) pixels from the top of the canvas 26 | (define (show/rocket n) 27 | (place-image ROCKET 10 (- CENTER n) BACKG)) 28 | 29 | ; LRCD -> Image 30 | ; renders the state as a resting or flying rocket 31 | (define (show x) 32 | (cond 33 | [(string? x) 34 | (show/rocket 0)] 35 | [(<= -3 x -1) 36 | (place-image (text (number->string x) 20 "red") 37 | 10 (* 3/4 WIDTH) 38 | (show/rocket 0))] 39 | [(>= x 0) 40 | (show/rocket x)])) 41 | 42 | ; LRCD KeyEvent -> LRCD 43 | ; starts the count-down when space bar is pressed 44 | ; if the rocket is still resting 45 | (define (launch x ke) 46 | (cond 47 | [(string? x) (if (string=? " " ke) -3 x)] 48 | [(<= -3 x -1) x] 49 | [(>= x 0) x])) 50 | 51 | ; LRCD -> LRCD 52 | ; raises the rocket by YDELTA, 53 | ; if it is moving already 54 | (define (fly x) 55 | (cond 56 | [(string? x) x] 57 | [(<= -3 x -1) (+ 1 x)] 58 | [(>= x 0) (+ x YDELTA)])) 59 | 60 | ; LRCD -> Boolean 61 | ; ends the program when the rocket disappears 62 | ; at the top of the canvas 63 | (define (end? x) 64 | (and (number? x) (> x HEIGHT))) 65 | 66 | ; LRCD -> LRCD 67 | (define (main s) 68 | (big-bang s 69 | [to-draw show] 70 | [on-key launch] 71 | [on-tick fly 1] 72 | [stop-when end?])) -------------------------------------------------------------------------------- /1-7 Fixed-Size Data/4-59.rkt: -------------------------------------------------------------------------------- 1 | ;; The first three lines of this file were inserted by DrRacket. They record metadata 2 | ;; about the language level of this file in a form that our tools can easily process. 3 | #reader(lib "htdp-beginner-reader.ss" "lang")((modname 4-59) (read-case-sensitive #t) (teachpacks ()) (htdp-settings #(#t constructor repeating-decimal #f #t none #f () #f))) 4 | (require 2htdp/image) 5 | (require 2htdp/universe) 6 | 7 | (define RADIUS 50) 8 | 9 | (define BOARD (rectangle (* 10 RADIUS) (* 3.5 RADIUS) 10 | "outline" "black")) 11 | (define R-RING (circle RADIUS "outline" "red")) 12 | (define Y-RING (circle RADIUS "outline" "yellow")) 13 | (define G-RING (circle RADIUS "outline" "green")) 14 | (define SPACE (rectangle RADIUS RADIUS "solid" "white")) 15 | 16 | ;BACKGROUND 17 | (define BACKG (overlay (beside R-RING SPACE Y-RING SPACE G-RING) BOARD)) 18 | 19 | ; TrafficLight -> Image 20 | ; renders a light bulb according to the TrafficLight tl 21 | (define (draw/bulb tl) 22 | (circle RADIUS "solid" tl)) 23 | 24 | ; TrafficLight -> Image 25 | ; renders the current state cs as an image 26 | (define (tl-render cs) 27 | (place-image (draw/bulb cs) 28 | (* RADIUS 29 | (cond 30 | [(string=? "red" cs) 2] 31 | [(string=? "yellow" cs) 5] 32 | [(string=? "green" cs) 8])) 33 | (/ (image-height BACKG) 2) 34 | BACKG)) 35 | 36 | ; TrafficLight -> TrafficLight 37 | ; yields the next state given current state cs 38 | (define (tl-next cs) 39 | (cond 40 | [(string=? "red" cs) "green"] 41 | [(string=? "green" cs) "yellow"] 42 | [(string=? "yellow" cs) "red"])) 43 | 44 | ; TrafficLight -> TrafficLight 45 | ; simulates a clock-based American traffic light 46 | (define (traffic-light-simulation initial-state) 47 | (big-bang initial-state 48 | [to-draw tl-render] 49 | [on-tick tl-next 1])) -------------------------------------------------------------------------------- /1-7 Fixed-Size Data/4-62.rkt: -------------------------------------------------------------------------------- 1 | ;; The first three lines of this file were inserted by DrRacket. They record metadata 2 | ;; about the language level of this file in a form that our tools can easily process. 3 | #reader(lib "htdp-beginner-reader.ss" "lang")((modname 4-62) (read-case-sensitive #t) (teachpacks ()) (htdp-settings #(#t constructor repeating-decimal #f #t none #f () #f))) 4 | (require 2htdp/image) 5 | (require 2htdp/universe) 6 | 7 | (define LOCKED "locked") ; A DoorState is one of: 8 | (define CLOSED "closed") ; - Locked 9 | (define OPEN "open") ; - Closed 10 | ; - OPEN 11 | 12 | ; DoorState -> DoorState 13 | ; close the door when it is open 14 | (define (door-closer s) 15 | (if 16 | (equal? s OPEN) 17 | CLOSED 18 | s)) 19 | 20 | ; DoorState -> Image 21 | ; renders the corresponding image according to DoorState s 22 | (define (door-render s) 23 | (text s 40 "red")) 24 | 25 | ; DoorState KeyEvent -> DoorState 26 | ; manipulates the door in response to pressing a key 27 | ; given CLOSED, " ", expected OPEN 28 | ; given LOCKED, "u", expected CLOSED 29 | ; given CLOSED, "l", expected LOCKED 30 | (define (door-actions s ke) 31 | (cond 32 | [(and (equal? s LOCKED) (string=? ke "u")) CLOSED] 33 | [(and (equal? s CLOSED) (string=? ke " ")) OPEN] 34 | [(and (equal? s CLOSED) (string=? ke "l")) LOCKED] 35 | [else s])) 36 | 37 | ; DoorState -> DoorState 38 | ; simulates a door with an automatic door closer 39 | (define (door-simulation initial-state) 40 | (big-bang initial-state 41 | [on-tick door-closer 3] 42 | [on-key door-actions] 43 | [to-draw door-render])) -------------------------------------------------------------------------------- /1-7 Fixed-Size Data/5-74.rkt: -------------------------------------------------------------------------------- 1 | ;; The first three lines of this file were inserted by DrRacket. They record metadata 2 | ;; about the language level of this file in a form that our tools can easily process. 3 | #reader(lib "htdp-beginner-reader.ss" "lang")((modname 5-74) (read-case-sensitive #t) (teachpacks ()) (htdp-settings #(#t constructor repeating-decimal #f #t none #f () #f))) 4 | (require 2htdp/image) 5 | (require 2htdp/universe) 6 | 7 | (define MTS (empty-scene 100 100)) 8 | (define DOT (circle 3 "solid" "red")) 9 | 10 | ; A Posn represents the state of the world. 11 | 12 | ; Posn -> Image 13 | ; adds a red spot to MTS at p 14 | (define (scene+dot ps) 15 | (place-image DOT (posn-x ps) (posn-y ps) MTS)) 16 | 17 | ; Posn -> Posn 18 | ; increases the x-coordinate of p by 3 for every clock tick 19 | (define (x+ p) 20 | (make-posn (+ 3 (posn-x p)) (posn-y p))) 21 | 22 | ; Posn Number Number MouseEvent -> Posn 23 | ; for mouse clicks, (make-posn x y); otherwise p 24 | (define (reset-dot p x y me) 25 | (if (mouse=? me "button-down") 26 | (make-posn x y) 27 | p)) 28 | 29 | ; Posn -> Posn 30 | (define (main p0) 31 | (big-bang p0 32 | [on-tick x+] 33 | [on-mouse reset-dot] 34 | [to-draw scene+dot])) -------------------------------------------------------------------------------- /1-7 Fixed-Size Data/5-81.rkt: -------------------------------------------------------------------------------- 1 | ;; The first three lines of this file were inserted by DrRacket. They record metadata 2 | ;; about the language level of this file in a form that our tools can easily process. 3 | #reader(lib "htdp-beginner-reader.ss" "lang")((modname 5-81) (read-case-sensitive #t) (teachpacks ()) (htdp-settings #(#t constructor repeating-decimal #f #t none #f () #f))) 4 | (define-struct time [hour minute second]) 5 | ; a time is a structure: 6 | ; (make-time Number Number Number) 7 | ; interpretation the time since midnight 8 | 9 | ; time -> Number 10 | ; obtains the number of seconds that have passed since midnight 11 | ; given the time 12 | ; given (make-time 0 0 0), expected 0 13 | ; given (make-time 10 10 10), expected 36,610 14 | (define (time->seconds t) 15 | (+ (* 3600 (time-hour t)) 16 | (* 60 (time-minute t)) 17 | (time-second t))) 18 | -------------------------------------------------------------------------------- /1-7 Fixed-Size Data/5-82.rkt: -------------------------------------------------------------------------------- 1 | ;; The first three lines of this file were inserted by DrRacket. They record metadata 2 | ;; about the language level of this file in a form that our tools can easily process. 3 | #reader(lib "htdp-beginner-reader.ss" "lang")((modname 5-82) (read-case-sensitive #t) (teachpacks ()) (htdp-settings #(#t constructor repeating-decimal #f #t none #f () #f))) 4 | (define-struct letters [first second third]) 5 | ; a letters is a structure: 6 | ; (make-letters 1String 1String 1String) 7 | 8 | 9 | ; A Word is one of: 10 | ; - letters 11 | ; - #false 12 | 13 | 14 | (define a (make-letters "a" "b" "c")) 15 | (define b (make-letters "a" "b" "d")) 16 | (define c (make-letters "a" "b" "c")) 17 | (define d #false) 18 | 19 | ; letters letters -> Boolean 20 | ; compares two letters, if they're the same 21 | ; yield #true, else #false 22 | (define (compare-letters l1 l2) 23 | (and (string=? (letters-first l1) (letters-first l2)) 24 | (string=? (letters-second l1) (letters-second l2)) 25 | (string=? (letters-third l1) (letters-third l2)))) 26 | 27 | ; Word Word-> Word 28 | ; compares two words, if they agree, 29 | ; yield one of them, else yield #false 30 | (define (compare-word1 w1 w2) 31 | (if (and (letters? w1) 32 | (letters? w2) 33 | (compare-letters w1 w2)) 34 | w1 35 | #false)) 36 | 37 | (define (compare-word2 w1 w2) 38 | (and (letters? w1) (equal? w1 w2))) -------------------------------------------------------------------------------- /1-7 Fixed-Size Data/5-graphical editor 2.rkt: -------------------------------------------------------------------------------- 1 | ;; The first three lines of this file were inserted by DrRacket. They record metadata 2 | ;; about the language level of this file in a form that our tools can easily process. 3 | #reader(lib "htdp-beginner-reader.ss" "lang")((modname |5-graphical editor 2|) (read-case-sensitive #t) (teachpacks ()) (htdp-settings #(#t constructor repeating-decimal #f #t none #f () #f))) 4 | (require 2htdp/image) 5 | (require 2htdp/universe) 6 | 7 | (define-struct editor [content cursor]) 8 | ; An editor is a structture: 9 | ; (make-editor String Number) 10 | ; interpretation (make-editor s n) describes an editor 11 | ; whose visible text is s with 12 | ; the cursor n characters from the beginning 13 | 14 | (define BACK (empty-scene 200 20)) 15 | (define CURSOR (rectangle 1 20 "solid" "red")) 16 | 17 | ;;--------------------- 18 | ;; Auxiliary functions: 19 | ;;--------------------- 20 | 21 | ; editor -> String 22 | ; gets the text before the cursor 23 | (define (get-pre ed) 24 | (if (string=? (editor-content ed) "") 25 | "" 26 | (substring (editor-content ed) 0 (editor-cursor ed)))) 27 | 28 | ; editor -> String 29 | ; gets the text after the cursor 30 | (define (get-post ed) 31 | (if (string=? (editor-content ed) "") 32 | "" 33 | (substring (editor-content ed) 34 | (editor-cursor ed) 35 | (string-length (editor-content ed))))) 36 | 37 | ; editor -> Image 38 | ; renders the text and the cursor without background image 39 | (define (render-text ed) 40 | (beside (text (get-pre ed) 11 "black") 41 | CURSOR 42 | (text (get-post ed) 11 "black"))) 43 | 44 | ; String -> String 45 | ; gets the first character of String str 46 | (define (string-first str) 47 | (if (> (string-length str) 0) 48 | (substring str 0 1) 49 | "")) 50 | 51 | ; String -> String 52 | ; get the last character of String str 53 | (define (string-last str) 54 | (if (> (string-length str) 0) 55 | (substring str (- (string-length str) 1) (string-length str)) 56 | "")) 57 | 58 | ; String -> String 59 | ; gets the new string after removing the last character of the original string str 60 | (define (string-last-remove str) 61 | (if (> (string-length str) 0) 62 | (substring str 0 (- (string-length str) 1)) 63 | "")) 64 | 65 | ; String -> String 66 | ; gets the new string after chopping the first character off 67 | (define (string-rest str) 68 | (if (> (string-length str) 0) 69 | (substring str 1 (string-length str)) 70 | "")) 71 | ; editor Number -> Number 72 | ; gets the new position of cursor by Number n when pressing "left" or "right" if 73 | ; the cursor doesn't cross the boundaries of text 74 | (define (move-cursor ed n) 75 | (if (or (< (+ (editor-cursor ed) n) 0) 76 | (> (+ (editor-cursor ed) n) (string-length (editor-content ed)))) 77 | (editor-cursor ed) 78 | (+ (editor-cursor ed) n))) 79 | ;;--------------------- 80 | ;; Auxiliary functions. 81 | ;;--------------------- 82 | 83 | ; editor -> Image 84 | ; renders the editor and places the cursor by editor-cursor characters from the beginning of the text 85 | (define (render ed) 86 | (overlay/xy (render-text ed) 87 | 0 0 88 | BACK)) 89 | 90 | ; editor KeyEvent -> editor 91 | ; obtains new editor after pressing a key 92 | ; "\b" deletes the last character of the editor-pre 93 | ; "left" and "right" move the cursor to the right place (if any) 94 | ; other letter keys, such as "a" "b", adds a new character to the end of the editor-pre 95 | ; all other keys are ignored 96 | (define (edit ed ke) 97 | (cond 98 | [(key=? ke "\b") 99 | (make-editor (string-append (string-last-remove (get-pre ed)) (get-post ed)) (move-cursor ed -1))] 100 | [(key=? ke "left") 101 | (make-editor (editor-content ed) (move-cursor ed -1))] 102 | [(key=? ke "right") 103 | (make-editor (editor-content ed) (move-cursor ed 1))] 104 | [(and (= 1 (string-length ke)) 105 | (not (key=? ke "\t")) 106 | (not (key=? ke "\r")) 107 | (> 33 (string-length (editor-content ed)))) 108 | (make-editor (string-append (get-pre ed) ke (get-post ed)) 109 | (+ (editor-cursor ed) 1))] 110 | [else ed])) 111 | 112 | ; String -> editor 113 | (define (run str) 114 | (big-bang (make-editor str (string-length str)) 115 | [on-key edit] 116 | [to-draw render])) 117 | -------------------------------------------------------------------------------- /1-7 Fixed-Size Data/5-graphical editor.rkt: -------------------------------------------------------------------------------- 1 | ;; The first three lines of this file were inserted by DrRacket. They record metadata 2 | ;; about the language level of this file in a form that our tools can easily process. 3 | #reader(lib "htdp-beginner-reader.ss" "lang")((modname |5-graphical editor|) (read-case-sensitive #t) (teachpacks ()) (htdp-settings #(#t constructor repeating-decimal #f #t none #f () #f))) 4 | (require 2htdp/image) 5 | (require 2htdp/universe) 6 | 7 | (define-struct editor [pre post]) 8 | ; An Editor is a structure: 9 | ; (make-editor String String) 10 | ; interpretation (make-editor s t) describes an editor 11 | ; whose visible text is (string-appedn s t) with 12 | ; the cursor displayed between s and t 13 | 14 | (define BACK (empty-scene 200 20)) 15 | (define CURSOR (rectangle 1 20 "solid" "red")) 16 | 17 | ;;--------------------- 18 | ;; Auxiliary functions: 19 | ;;--------------------- 20 | 21 | ; editor -> Image 22 | ; renders the text and the cursor without background image 23 | (define (render-text e) 24 | (beside (text (editor-pre e) 11 "black") 25 | CURSOR 26 | (text (editor-post e) 11 "black"))) 27 | 28 | ; String -> String 29 | ; gets the first character of String str 30 | (define (string-first str) 31 | (if (> (string-length str) 0) 32 | (substring str 0 1) 33 | "")) 34 | 35 | ; String -> String 36 | ; get the last character of String str 37 | (define (string-last str) 38 | (if (> (string-length str) 0) 39 | (substring str (- (string-length str) 1) (string-length str)) 40 | "")) 41 | 42 | ; String -> String 43 | ; gets the new string after removing the last character of the original string str 44 | (define (string-last-remove str) 45 | (if (> (string-length str) 0) 46 | (substring str 0 (- (string-length str) 1)) 47 | "")) 48 | 49 | ; String -> String 50 | ; gets the new string after chopping the first character off 51 | (define (string-rest str) 52 | (if (> (string-length str) 0) 53 | (substring str 1 (string-length str)) 54 | "")) 55 | 56 | ;;--------------------- 57 | ;; Auxiliary functions. 58 | ;;--------------------- 59 | 60 | 61 | ; editor -> Image 62 | ; renders the editor and places the cursor between editor-pre and editor-post 63 | (define (render e) 64 | (overlay/xy (render-text e) 65 | 0 0 66 | BACK)) 67 | 68 | ; editor KeyEvent -> editor 69 | ; obtains new editor after pressing a key 70 | ; "\b" deletes the last character of the editor-pre 71 | ; "left" and "right" move the cursor to the right place (if any) 72 | ; other letter keys, such as "a" "b", adds a new character to the end of the editor-pre 73 | ; all other keys are ignored 74 | (define (edit edi ke) 75 | (cond 76 | [(key=? ke "\b") 77 | (make-editor (string-last-remove (editor-pre edi)) (editor-post edi))] 78 | [(key=? ke "left") 79 | (make-editor (string-last-remove (editor-pre edi)) 80 | (string-append (string-last (editor-pre edi)) (editor-post edi)))] 81 | [(key=? ke "right") 82 | (make-editor (string-append (editor-pre edi) (string-first (editor-post edi))) 83 | (string-rest (editor-post edi)))] 84 | [(and (= 1 (string-length ke)) 85 | (not (key=? ke "\t")) 86 | (not (key=? ke "\r")) 87 | (> 33 (+ (string-length (editor-pre edi)) (string-length (editor-post edi))))) 88 | (make-editor (string-append (editor-pre edi) ke) (editor-post edi))] 89 | [else edi])) 90 | 91 | ; String -> editor 92 | (define (run str) 93 | (big-bang (make-editor str "") 94 | [on-key edit] 95 | [to-draw render])) 96 | -------------------------------------------------------------------------------- /1-7 Fixed-Size Data/6-109.rkt: -------------------------------------------------------------------------------- 1 | ;; The first three lines of this file were inserted by DrRacket. They record metadata 2 | ;; about the language level of this file in a form that our tools can easily process. 3 | #reader(lib "htdp-beginner-reader.ss" "lang")((modname 6-109) (read-case-sensitive #t) (teachpacks ()) (htdp-settings #(#t constructor repeating-decimal #f #t none #f () #f))) 4 | (require 2htdp/image) 5 | (require 2htdp/universe) 6 | 7 | ;---------------------- 8 | (define AA "start, expected an 'a'") 9 | (define BB "expect 'b', 'c', or 'd'") 10 | (define DD "finished") 11 | (define ER "error, illegal key") 12 | 13 | ; A State is one of: 14 | ; - AA 15 | ; - BB 16 | ; - DD 17 | ; - ER 18 | ;----------------------- 19 | 20 | ;----------------------- 21 | (define GREEN (rectangle 100 100 "solid" "green")) 22 | (define YELLOW (rectangle 100 100 "solid" "yellow")) 23 | (define RED (rectangle 100 100 "solid" "red")) 24 | ;---------------------- 25 | 26 | ;----------------------- 27 | ; -> State 28 | (define (main s) 29 | (big-bang AA 30 | [on-key stroke] 31 | [to-draw render])) 32 | 33 | ; State KeyEvent -> State 34 | ; AA->BB when "a" pressed 35 | ; BB->BB when "b" or "c" pressed 36 | ; BB->DD when "d" pressed 37 | ; AA->ER when keys other than "a" pressed 38 | ; BB->ER when keys other than "b" "c" or "d" pressed 39 | ;(check-expect (stroke AA "a") BB) 40 | ;(check-expect (stroke AA "b") ER) 41 | ;(check-expect (stroke BB "b") BB) 42 | ;(check-expect (stroke BB "c") BB) 43 | ;(check-expect (stroke BB "d") DD) 44 | ;(check-expect (stroke BB "e") ER) 45 | ;(check-expect (stroke DD "a") DD) 46 | ;(check-expect (stroke ER "a") ER) 47 | (define (stroke s ke) 48 | (cond 49 | [(equal? s AA) 50 | (if (key=? ke "a") BB ER)] 51 | [(equal? s BB) 52 | (cond 53 | [(or (key=? ke "b") (key=? ke "c")) BB] 54 | [(key=? ke "d") DD] 55 | [else ER])] 56 | [else s])) 57 | 58 | ; State -> Image 59 | ; render the corresponding image according to specific state 60 | ; when AA and BB, show yellow 61 | ; when DD, show green 62 | ; when ER, show red 63 | ;(check-expect (render AA) YELLOW) 64 | ;(check-expect (render BB) YELLOW) 65 | ;(check-expect (render DD) GREEN) 66 | ;(check-expect (render ER) RED) 67 | (define (render s) 68 | (cond 69 | [(or (equal? s AA) (equal? s BB)) 70 | YELLOW] 71 | [(equal? s DD) GREEN] 72 | [(equal? s ER) RED])) 73 | 74 | -------------------------------------------------------------------------------- /14-18 Abstraction/14-235-236.rkt: -------------------------------------------------------------------------------- 1 | ;;=========================== 2 | 3 | ; String Los -> Boolean 4 | ; determines whether l contains the string s 5 | (define (contains? s l) 6 | (cond 7 | [(empty? l ) #false] 8 | [else (or (string=? (first l) s) 9 | (contains? s (rest l)))])) 10 | 11 | (define one-list (list "atom" "zoo" "dog")) 12 | ;;============================= 13 | ;;235 14 | 15 | ; Los -> Boolean 16 | (check-expect (contains-atom? one-list) #true) 17 | (define (contains-atom? l) 18 | (contains? "atom" l)) 19 | 20 | ; Los -> Boolean 21 | (check-expect (contains-basic? one-list) #false) 22 | (define (contains-basic? l) 23 | (contains? "basic" l)) 24 | 25 | ; Los -> Boolean 26 | (check-expect (contains-zoo? one-list) #true) 27 | (define (contains-zoo? l) 28 | (contains? "zoo" l)) 29 | 30 | ;;========================== 31 | ;; 236 32 | 33 | ;; Lon -> Lon 34 | ;; add 1 to each item on l 35 | (check-expect (add1* '( 1 2 3)) '( 2 3 4)) 36 | (define (add1* l) 37 | (cond 38 | [(empty? l) '()] 39 | [else 40 | (cons (add1 (first l)) 41 | (add1* (rest l)))])) 42 | 43 | 44 | ;; Lon -> Lon 45 | ;; adds 5 to each item on 1 46 | (check-expect (plus5 '(0 1)) '(5 6)) 47 | (define (plus5 l) 48 | (cond 49 | [(empty? l ) '()] 50 | [else (cons (+ (first l) 5) 51 | (plus5 (rest l)))])) 52 | 53 | ;;================= 54 | ;; abstraction 55 | 56 | ;; Number Lon -> Lon 57 | (define (plus* n l) 58 | (cond 59 | [(empty? l) '()] 60 | [else (cons (+ (first l) n) 61 | (plus* n (rest l)))])) 62 | 63 | ;; Lon -> Lon 64 | ;; add 1 to each item on l 65 | (check-expect (plus-1 '( 1 2 3)) '( 2 3 4)) 66 | (define (plus-1 l) 67 | (plus* 1 l)) 68 | 69 | ;; Lon -> Lon 70 | (check-expect (plus-5 '(0 5)) '(5 10)) 71 | (define (plus-5 l) 72 | (plus* 5 l)) 73 | 74 | -------------------------------------------------------------------------------- /14-18 Abstraction/14-238.rkt: -------------------------------------------------------------------------------- 1 | ;;========================== 2 | ;;238 3 | 4 | (define list1 (list 25 24 23 22 21 20 19 18 17 16 15 14 13 5 | 12 11 10 9 8 7 6 5 4 3 2 1)) 6 | (define list2 (list 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 7 | 17 18 19 20 21 22 23 24 25)) 8 | 9 | ;; Function Nelon -> Number 10 | ;; extract a number from l 11 | (define (extract f l) 12 | (cond 13 | [(empty? (rest l)) 14 | (first l)] 15 | [else (if (f (first l) 16 | (extract f (rest l))) 17 | (first l) 18 | (extract f (rest l)))])) 19 | 20 | ;; Nelon -> Number 21 | ;;(check-expect (inf-1 list1) 1) 22 | (define (inf-1 l) 23 | (extract < l)) 24 | 25 | ;; Nelon -> Number 26 | ;;(check-expect (sup-1 list2) 25) 27 | (define (sup-1 l) 28 | (extract > l)) 29 | 30 | ;; Function Nelon -> Number 31 | (define (extract2 f l) 32 | (cond 33 | [(empty? (rest l)) (first l)] 34 | [else (extract2 f 35 | (cons (f (first l) 36 | (first (rest l))) 37 | (rest (rest l))))])) 38 | 39 | ;; Nelon -> Number 40 | (check-expect (inf-2 list1) 1) 41 | (define (inf-2 l) 42 | (extract2 min l)) 43 | 44 | ;; Nelon -> Number 45 | (check-expect (sup-2 list2) 25) 46 | (define (sup-2 l) 47 | (extract2 max l)) 48 | -------------------------------------------------------------------------------- /14-18 Abstraction/14-245.rkt: -------------------------------------------------------------------------------- 1 | ;;====================== 2 | ;;245 3 | 4 | ;; Function Function -> Boolean 5 | ;; determines if two functions are equal 6 | (define (function=at-1.2-3-and-5.775? f1 f2) 7 | (and (= (f1 1.2) (f2 1.2)) 8 | (= (f1 3) (f2 3)) 9 | (= (f1 -5.775) (f2 -5.775)))) 10 | -------------------------------------------------------------------------------- /14-18 Abstraction/14-250-252.rkt: -------------------------------------------------------------------------------- 1 | ;;===================== 2 | ;;250 3 | 4 | ;; [Number -> Number] Number -> [List-of Number] 5 | ;; tabulates a number 6 | (define (tab f n) 7 | (cond 8 | [(= n 0) (list (f n))] 9 | [else (cons 10 | (f n) 11 | (tab f (sub1 n)))])) 12 | 13 | ;; Number -> [List-of Number] 14 | (define (tab-sqr n) 15 | (tab sqrt n)) 16 | 17 | ;; Number -> [List-of Number] 18 | (define (tab-tan n) 19 | (tab tan n)) 20 | 21 | 22 | ;;============== 23 | ;;251 24 | 25 | ;; [Number Number -> Number] Number [List-of Number] -> Number 26 | (define (fold f i l) 27 | (cond 28 | [(empty? l) i] 29 | [else (f (first l) 30 | (fold f i (rest l)))])) 31 | 32 | ;; [List-of Number] -> Number 33 | (check-expect (fold-plus '(1 2)) 3) 34 | (define (fold-plus l) 35 | (fold + 0 l)) 36 | 37 | ;; [List-of Number] -> Number 38 | (check-expect (fold-prod '(1 2)) 2) 39 | (define (fold-prod l) 40 | (fold * 1 l)) 41 | 42 | ;;===================== 43 | ;;252 44 | 45 | ;; [Item Item -> Result] Result [List-of Item] -> Result 46 | (define (fold2 f i l) 47 | (cond 48 | [(empty? l) i] 49 | [else (f (first l) 50 | (fold2 f i (rest l)))])) 51 | -------------------------------------------------------------------------------- /14-18 Abstraction/16-257-258.rkt: -------------------------------------------------------------------------------- 1 | ;;=================== 2 | ;;257 3 | 4 | ;; [X] N [N -> X] -> [List-of X] 5 | (check-expect (build-l*st 10 add1) 6 | (build-list 10 add1)) 7 | (define (build-l*st n f) 8 | (cond 9 | [(zero? n) '()] 10 | [else (add-at-end (f (- n 1)) (build-l*st (- n 1) f))])) 11 | 12 | ;; [X] X [List-of X] -> [List-of X] 13 | (define (add-at-end x l) 14 | (cond 15 | [(empty? l) (list x)] 16 | [else (cons (first l) 17 | (add-at-end x (rest l)))])) 18 | 19 | ;;=========================== 20 | ;;258 21 | 22 | (require 2htdp/image) 23 | 24 | (define MT (empty-scene 50 50)) 25 | ;; a Polygon is one of: 26 | ;; - (list Posn Posn Posn) 27 | ;; - (cons Posn Polygon) 28 | 29 | ;; Image Polygon -> Image 30 | ;; adds an image of p to MT 31 | (define (render-polygon img p) 32 | (local (; Image Polygon -> Image 33 | (define (connect-dots img p) 34 | (cond 35 | [(empty? (rest p)) MT] 36 | [else (render-line (connect-dots img (rest p)) 37 | (first p) 38 | (second p))])) 39 | ;; connected dots except the first and the last 40 | (define partly-connected (connect-dots MT p)) 41 | 42 | ;;Polygon -> Posn 43 | ;;extracts the last item from p 44 | (define (last p) 45 | (cond 46 | [(= 3 (length p)) (third p)] 47 | [else (last (rest p))])) )) 48 | (render-line partly-connected (first p) (last p))) 49 | -------------------------------------------------------------------------------- /14-18 Abstraction/16-262.rkt: -------------------------------------------------------------------------------- 1 | ;;===================== 2 | ;;262 3 | 4 | ;; N -> [List-of [List-of N]] 5 | (check-expect (identityM 1) (list (list 1))) 6 | (check-expect (identityM 3) '((1 0 0) 7 | (0 1 0) 8 | (0 0 1))) 9 | (define (identityM n) 10 | (local (;; the length of columns 11 | (define cols n) 12 | 13 | ;; N -> [List-of [List-of N]] 14 | (define (generate-matrix n) 15 | (cond 16 | [(zero? n) '()] 17 | [else (cons (generate-row n cols) 18 | (generate-matrix (- n 1)))])) 19 | 20 | ;; N N -> [List-of N] 21 | (define (generate-row n len) 22 | (cond 23 | [(zero? len) '()] 24 | [else (cons (if (= n len) 1 0) 25 | (generate-row n (- len 1)))]))) 26 | (generate-matrix n))) 27 | -------------------------------------------------------------------------------- /14-18 Abstraction/16-267-269.rkt: -------------------------------------------------------------------------------- 1 | ;;======================= 2 | ;;267 3 | 4 | ;; [List-of N] -> [List-of N] 5 | (check-expect (convert-euro '(1 2)) 6 | '(1.22 2.44)) 7 | (define (convert-euro l) 8 | (local (;; N -> N 9 | (define (convert-1 n) 10 | (* 1.22 n))) 11 | (map convert-1 l))) 12 | 13 | 14 | ;; [List-of Posn] -> [List-of [List-of 2N]] 15 | (check-expect (translate (list (make-posn 12 23) (make-posn 10 45))) 16 | '((12 23) (10 45))) 17 | (define (translate l) 18 | (local (;; Posn -> [List-of 2N] 19 | (define (translate-1 p) 20 | (list (posn-x p) (posn-y p)))) 21 | 22 | (map translate-1 l))) 23 | 24 | ;;==================== 25 | ;;268 26 | 27 | ;; Inventory is: 28 | (define-struct inv [name des in-pri sale-pri]) 29 | ;; name: String - name of the product 30 | ;; des: String - description of the product 31 | ;; in-pri: Number - the price when acquired 32 | ;; sale-pri: Number - recommended price of sales 33 | (define one-list-inv (list (make-inv "a" "a" 12 25) 34 | (make-inv "a" "a" 12 13) 35 | (make-inv "b" "b" 34 45))) 36 | 37 | ;; [List-of Inventory] -> [List-of Inventory] 38 | (check-expect (sort-inv one-list-inv) 39 | (list (make-inv "a" "a" 12 13) 40 | (make-inv "b" "b" 34 45) 41 | (make-inv "a" "a" 12 25))) 42 | (define (sort-inv l) 43 | (local (;; Inventory Inventory -> Boolean 44 | (define (sort-between-2 a b) 45 | (<= (diff-between-prices a) 46 | (diff-between-prices b))) 47 | 48 | ;; Inventory -> N 49 | (define (diff-between-prices i) 50 | (abs (- (inv-in-pri i) 51 | (inv-sale-pri i))))) 52 | 53 | (sort l sort-between-2))) 54 | 55 | ;;========================= 56 | ;;269 57 | 58 | ;; N [List-of Inventory] -> [List-of Inventory] 59 | (check-expect (eliminate-expensive 40 one-list-inv) 60 | (list (make-inv "a" "a" 12 25) 61 | (make-inv "a" "a" 12 13))) 62 | (define (eliminate-expensive ua l) 63 | (local (;; Inventory -> Boolean 64 | (define (not-expensive? i) 65 | (< (inv-sale-pri i) ua))) 66 | (filter not-expensive? l))) 67 | 68 | ;; Inventory [List-of Inventory] -> [List-of Inventory] 69 | (check-expect (recall (first one-list-inv) one-list-inv) 70 | (list (make-inv "b" "b" 34 45))) 71 | (define (recall ty l) 72 | (local (;; Inventory -> Boolean 73 | (define (!same-name? i) 74 | (not (string=? (inv-name i) (inv-name ty))))) 75 | (filter !same-name? l))) 76 | 77 | ;; [List-of String] [List-of String] -> [List-of String] 78 | (check-expect (selection '(1 2) '(2 3 4)) 79 | '(2)) 80 | (define (selection l1 l2) 81 | (local (;; String -> Boolean 82 | (define (in-l1? s) 83 | (member? s l1))) 84 | (filter in-l1? l2))) 85 | -------------------------------------------------------------------------------- /14-18 Abstraction/16-270-271.rkt: -------------------------------------------------------------------------------- 1 | ;;================ 2 | ;;270 3 | 4 | ;; N -> [List-of N] 5 | (check-expect (build-list1 3) '(0 1 2)) 6 | (define (build-list1 n) 7 | (local (;; N -> N 8 | (define (helper n) 9 | n)) 10 | (build-list n helper))) 11 | 12 | ;; N -> [List-of N] 13 | (check-expect (build-list2 3) '(1 2 3)) 14 | (define (build-list2 n) 15 | (local (;; N => N 16 | (define (helper n) 17 | (add1 n))) 18 | (build-list n helper))) 19 | 20 | ;; N -> [List-of N] 21 | (check-expect (build-list3 3) '(1 1/2 1/3)) 22 | (define (build-list3 n) 23 | (local (;; N -> N 24 | (define (helper n) 25 | (/ 1 (add1 n)))) 26 | (build-list n helper))) 27 | 28 | ;; N -> [List-of N] 29 | (check-expect (build-list4 3) '(0 2 4)) 30 | (define (build-list4 n) 31 | (local (;; N -> N 32 | (define (helper n) 33 | (* 2 n))) 34 | (build-list n helper))) 35 | 36 | ;; N -> [List-of [List-of N]] 37 | (check-expect (identityM 3) '((1 0 0) 38 | (0 1 0) 39 | (0 0 1))) 40 | (define (identityM n) 41 | (local (;; the length of columns 42 | (define cols n) 43 | 44 | ;; N -> [List-of N] 45 | (define (generate-row n) 46 | (generate-row-helper n 0)) 47 | 48 | ;; N N -> [List-of N] 49 | (define (generate-row-helper n i) 50 | (cond 51 | [(= i cols) '()] 52 | [else (cons (if (= n i) 1 0) 53 | (generate-row-helper n (add1 i)))]))) 54 | (build-list n generate-row))) 55 | 56 | ;; [Number -> Number] Number -> [List-of Number] 57 | (define (tab f n) 58 | (build-list n f)) 59 | 60 | 61 | ;;=========================== 62 | ;;271 63 | 64 | ;; String [List-of String] -> Boolean 65 | (check-expect (find-name? "ada" '("adaliuada")) #true) 66 | (check-expect (find-name? "ada" '("b")) #false) 67 | (define (find-name? name l) 68 | (local (;; the length of name 69 | (define len (string-length name)) 70 | ;; String -> Boolean 71 | (define (equal-or-extend? s) 72 | (if (> (string-length s) len) 73 | (string=? name (substring s 0 len)) 74 | #false))) 75 | (ormap equal-or-extend? l))) 76 | 77 | ;; [List-of String] -> Boolean 78 | ;; all strings start with "a"?? 79 | (check-expect (all-start-with-a? '("a" "ada")) #true) 80 | (check-expect (all-start-with-a? '("b" "ada")) #false) 81 | (define (all-start-with-a? l) 82 | (local (;; String -> Boolean 83 | (define (start-with-a? s) 84 | (string=? "a" (substring s 0 1)))) 85 | (andmap start-with-a? l))) 86 | 87 | ;; Number [List-of String]-> Boolean 88 | (check-expect (*no-longer-than? 2 '("a" "ad")) #true) 89 | (check-expect (*no-longer-than? 2 '("abd" "ad")) #false) 90 | (define (*no-longer-than? max-length l) 91 | (local (;; String -> Boolean 92 | (define (no-longer-than? s) 93 | (<= (string-length s) max-length))) 94 | (andmap no-longer-than? l))) 95 | -------------------------------------------------------------------------------- /14-18 Abstraction/16-272-274.rkt: -------------------------------------------------------------------------------- 1 | ;;=================== 2 | ;;272 3 | 4 | ;; [X] [List-of X] [List-of X] -> [List-of X] 5 | (check-expect (append-from-fold '(1 2) '(2 3)) (append '(1 2) '(2 3))) 6 | (define (append-from-fold l1 l2) 7 | (foldr cons l2 l1 )) 8 | 9 | ;; [List-of Number] -> Number 10 | (check-expect (sum-from-fold '( 1 2)) 3) 11 | (define (sum-from-fold l) 12 | (foldr + 0 l)) 13 | 14 | ;; [List-of Number] -> Number 15 | (check-expect (product-from-fold '( 1 2)) 2) 16 | (define (product-from-fold l) 17 | (foldr * 1 l)) 18 | 19 | 20 | ;;======================= 21 | ;;273 22 | 23 | ;; [X Y] [X -> Y] [List-of X] -> [List-of Y] 24 | (check-expect (map-from-fold add1 '(1 2)) 25 | (map add1 '( 1 2))) 26 | (define (map-from-fold f l) 27 | (local (;; X [List-of Y] -> [List-of Y] 28 | (define (join x ly) 29 | (cons (f x) ly))) 30 | (foldr join '() l))) 31 | 32 | 33 | ;;===================== 34 | ;;274 35 | 36 | ;; String -> [List-of String] 37 | (check-expect (prefixes "ada") '("a" "ad" "ada")) 38 | (define (prefixes s) 39 | (local (;; Number -> String 40 | (define (get-prefix n) 41 | (substring s 0 (add1 n)))) 42 | (build-list (string-length s) get-prefix))) 43 | 44 | ;; String -> [List-of String] 45 | (check-expect (suffixes "ada") '("ada" "da" "a")) 46 | (define (suffixes s) 47 | (local ((define len (string-length s)) 48 | ;; Number -> String 49 | (define (get-suffix n) 50 | (substring s n len))) 51 | (build-list len get-suffix))) 52 | -------------------------------------------------------------------------------- /14-18 Abstraction/17-292-295.rkt: -------------------------------------------------------------------------------- 1 | ;;=================== 2 | ;;292 3 | 4 | ;; [X X -> Boolean] [NEList-of X] -> Boolean 5 | (check-expect (sorted? < '(1 2 3)) #true) 6 | (check-expect (sorted? < '(2 1 3)) #false) 7 | 8 | (define (sorted? cmp l) 9 | (cond 10 | [(empty? (rest l)) #true] 11 | [else (and (if (cmp (first l) (first (rest l))) 12 | #true 13 | #false) 14 | (sorted? cmp (rest l)))])) 15 | 16 | ;;======================== 17 | ;;293 18 | 19 | ;; X -> [[Maybe List-of X] -> Boolean] 20 | (define (found? x l0) 21 | (lambda (l) 22 | (if (list? l) 23 | (equal? x (first l)) 24 | (andmap (lambda (i) (not (equal? i x))) l0)))) 25 | 26 | ;; X [List-of X] -> [Maybe [List-of X]] 27 | ;; returns the first sublist of l that starts 28 | ;; with x, #false otherwise 29 | (check-satisfied (find 2 '(1 2 3)) (found? 2 '(1 2 3))) 30 | (check-satisfied (find 2 '(1 4 3)) (found? 2 '(1 4 3))) 31 | (define (find x l) 32 | (cond 33 | [(empty? l) #false] 34 | [else 35 | (if (equal? (first l) x) l (find x (rest l)))])) 36 | 37 | ;;====================================== 38 | ;;294 39 | 40 | ;; X [List-of X] -> [[Maybe N] -> Boolean] 41 | (define (is-index? x l) 42 | (lambda (i) 43 | (if (boolean? i) 44 | (andmap (lambda (n) (not (equal? n x))) l) 45 | (local ((define (is-x? i l0) 46 | (cond 47 | [(zero? i) (equal? x (first l0))] 48 | [else (is-x? (sub1 i) (rest l0))]))) 49 | (is-x? i l)) 50 | ))) 51 | 52 | ;; X [List-of X] -> [Maybe N] 53 | ;; determine the index of the first occurrence 54 | ;; of x in l, #false otherwise 55 | (check-satisfied (index 2 '(1 2 3)) (is-index? 2 '(1 2 3))) 56 | (check-satisfied (index 2 '(1 4 3)) (is-index? 2 '(1 4 3))) 57 | (define (index x l) 58 | (cond 59 | [(empty? l) #false] 60 | [else (if (equal? (first l) x) 61 | 0 62 | (local ((define i (index x (rest l)))) 63 | (if (boolean? i) i (+ i 1))))])) 64 | 65 | ;;=============================== 66 | ;;295 67 | 68 | (define WIDTH 300) 69 | (define HEIGHT 300) 70 | 71 | ;; N -> [[List-of Posn] -> Boolean] 72 | (define (n-inside-playground? n) 73 | (lambda (l) 74 | (and (= n (length l)) 75 | (andmap (lambda (p) (and (< -1 (posn-x p) WIDTH) 76 | (< -1 (posn-y p) HEIGHT))) 77 | l)))) 78 | 79 | ;; N -> [List-of Posn] 80 | ;; generate n random Posns in [0,WIDTH) by [0,HEIGHT) 81 | (check-satisfied (random-posns 3) 82 | (n-inside-playground? 3)) 83 | (define (random-posns n) 84 | (build-list 85 | n 86 | (lambda ( i ) 87 | (make-posn (random WIDTH) (random HEIGHT))))) 88 | ;;this function cannot check if the list is random. 89 | -------------------------------------------------------------------------------- /14-18 Abstraction/17-299.rkt: -------------------------------------------------------------------------------- 1 | ;;================== 2 | ;;299 3 | 4 | ;; the sets of all odd numbers 5 | ;; N -> Boolean 6 | (define (odd-numbers n) 7 | (= 1 (/ n 2))) 8 | 9 | ;; the set of all even numbers 10 | ;; N -> Boolean 11 | (define (even-numbers n) 12 | (zero? (/ n 2))) 13 | 14 | ;; the set of all numbers divisible by 10 15 | ;; N -> Boolean 16 | (define (divisible-by-10 n) 17 | (zero? (/ n 10))) 18 | 19 | ;; Set Element -> Set 20 | (define (add-element s e) 21 | (lambda (x) 22 | (or (s x) 23 | (equal? x e)))) 24 | 25 | ;; Set Set -> Set 26 | (define (union s1 s2) 27 | (lambda (x) 28 | (or (s1 x) 29 | (s2 x)))) 30 | 31 | ;; Set Set -> Set 32 | (define (intersect s1 s2) 33 | (lambda (x) 34 | (and (s1 x) 35 | (s2 x)))) 36 | -------------------------------------------------------------------------------- /14-18 Abstraction/for-loop.rkt: -------------------------------------------------------------------------------- 1 | (require 2htdp/abstraction) 2 | ;;======================== 3 | ;;305 4 | 5 | ;; [List-of Number] -> [List-of Number] 6 | (check-expect (convert-euro '(1 2)) 7 | '(1.22 2.44)) 8 | (define (convert-euro l) 9 | (for/list ( [x l] ) (* 1.22 x))) 10 | 11 | ;;======================= 12 | ;;306 13 | 14 | ;; N -> [List-of N] 15 | (check-expect (build-list1 3) '(0 1 2)) 16 | (define (build-list1 n) 17 | (for/list ( [i n] ) i)) 18 | 19 | ;; N -> [List-of N] 20 | (check-expect (build-list2 3) '(1 2 3)) 21 | (define (build-list2 n) 22 | (for/list ( [i n] ) (add1 i))) 23 | 24 | ;; N -> [List-of N] 25 | (check-expect (build-list3 3) '(1 1/2 1/3)) 26 | (define (build-list3 n) 27 | (for/list ( [i n] ) (/ 1 (add1 i)))) 28 | 29 | ;; N -> [List-of N] 30 | (check-expect (build-list4 3) '(0 2 4)) 31 | (define (build-list4 n) 32 | (for/list ( [i n] ) (* 2 i))) 33 | 34 | ;; N -> [List-of [List-of N]] 35 | (check-expect (identityM 3) '((1 0 0) 36 | (0 1 0) 37 | (0 0 1))) 38 | (define (identityM n) 39 | (local ((define cols n) 40 | ;; N N -> [List-of N] 41 | (define (generate-row-helper n i) 42 | (cond 43 | [(= i cols) '()] 44 | [else (cons (if (= n i) 1 0) 45 | (generate-row-helper n (add1 i)))]))) 46 | (for/list ( [i n] ) (generate-row-helper i 0)))) 47 | 48 | ;;======================== 49 | ;;307 50 | 51 | ;; String [List-of String] -> Boolean 52 | (check-expect (find-name? "ada" '("adaliuada")) #true) 53 | (check-expect (find-name? "ada" '("b")) #false) 54 | (define (find-name? name l) 55 | (local ((define len (string-length name))) 56 | (for/or ([i l]) (if (>= (string-length i) len) 57 | (string=? name (substring i 0 len)) 58 | #false)))) 59 | 60 | ;; Number [List-of String]-> Boolean 61 | (check-expect (*no-longer-than? 2 '("a" "ad")) #true) 62 | (check-expect (*no-longer-than? 2 '("abd" "ad")) #false) 63 | (define (*no-longer-than? max-length l) 64 | (for/and ([i l]) (<= (string-length i) max-length))) 65 | -------------------------------------------------------------------------------- /14-18 Abstraction/pattern.rkt: -------------------------------------------------------------------------------- 1 | (require 2htdp/abstraction) 2 | 3 | ;;====================== 4 | ;;308 5 | (define-struct phone [area switch four]) 6 | 7 | ;; [List-of Phone] -> [List-of Phone] 8 | (check-expect (replace (list (make-phone 713 234 1234) (make-phone 713 456 6789))) (list (make-phone 281 234 1234) (make-phone 281 456 6789))) 9 | (check-expect (replace (list (make-phone 613 234 1234) (make-phone 713 456 6789))) (list (make-phone 613 234 1234) (make-phone 281 456 6789))) 10 | (define (replace lop) 11 | (match lop 12 | ['() '()] 13 | [(cons (phone 713 switch four) tail) 14 | (cons (make-phone 281 switch four) (replace tail))] 15 | [(cons x tail) (cons x (replace tail))])) 16 | 17 | ;;========================== 18 | ;;309 19 | ;; [List-of [List-of String]] -> [List-of Number] 20 | ;; determines the number of words on each line 21 | (check-expect (words-on-line '(("a" "b") ("c"))) '(2 1)) 22 | (define (words-on-line lls) 23 | (match lls 24 | ['() '()] 25 | [(cons head tail) 26 | (cons (length head) (words-on-line tail))])) 27 | -------------------------------------------------------------------------------- /19-24 Intertwined Data/310-315.rkt: -------------------------------------------------------------------------------- 1 | (require 2htdp/abstraction) 2 | 3 | (define-struct no-parent []) 4 | (define NP (make-no-parent)) 5 | (define-struct child [father mother name date eyes]) 6 | ;;a FT (short for family tree) is one of: 7 | ;; - NP 8 | ;; - (make-child FT FT String N String) 9 | 10 | ;; Oldest Generation: 11 | (define Carl (make-child NP NP "Carl" 1926 "green")) 12 | (define Bettina (make-child NP NP "Bettina" 1926 "green")) 13 | 14 | ;; Middle Generation: 15 | (define Adam (make-child Carl Bettina "Adam" 1950 "hazel")) 16 | (define Dave (make-child Carl Bettina "Dave" 1955 "black")) 17 | (define Eva (make-child Carl Bettina "Eva" 1965 "blue")) 18 | (define Fred (make-child NP NP "Fred" 1966 "pink")) 19 | 20 | ;; Youngest Generation: 21 | (define Gustav (make-child Fred Eva "Gustav" 1988 "brown")) 22 | 23 | ;; a FF (short for family forest) is one of: 24 | ;; - '() 25 | ;; - (cons FT FF) 26 | (define ff1 (list Carl Bettina)) 27 | (define ff2 (list Fred Eva)) 28 | (define ff3 (list Fred Eva Carl)) 29 | 30 | ;; FT -> Boolean 31 | ;; does a-ftree contain a child 32 | ;; structure with "blue" in the eyes field 33 | (check-expect (blue-eyed-child? Carl) #false) 34 | (check-expect (blue-eyed-child? Gustav) #true) 35 | 36 | (define (blue-eyed-child? a-ftree) 37 | (cond 38 | [(no-parent? a-ftree) #false] 39 | [else (or (string=? (child-eyes a-ftree) "blue") 40 | (blue-eyed-child? (child-father a-ftree)) 41 | (blue-eyed-child? (child-mother a-ftree)))])) 42 | ;;=========================== 43 | ;;310 44 | 45 | ;; FT -> Number 46 | ;; counts the child knots in the family tree ftree 47 | (check-expect (count-persons Gustav) 5) 48 | (check-expect (count-persons Carl) 1) 49 | (define (count-persons ftree) 50 | (match ftree 51 | [(no-parent) 0] 52 | [(child father mother name date eyes) 53 | (+ 1 (count-persons father) (count-persons mother))])) 54 | 55 | ;;================================= 56 | ;;311 57 | 58 | ;; FT -> Number 59 | ;; sums the ages of all child structures in the ftree 60 | (define (sum-ages ftree present) 61 | (match ftree 62 | [(no-parent) 0] 63 | [(child father mother name date eyes) 64 | (+ (- present date) (sum-ages father present) (sum-ages mother present))])) 65 | 66 | ;; FT -> Number 67 | ;; computes the average age of all child structures in the ftree 68 | (define (average-age ftree) 69 | (/ (sum-ages ftree) (count-persons ftree))) 70 | 71 | ;;================================== 72 | ;;312 73 | 74 | ;; FT -> [List-of String] 75 | ;; gets a list of eye colors in the tree 76 | (check-expect (eye-colors Carl) '("green")) 77 | (check-expect (eye-colors Dave) '("black" "green" "green")) 78 | (define (eye-colors ftree) 79 | (match ftree 80 | [(no-parent) '()] 81 | [(child father mother name date eyes) 82 | (cons eyes (append (eye-colors father) (eye-colors mother)))])) 83 | 84 | ;;================================= 85 | ;;313 86 | 87 | ;; FT -> Boolean 88 | ;; determines if any of ancestors of the ftree has blue eyes 89 | (check-expect (blue-eyed-ancestor? Eva) #false) 90 | (check-expect (blue-eyed-ancestor? Gustav) #true) 91 | (define (blue-eyed-ancestor? ftree) 92 | (match ftree 93 | [(no-parent) #false] 94 | [(child father mother name date eyes) 95 | (or (blue-eyed-child? father) (blue-eyed-child? mother))])) 96 | 97 | ;;================ 98 | ;;314 99 | 100 | ;; FF -> Boolean 101 | ;; does the forest contain any child with "blue" eyes? 102 | (check-expect (blue-eyed-child-in-forest? ff1) #false) 103 | (check-expect (blue-eyed-child-in-forest? ff2) #true) 104 | (check-expect (blue-eyed-child-in-forest? ff3) #true) 105 | (define (blue-eyed-child-in-forest? forest) 106 | (ormap blue-eyed-child? forest)) 107 | 108 | ;;=========================== 109 | ;;315 110 | 111 | ;; FF -> Number 112 | (define (average-age-in-forest forest present) 113 | (/ (foldl (lambda (x y) (+ (sum-ages x present) y)) 0 forest) 114 | (foldl (lambda (x y) (+ (count-persons x) y)) 0 forest))) 115 | -------------------------------------------------------------------------------- /19-24 Intertwined Data/316-321.rkt: -------------------------------------------------------------------------------- 1 | ;; An S-expr is one of: 2 | ;; – Atom 3 | ;; – SL 4 | 5 | ;; An Atom is one of: 6 | ;; – String 7 | ;; – Number 8 | ;; – Symbol 9 | 10 | ;; An SL is one of: 11 | ;; – '() 12 | ;; – (cons S-expr SL) 13 | 14 | ;;======================== 15 | ;;316 16 | 17 | ;; Any -> Boolean 18 | ;; determines if the given thing is an atom 19 | (define (atom? x) 20 | (or (string? x) 21 | (number? x) 22 | (symbol? x))) 23 | 24 | ;;======================== 25 | ;;317 26 | 27 | ;; S-expr Symbol -> N 28 | ;; counts all occurences of sy in sexp 29 | (check-expect (count 'world 'hello) 0) 30 | (check-expect (count '(world hello) 'hello) 1) 31 | (define (count sexp sy) 32 | (local (;; Atom -> N 33 | (define (count-atom a) 34 | (cond 35 | [(string? a) 0] 36 | [(number? a) 0] 37 | [(symbol? a) (if (symbol=? sy a) 1 0)])) 38 | 39 | ;; SL -> N 40 | (define (count-sl sl) 41 | (cond 42 | [(empty? sl) 0] 43 | [else 44 | (+ (count (first sl) sy) (count-sl (rest sl)))]))) 45 | (cond 46 | [(atom? sexp) (count-atom sexp)] 47 | [else (count-sl sexp)]))) 48 | 49 | 50 | ;;============================= 51 | ;;318 52 | 53 | ;; S-expr -> N 54 | ;; determines the depth of sexp 55 | (check-expect (depth 10) 1) 56 | (check-expect (depth '( "sd" 34)) 2) 57 | (check-expect (depth '((21 12))) 3) 58 | (check-expect (depth '( "sd" 34 (12 er))) 3) 59 | (define (depth sexp) 60 | (local (;; Atom -> N 61 | (define (depth-atom a) 1) 62 | 63 | ;; SL -> N 64 | (define (depth-sl l) 65 | (cond 66 | [(empty? l) 1] 67 | [else (max (depth (first l)) 68 | (depth-sl (rest l)))]))) 69 | (cond 70 | [(atom? sexp) (depth-atom sexp)] 71 | [else (add1 (depth-sl sexp))]))) 72 | 73 | ;;====================== 74 | ;;319 75 | 76 | ;; S-expr Atom Atom -> S-expr 77 | ;; replaces all occurences of old with new in sexp 78 | (check-expect (substitute "as" "as" "ad") "ad") 79 | (check-expect (substitute '("as" 1 2) "as" "ad") '("ad" 1 2)) 80 | (check-expect (substitute '("as" 1 2 ("as")) "as" "ad") '("ad" 1 2 ("ad"))) 81 | (define (substitute sexp old new) 82 | (local (;; Atom -> Atom 83 | (define (sub-atom a) 84 | (if (equal? a old) new a)) 85 | 86 | ;; SL -> SL 87 | (define (sub-sl l) 88 | (cond 89 | [(empty? l) l] 90 | [else (cons (substitute (first l) old new) 91 | (sub-sl (rest l)))]))) 92 | (cond 93 | [(atom? sexp) (sub-atom sexp)] 94 | [else (sub-sl sexp)]))) 95 | 96 | ;;========================== 97 | ;;320 98 | 99 | ;; a S-expr is one of: 100 | ;; - String 101 | ;; - Number 102 | ;; - Symbol 103 | ;; - [List-of S-expr] 104 | 105 | ;; S-expr [String or Number or Symbol] -> Number 106 | (check-expect (count.v2 'world 'hello) 0) 107 | (check-expect (count.v2 '(world hello) 'hello) 1) 108 | (define (count.v2 sexp sy) 109 | (local (;; [List-of S-expr] -> Number 110 | (define (count-sl l) 111 | (cond 112 | [(empty? l) 0] 113 | [else (+ (count.v2 (first l) sy) 114 | (count-sl (rest l)))]))) 115 | (cond 116 | [(list? sexp) (count-sl sexp)] 117 | [else (if (equal? sexp sy) 1 0)]))) 118 | 119 | ;; a S-expr is one of: 120 | ;; - '() 121 | ;; - String 122 | ;; - Number 123 | ;; - Symbol 124 | ;; - [NEList-of S-expr] 125 | (check-expect (count.v2 'world 'hello) 0) 126 | (check-expect (count.v2 '(world hello) 'hello) 1) 127 | (define (count.v3 sexp sy) 128 | (cond 129 | [(empty? sexp) 0] 130 | [(list? sexp) 131 | (foldl (lambda (x y) (+ (count.v3 x sy) y)) 0 sexp)] 132 | [else (if (equal? sexp sy) 1 0)])) 133 | 134 | 135 | ;;================== 136 | ;;321 137 | 138 | ;; an Atom is: 139 | ;; - Any Item 140 | 141 | ;; a S-expr is one of: 142 | ;; - Atom 143 | ;; - SL 144 | 145 | ;; a SL is one of: 146 | ;; - '() 147 | ;; - (cons S-expr SL) 148 | 149 | -------------------------------------------------------------------------------- /19-24 Intertwined Data/322-327.rkt: -------------------------------------------------------------------------------- 1 | (require 2htdp/abstraction) 2 | (define-struct no-info []) 3 | (define NONE (make-no-info)) 4 | 5 | (define-struct node [ssn name left right]) 6 | ;; a BinaryTree (short for BT) is one of: 7 | ;; - None 8 | ;; - (make-node Number Symbol BT BT) 9 | 10 | (define bt1 (make-node 15 'd NONE (make-node 24 'i NONE NONE))) 11 | (define bt2 (make-node 15 'd (make-node 87 'h NONE NONE) NONE)) 12 | 13 | ;;=========================== 14 | ;;322 15 | 16 | ;; BT Number -> Boolean 17 | ;;(check-expect (contains-bt? bt1 87) #false) 18 | ;;(check-expect (contains-bt? bt2 87) #true) 19 | (define (contains-bt? bt n) 20 | (match bt 21 | [(no-info) #false] 22 | [(node nu sy bt1 bt2) 23 | (or (= nu n) 24 | (contains-bt? bt1 n) 25 | (contains-bt? bt2 n))])) 26 | 27 | ;;========================== 28 | ;;323 29 | 30 | ;; BT Number -> [Maybe [Symbol]] 31 | (check-expect (search-bt bt1 87) #false) 32 | (check-expect (search-bt bt2 87) 'h) 33 | (define (search-bt b n) 34 | (match b 35 | [(no-info) #false] 36 | [(node nu s b1 b2) 37 | (if (= nu n) s 38 | (if (contains-bt? b1 n) 39 | (search-bt b1 n) 40 | (search-bt b2 n)))])) 41 | 42 | ;;======================= 43 | ;;324 44 | 45 | ;;BT -> [List-of Number] 46 | (check-expect (inorder bt1) '(15 24)) 47 | (check-expect (inorder bt2) '(87 15)) 48 | (define (inorder bt) 49 | (match bt 50 | [(no-info) '()] 51 | [(node nu sy bt1 bt2) 52 | (append (inorder bt1) (list nu) (inorder bt2))])) 53 | 54 | ;;======================== 55 | ;;325 56 | 57 | ;; BST N -> [Symbol/no-info] 58 | (define (search-bst bt n) 59 | (match bt 60 | [(no-info) bt] 61 | [(node nu sy bt1 bt2) 62 | (if (= nu n) sy 63 | (if (> n nu) 64 | (search-bst bt1 n) 65 | (search-bst bt2 n)))])) 66 | 67 | ;;===================== 68 | ;;326 69 | 70 | ;; BST Number Symbol -> BST 71 | (define (create-bst bst n s) 72 | (match bst 73 | [(no-info) (make-node n s NONE NONE)] 74 | [(node num sym bs bl) 75 | (cond 76 | [(< n num) (make-node num sym (create-bst bs n s) bl)] 77 | [(> n num) (make-node num sym bs (create-bst bl n s))])])) 78 | 79 | ;;============================= 80 | ;;327 81 | 82 | (define one-list '((99 o) 83 | (77 l) 84 | (24 i) 85 | (10 h) 86 | (95 g) 87 | (15 d) 88 | (89 c) 89 | (29 b) 90 | (63 a))) 91 | ;; [List-of [List Number Symbol]] -> BST 92 | (define (create-bst-from-list l) 93 | (match l 94 | ['() NONE] 95 | [(cons head tail) 96 | (create-bst (create-bst-from-list tail) (first head) (second head))])) 97 | 98 | ;; version 2 99 | (define (create-bst-from-list.v2 l) 100 | (foldr (lambda (i bst) 101 | (create-bst bst (first i) (second i))) NONE l)) 102 | 103 | ;; version 3 104 | (define (create-bst-from-list.v3 l) 105 | (foldl (lambda (i bst) 106 | (create-bst bst (first i) (second i))) NONE l)) 107 | -------------------------------------------------------------------------------- /19-24 Intertwined Data/330-336.rkt: -------------------------------------------------------------------------------- 1 | (require 2htdp/abstraction) 2 | 3 | ;;====================== 4 | ;;330 5 | 6 | ;; a Dir.v1 (short for directory) is one of: 7 | ;; - '() 8 | ;; - (cons File.v1 Dir.v1) 9 | ;; - (cons Dir.v1 Dir.v1) 10 | 11 | ;; a File.v1 is a String 12 | 13 | (define part1 "part1-99") 14 | (define part2 "part2-52") 15 | (define part3 "part3-17") 16 | (define hang "hang-8") 17 | (define draw "draw-2") 18 | (define read1 "read!-10") 19 | (define read2 "read!-19") 20 | (define Text (list part1 part2 part3)) 21 | (define Code (list hang draw)) 22 | (define Docs (list read2)) 23 | (define Libs (list Code Docs)) 24 | (define TS (list Text read1 Libs)) 25 | 26 | 27 | ;;=========================== 28 | ;;331 29 | 30 | ;; Dir.v1 -> Number 31 | ;; counts how many files a d contains 32 | (check-expect (how-many.v1 TS) 7) 33 | (define (how-many.v1 d) 34 | (foldl (lambda (x y) 35 | (+ y (if (string? x) 1 (how-many.v1 x)))) 36 | 0 d)) 37 | 38 | ;;====================== 39 | ;;332 40 | 41 | ;; a Dir.v2 is a structure: 42 | (define-struct dir [name content]) 43 | ;; - (make-dir String LOFD) 44 | 45 | ;; a LOFD (short for list of files and directories) is one of: 46 | ;; - '() 47 | ;; - (cons File.v2 LOFD) 48 | ;; - (cons Dir.v2 LOFD) 49 | 50 | ;; A File.v2 is a String 51 | 52 | (define v2.part1 "part1-99") 53 | (define v2.part2 "part2-52") 54 | (define v2.part3 "part3-17") 55 | (define v2.hang "hang-8") 56 | (define v2.draw "draw-2") 57 | (define v2.read1 "read!-10") 58 | (define v2.read2 "read!-19") 59 | (define text (make-dir "text" (list v2.part1 v2.part2 v2.part3))) 60 | (define code (make-dir "code" (list v2.hang v2.draw))) 61 | (define docs (make-dir "docs" (list v2.read2))) 62 | (define libs (make-dir "libs" (list code docs))) 63 | (define ts (make-dir "ts" (list text v2.read1 libs))) 64 | 65 | 66 | ;;========================== 67 | ;;333 68 | 69 | ;; Dir.v2 -> Number 70 | ;; counts how many files a d contains 71 | (check-expect (how-many.v2 ts) 7) 72 | (define (how-many.v2 d) 73 | (foldl (lambda (x y) 74 | (+ y (if (string? x) 1 (how-many.v2 x)))) 75 | 0 (dir-content d))) 76 | 77 | ;;====================== 78 | ;;334 79 | 80 | ;; a Dir.my is a structure: 81 | (define-struct dir-my [name content size readability]) 82 | 83 | ;;============================== 84 | ;;335 85 | 86 | ;; a File.v3 is a structure: 87 | (define-struct file [name size content]) 88 | ;; name - String; size - Number; content - String 89 | 90 | ;; a Dir.v3 is a structure: 91 | (define-struct dir.v3 [name dirs files]) 92 | ;; name - String; dirs - Dir*; files - File* 93 | 94 | ;; a Dir* is: 95 | ;; [List-of Dir.v3] 96 | 97 | ;; a File* is one of: 98 | ;; [List-of File.v3] 99 | 100 | (define part1.v3 (make-file "part1" 99 "" )) 101 | (define part2.v3 (make-file "part2" 52 "")) 102 | (define part3.v3 (make-file "part3" 17 "")) 103 | (define text.v3 (make-dir.v3 "text" '() (list part1.v3 part2.v3 part3.v3))) 104 | 105 | (define hang.v3 (make-file "hang" 8 "")) 106 | (define draw.v3 (make-file "draw" 2 "")) 107 | (define code.v3 (make-dir.v3 "code" '() (list hang.v3 draw.v3))) 108 | 109 | (define read2.v3 (make-file "read!" 19 "")) 110 | (define docs.v3 (make-dir.v3 "docs" '() (list read2.v3))) 111 | (define libs.v3 (make-dir.v3 "libs" (list code.v3 docs.v3) '())) 112 | 113 | (define read1.v3 (make-file "read!" 10 "")) 114 | (define ts.v3 (make-dir.v3 "ts" (list text.v3 libs.v3) (list read1.v3))) 115 | 116 | ;;===================== 117 | ;;336 118 | 119 | ;; Dir.v3 -> Number 120 | ;; counts how many files a d contains 121 | (check-expect (how-many.v3 ts.v3) 7) 122 | (define (how-many.v3 d) 123 | (+ (length (dir.v3-files d)) 124 | (foldl (lambda (x y) (+ y (how-many.v3 x))) 125 | 0 (dir.v3-dirs d)))) 126 | -------------------------------------------------------------------------------- /19-24 Intertwined Data/338-344.rkt: -------------------------------------------------------------------------------- 1 | (require 2htdp/abstraction) 2 | (require htdp/dir) 3 | 4 | ;;=================== 5 | ;;338 6 | 7 | (define working-dir (create-dir "/home/ada/code/htdp/")) 8 | (define f1 (make-file "f1" 1 "")) 9 | (define f2 (make-file "f2" 1 "")) 10 | (define d1 (make-dir "d1" '() (list f1 f2))) 11 | (define d2 (make-dir "d2" (list d1) '())) 12 | 13 | ;; Dir -> Number 14 | ;; counts how many files the given d contains 15 | (define (how-many d) 16 | (+ (length (dir-files d)) 17 | (foldl (lambda (x y) (+ y (how-many x))) 18 | 0 (dir-dirs d)))) 19 | 20 | ;;===================== 21 | ;;339 22 | 23 | ;; Dir String -> Boolean 24 | ;; determines if the file f exists in the given d 25 | (check-expect (find? working-dir "330-336.rkt") #true) 26 | (check-expect (find? working-dir "330-336.ss") #false) 27 | (define (find? d f) 28 | (or (ormap (lambda (x) (string=? f (file-name x))) (dir-files d)) 29 | (ormap (lambda (x) (find? x f)) (dir-dirs d)))) 30 | 31 | ;;========================= 32 | ;;340 33 | 34 | ;; Dir -> [List-of String] 35 | ;; lists all files and dirs in the given d 36 | (define (ls d) 37 | (append (map (lambda (x) (file-name x)) (dir-files d)) 38 | (map (lambda (x) (dir-name x)) (dir-dirs d)))) 39 | 40 | ;;======================== 41 | ;;341 42 | 43 | ;; Dir -> Number 44 | ;; computes the total size of a directory tree d 45 | (define (du d) 46 | (+ 1 (foldl (lambda (x y) (+ y (file-size x))) 0 (dir-files d)) 47 | (foldl (lambda (x y) (+ y (du x))) 0 (dir-dirs d)))) 48 | 49 | ;;============================ 50 | ;;342 51 | 52 | ;; Dir String -> Boolean 53 | ;; determines if the file is directly in the given d 54 | (define (in-files? d f) 55 | (ormap (lambda (x) (string=? f (file-name x))) (dir-files d))) 56 | 57 | ;; Dir String -> [Maybe [Path]] 58 | (define (find d f) 59 | (local ( 60 | ;; [List-of Dir] -> Dir 61 | ;; gets the subdirectory where is the f is 62 | (define (get-sub l) 63 | (cond 64 | [(empty? (rest l)) (rest l) ] 65 | [else (if (find? (first l) f) (first l) (get-sub (rest l)))]))) 66 | (cond 67 | [(in-files? d f) (list (dir-name d) f)] 68 | [(find? d f) (cons (dir-name d) (find (get-sub (dir-dirs d)) f))] 69 | [else #false]))) 70 | 71 | ;;============================ 72 | ;;342 challenge 73 | 74 | ;; Dir String -> [List-of Path] 75 | (define (find-all d f) 76 | (local ( 77 | ;; Dir -> [List-of Path] 78 | (define (all-valid-paths d) 79 | (append (if (in-files? d f) (list (list f)) '() ) 80 | (foldl (lambda (x y) 81 | (append y (find-all x f))) 82 | '() (dir-dirs d))))) 83 | 84 | (map (lambda (x) (cons (dir-name d) x)) ( all-valid-paths d)))) 85 | ;;======================== 86 | ;;343 87 | 88 | ;; Dir -> [List-of Path] 89 | (define (ls-R d) 90 | (local (;; Dir -> [List-of Path] 91 | (define (all-sub-paths d) 92 | (append (map (lambda (f) (list (file-name f))) (dir-files d)) 93 | (foldl (lambda (x y) 94 | (append y (ls-R x))) 95 | '() (dir-dirs d))))) 96 | (map (lambda (x) (cons (dir-name d) x)) (all-sub-paths d)))) 97 | 98 | ;; [List-of Item] -> Item 99 | (define (last l) 100 | (cond 101 | [(empty? (rest l)) (first l)] 102 | [else (last (rest l))])) 103 | 104 | ;;===================== 105 | ;;344 106 | 107 | ;; Dir String -> [List-of Path] 108 | (define (find-all.v2 d f) 109 | (filter (lambda (p) (equal? f (last p))) (ls-R d))) 110 | -------------------------------------------------------------------------------- /19-24 Intertwined Data/356-359.rkt: -------------------------------------------------------------------------------- 1 | (require 2htdp/abstraction) 2 | ;; BSL-var-expr Symbol Number -> BSL-var-expr 3 | (define (subst ex x v) 4 | (match ex 5 | [(add-expr left right) 6 | (make-add-expr (subst left x v) (subst right x v))] 7 | [(mul-expr left right) 8 | (make-mul-expr (subst left x v) (subst right x v))] 9 | [(fun-expr f argu) 10 | (make-fun-expr f (subst argu x v))] 11 | [(? (lambda (i) (equal? i x))) v] 12 | [else ex])) 13 | 14 | ;;============================= 15 | ;;356 16 | 17 | (define-struct add-expr [left right]) 18 | (define-struct mul-expr [left right]) 19 | (define-struct fun-expr [name arg]) 20 | (define WRONG "wrong expression") 21 | ;; a BSL-fun-expr is one of: 22 | ;; - Number 23 | ;; - Symbol 24 | ;; - (make-add-expr BSL-fun-expr) 25 | ;; - (make-mul-expr BSL-fun-expr) 26 | ;; - (make-fun-expr Symbol BSL-fun-expr) 27 | 28 | 29 | ;;============================== 30 | ;;357 31 | 32 | ;; BSL-fun-expr Symbol Symbol BSL-fun-expr -> Number 33 | (check-expect (eval-definition1 (make-fun-expr 'k (make-add-expr 1 1)) 'k 'x (make-mul-expr 'x 'x)) 4) 34 | (define (eval-definition1 ex f x b) 35 | (match ex 36 | [(? number?) ex] 37 | [(add-expr left right) 38 | (+ (eval-definition1 left f x b) (eval-definition1 right f x b))] 39 | [(mul-expr left right) 40 | (* (eval-definition1 left f x b) (eval-definition1 right f x b))] 41 | [(fun-expr s exp) 42 | (if (equal? s f) 43 | (eval-definition1 44 | (subst b x (eval-definition1 exp f x b)) f x b) 45 | (error WRONG))])) 46 | 47 | ;;============================== 48 | ;;358 49 | 50 | (define-struct fun-def [name para body]) 51 | ;; a BSL-fun-def is: 52 | ;; (make-fun-def Symbol Symbol BSL-fun-expr) 53 | ;; ex: 54 | (define f (make-fun-def 'f 'x (make-add-expr 3 'x))) 55 | (define g (make-fun-def 'g 'y (make-fun-expr 'f (make-mul-expr 2 'y)))) 56 | (define h (make-fun-def 'h 'v (make-add-expr (make-fun-expr 'f 'v) (make-fun-expr 'g 'v)))) 57 | 58 | ;; a BSL-fun-def* is [List-of BSL-fun-def] 59 | (define da-fgh (list f g h)) 60 | 61 | ;; BSL-fun-def* Symbol -> BSL-fun-def 62 | ;; retrives the definition of f in da 63 | ;; signals an error is there is none 64 | (check-expect (lookup-def da-fgh 'g) g) 65 | (check-error (lookup-def da-fgh 't) WRONG) 66 | (define (lookup-def da f) 67 | (cond 68 | [(empty? da) (error WRONG)] 69 | [else (if (equal? f (fun-def-name (first da))) 70 | (first da) 71 | (lookup-def (rest da) f))])) 72 | 73 | ;;============================= 74 | ;;359 75 | 76 | ;; BSL-fun-expr BSL-fun-def* -> Number 77 | (check-expect (eval-function* (make-fun-expr 'f 4) da-fgh) 7) 78 | (check-expect (eval-function* (make-fun-expr 'g 1) da-fgh) 5) 79 | (check-expect (eval-function* (make-fun-expr 'h 1) da-fgh) 9) 80 | (define (eval-function* ex da) 81 | (match ex 82 | [(? number?) ex] 83 | [(add-expr left right) 84 | (+ (eval-function* left da) (eval-function* right da))] 85 | [(mul-expr left right) 86 | (* (eval-function* left da) (eval-function* right da))] 87 | [(fun-expr s exp) 88 | (local ((define f (lookup-def da s))) 89 | (eval-function* (subst (fun-def-body f) (fun-def-para f) 90 | (eval-function* exp da)) da))])) 91 | -------------------------------------------------------------------------------- /19-24 Intertwined Data/360-362.rkt: -------------------------------------------------------------------------------- 1 | (require 2htdp/abstraction) 2 | 3 | ;;========================= 4 | ;;360 5 | 6 | (define-struct add-expr [left right]) 7 | (define-struct mul-expr [left right]) 8 | (define-struct fun-expr [name argu]) 9 | ;; a BSL-expr is one of: 10 | ;; - Number 11 | ;; - Symbol 12 | ;; - (make-add-expr BSL-expr) 13 | ;; - (make-mul-expr BSL-expr) 14 | ;; - (make-fun-expr Symbol BSL-expr) 15 | 16 | (define-struct con [name value]) 17 | (define-struct fun [name para body]) 18 | 19 | ;; a BSL-da is one of: 20 | ;; - (make-con Symbol Number) 21 | ;; - (make-fun Symbol Symbol BSL-expr) 22 | (define con1 (make-con 'x 1)) 23 | (define con2 (make-con 'y 2)) 24 | (define f (make-fun 'f 'x (make-add-expr 3 'x))) 25 | (define g (make-fun 'g 'y (make-fun-expr 'f (make-mul-expr 2 'y)))) 26 | (define h (make-fun 'h 'v (make-add-expr (make-fun-expr 'f 'v) (make-fun-expr 'g 'v)))) 27 | 28 | ;; a BSL-da-all is [List-of BSL-da] 29 | (define one-da (list con1 con2 f g h)) 30 | 31 | (define CON-ERROR "NO CONSTANT DEFINITION FOUND") 32 | 33 | ;; BSL-da-all Symbol -> Number 34 | (check-expect (lookup-con-def one-da 'x) con1) 35 | (check-error (lookup-con-def one-da 'f) CON-ERROR) 36 | (define (lookup-con-def da x) 37 | (cond 38 | [(empty? da) (error CON-ERROR)] 39 | [else (if (and (con? (first da)) 40 | (equal? x (con-name (first da)))) 41 | (first da) 42 | (lookup-con-def (rest da) x))])) 43 | 44 | (define FUN-ERROR "NO FUNCTION DEFINITION FOUND") 45 | ;; BSL-da-all Symbol -> [BSL-da fun] 46 | (check-expect (lookup-fun-def one-da 'f) f) 47 | (check-error (lookup-fun-def one-da 'x) FUN-ERROR) 48 | (define (lookup-fun-def da x) 49 | (cond 50 | [(empty? da) (error FUN-ERROR)] 51 | [else (if (and (fun? (first da)) 52 | (equal? x (fun-name (first da)))) 53 | (first da) 54 | (lookup-fun-def (rest da) x))])) 55 | 56 | ;;============================ 57 | ;;391 58 | 59 | ;; BSL-var-expr Symbol Number -> BSL-var-expr 60 | (define (subst ex x v) 61 | (match ex 62 | [(add-expr left right) 63 | (make-add-expr (subst left x v) (subst right x v))] 64 | [(mul-expr left right) 65 | (make-mul-expr (subst left x v) (subst right x v))] 66 | [(fun-expr f argu) 67 | (make-fun-expr f (subst argu x v))] 68 | [(? (lambda (i) (equal? i x))) v] 69 | [else ex])) 70 | 71 | ;; BSL-expr BSL-da-all -> Number 72 | (check-expect (eval-all 1 one-da) 1) 73 | (check-expect (eval-all 'x one-da) 1) 74 | (check-expect (eval-all (make-add-expr 'x 1) one-da) 2) 75 | (check-expect (eval-all (make-fun-expr 'h 'y) one-da) 12) 76 | (define (eval-all ex da) 77 | (match ex 78 | [(? number?) ex] 79 | [(? symbol?) (con-value (lookup-con-def da ex))] 80 | [(add-expr left right) 81 | (+ (eval-all left da) (eval-all right da))] 82 | [(mul-expr left right) 83 | (* (eval-all left da) (eval-all right da))] 84 | [(fun-expr f argu) 85 | (local ((define function (lookup-fun-def da f))) 86 | (eval-all 87 | (subst (fun-body function) (fun-para function) 88 | (eval-all argu da)) da))])) 89 | 90 | ;;============================== 91 | ;;392 92 | 93 | ;; S-expr -> BSL-expr 94 | (check-expect (parse-expr 1) 1) 95 | (check-expect (parse-expr 'x) 'x) 96 | (check-expect (parse-expr '(+ 1 1)) (make-add-expr 1 1)) 97 | (check-expect (parse-expr '(f x)) (make-fun-expr 'f 'x)) 98 | (define (parse-expr sexp) 99 | (match sexp 100 | [(? number?) sexp] 101 | [(? symbol?) sexp] 102 | [(list '+ f s) 103 | (make-add-expr (parse-expr f) (parse-expr s) )] 104 | [(list '* f s) 105 | (make-mul-expr (parse-expr f) (parse-expr s) )] 106 | [(list s b) 107 | (make-fun-expr s (parse-expr b))])) 108 | 109 | ;; SL -> BSL-da-all 110 | (check-expect (parse-da (list '(define x 1))) (list (make-con 'x 1))) 111 | (check-expect (parse-da (list '(define (f x) (+ 3 x)))) (list (make-fun 'f 'x (make-add-expr 3 'x)))) 112 | (check-expect (parse-da '((define x 1) (define (f x) (+ 3 x)))) (list (make-con 'x 1) (make-fun 'f 'x (make-add-expr 3 'x)))) 113 | (define (parse-da sl) 114 | (match sl 115 | [(? empty?) '()] 116 | [(cons (list 'define (list s para) body) rest-sl) 117 | (cons (make-fun s para (parse-expr body)) (parse-da rest-sl))] 118 | [(cons (list 'define s v) rest-sl) 119 | (cons (make-con s (parse-expr v)) (parse-da rest-sl))] 120 | )) 121 | 122 | (define sl1 '( (define x 1) (define y 2) 123 | (define (f x) (+ 3 x)) (define (g x) (f (* 2 x))) 124 | (define (h x) (+ (f x) (g x))))) 125 | ;; S-expr SL -> Number 126 | (check-expect (interpreter 1 sl1) 1) 127 | (check-expect (interpreter 'x sl1) 1) 128 | (check-expect (interpreter '(f y) sl1) 5) 129 | (check-expect (interpreter '(h y) sl1) 12) 130 | (define (interpreter sexp sl) 131 | (eval-all (parse-expr sexp) (parse-da sl) )) 132 | -------------------------------------------------------------------------------- /19-24 Intertwined Data/363-369.rkt: -------------------------------------------------------------------------------- 1 | ;;==================== 2 | ;;363 3 | 4 | ;; an Xexpr.v2 is a list: 5 | ;; - (cons Symbol XL) 6 | 7 | ;; an XL is one of: 8 | ;; - '() 9 | ;; - Xexpr.v2 10 | ;; - (cons Xexpr.v2 XL) 11 | ;; - (cons AL (cons Xexpr.v2 XL)) 12 | 13 | ;; an Attribute is: 14 | ;; (cons Symbol (cons String '())) 15 | 16 | ;; an AL is one of: 17 | ;; - '() 18 | ;; - (cons Attribute AL) 19 | 20 | 21 | ;;======================== 22 | ;;364 23 | 24 | (define xexpr1 '(transition ((from "seen-e") (to "seen-f")) (l))) 25 | (define xexpr2 '(ul (li (word) (word)) (li (word)))) 26 | 27 | ;;========================== 28 | ;;365 29 | 30 | ;; 1. 31 | ;; 2. 32 | ;; 3. 33 | 34 | ;;=========================== 35 | ;;366 36 | 37 | ;; Xexpr.v2 -> Symbol 38 | ;; extract the name of the Xexpr 39 | (check-expect (xexpr-name xexpr1) 'transition) 40 | (check-expect (xexpr-name xexpr2) 'ul) 41 | (define (xexpr-name xexpr) 42 | (first xexpr)) 43 | 44 | ;; [List-of Attribute] or Xexpr.v2 -> Boolean 45 | ;; is the given value a list of attributes 46 | (define (list-of-attributes? x) 47 | (cond 48 | [(empty? x) #true] 49 | [else 50 | (local ((define possible-attribute (first x))) 51 | (cons? possible-attribute))])) 52 | 53 | ;; Xexpr.v2 -> [List-of Xexpr.v2] 54 | (check-expect (xexpr-content xexpr1) '((l))) 55 | (check-expect (xexpr-content xexpr2) '((li (word) (word)) (li (word)))) 56 | (define (xexpr-content xexpr) 57 | (local ((define optional-loa+content (rest xexpr))) 58 | (cond 59 | [(empty? optional-loa+content) '()] 60 | [else (local ((define loa-or-x 61 | (first optional-loa+content))) 62 | (if (list-of-attributes? loa-or-x) 63 | (rest optional-loa+content) 64 | optional-loa+content))]))) 65 | 66 | ;;============================ 67 | ;;369 68 | 69 | (define attr1 '((name "ada") (age "21") (gender "f"))) 70 | 71 | ;; AL Symbol -> String 72 | (check-expect (find-attr attr1 'name) "ada") 73 | (check-expect (find-attr attr1 'addr) #false) 74 | (define (find-attr l s) 75 | (cond 76 | [(empty? l) #false] 77 | [else (if (equal? (first (first l)) s) 78 | (second (first l)) 79 | (find-attr (rest l) s))])) 80 | -------------------------------------------------------------------------------- /19-24 Intertwined Data/378-383.rkt: -------------------------------------------------------------------------------- 1 | (require 2htdp/universe) 2 | (require 2htdp/image) 3 | 4 | ;; Xexpr.v2 -> [List-of Xexpr.v2] 5 | (define (xexpr-content xexpr) 6 | (local ((define optional-loa+content (rest xexpr))) 7 | (cond 8 | [(empty? optional-loa+content) '()] 9 | [else (local ((define loa-or-x 10 | (first optional-loa+content))) 11 | (if (list-of-attributes? loa-or-x) 12 | (rest optional-loa+content) 13 | optional-loa+content))]))) 14 | 15 | ;; [List-of Attribute] or Xexpr.v2 -> Boolean 16 | ;; is the given value a list of attributes 17 | (define (list-of-attributes? x) 18 | (cond 19 | [(empty? x) #true] 20 | [else 21 | (local ((define possible-attribute (first x))) 22 | (cons? possible-attribute))])) 23 | 24 | ;; Xexpr.v2 -> [List-of Attribute] 25 | (define (xexpr-attr x) 26 | (local ((define optional-loa+content (rest x))) 27 | (cond 28 | [(empty? optional-loa+content) '()] 29 | [else (local ((define loa-or-x 30 | (first optional-loa+content))) 31 | (if (list-of-attributes? loa-or-x) 32 | loa-or-x 33 | '()))]))) 34 | 35 | ;; AL Symbol -> String 36 | (define (find-attr l s) 37 | (cond 38 | [(empty? l) #false] 39 | [else (if (equal? (first (first l)) s) 40 | (second (first l)) 41 | (find-attr (rest l) s))])) 42 | 43 | ;; A FSM is a [List-of 1Transition] 44 | ;; A 1Transition is a list of two items: 45 | ;; (cons FSM-State (cons FSM-State '())) 46 | ;; A FSM-State is a String that specifies a color 47 | 48 | ;; data examples 49 | (define fsm-traffic 50 | '(("red" "green") ("green" "yellow") ("yellow" "red"))) 51 | 52 | ;;========================== 53 | ;;378 54 | 55 | ;; FSM FSM-State -> FSM-State 56 | ;; match the keys pressed by a player with the given FSM 57 | (define (simulate state0 transitions) 58 | (big-bang state0 59 | [to-draw 60 | (lambda (current) 61 | (overlay (text current 15 "black") 62 | (square 100 "solid" current)))] 63 | [on-key 64 | (lambda (current key-event) 65 | (find transitions current))])) 66 | 67 | ;;========================== 68 | ;;379 69 | 70 | ;; [X Y] [List-of [List X Y]] X -> Y 71 | ;; finds the matching Y for the given X in alist 72 | (check-expect (find '((1 2) (2 3)) 1) 2) 73 | (check-error (find '(("e" "er")) "not found")) 74 | (define (find alist x) 75 | (local ((define fm (assoc x alist))) 76 | (if (cons? fm) (second fm) (error "not found")))) 77 | 78 | ;;============================ 79 | ;;380 80 | 81 | ;; a 1Transition is a list of two items: 82 | ;; (cons (list FSM-State KeyEvent) (cons FSM-State '())) 83 | 84 | ;; data examples 85 | (define fsm-2 '((("red" "g") "green") (("green" "y") "yellow") (("yellow" "r")"red"))) 86 | 87 | ;; FSM FSM-State -> FSM-State 88 | (define (simulate.v2 state0 transitions) 89 | (big-bang state0 90 | [to-draw 91 | (lambda (current) 92 | (overlay (text current 15 "black") 93 | (square 100 "solid" current)))] 94 | [on-key 95 | (lambda (current key-event) 96 | (find transitions (list current key-event)))])) 97 | 98 | ;;============================= 99 | ;;381 100 | 101 | ;; an XMachine is a nested list of this shape: 102 | ;; (cons 'machine 103 | ;; (cons (list (list 'initial FSM-State)) 104 | ;; [List-of X1T])) 105 | 106 | ;; an X1T is a nested list of this shape: 107 | ;; (cons 'action 108 | ;; (cons (list (list 'state FSM-State) 109 | ;; (list 'next FSM-State)) '()) 110 | 111 | ;;=========================== 112 | ;;382 113 | 114 | ;; a BW machine in XML 115 | ;; 116 | ;; 117 | ;; 118 | ;; 119 | 120 | ;; a BW machine in XMachine: 121 | (define bw-machine 122 | '(machine ((initial "black")) 123 | (action ((state "black") (next "white"))) 124 | (action ((state "white") (next "black"))))) 125 | 126 | ;;============================= 127 | ;;383 128 | 129 | ;; XM -> FSM-State 130 | (define (simulate-xm xm) 131 | (simulate (xm-initial xm) (xm-transitions xm))) 132 | 133 | ;; XM -> FSM-State 134 | ;; extract the initial state from xm 135 | (check-expect (xm-initial bw-machine) "black") 136 | (define (xm-initial xm) 137 | (find-attr (xexpr-attr xm) 'initial)) 138 | 139 | ;; XM -> FSM 140 | ;; extract & convert the transitions in xm 141 | (check-expect (xm-transitions bw-machine) 142 | '(("black" "white") ("white" "black"))) 143 | (define (xm-transitions xm) 144 | (local ((define (action->transition xa) 145 | (list (find-attr (xexpr-attr xa) 'state) 146 | (find-attr (xexpr-attr xa) 'next)))) 147 | (map action->transition (xexpr-content xm)))) 148 | -------------------------------------------------------------------------------- /19-24 Intertwined Data/384-386.rkt: -------------------------------------------------------------------------------- 1 | (require 2htdp/abstraction) 2 | (require 2htdp/batch-io) 3 | (require 2htdp/universe) 4 | (require 2htdp/image) 5 | 6 | (define PREFIX "https://www.google.com/finance?q=") 7 | (define SUFFIX "&btnG=Search") 8 | (define SIZE 22) ;; font size 9 | 10 | (define-struct data [price delta]) 11 | ;; a StockWorld is a structure; (make-data String String) 12 | 13 | ;; String -> StockWorld 14 | ;; retrives the stock price of co and its change every 15 minutes 15 | (define (stock-alert co) 16 | (local (;; the url of search page 17 | (define url (string-append PREFIX co SUFFIX)) 18 | 19 | ;; [StockWorld -> StockWorld] 20 | ;; retrives new data 21 | (define (retrieve-stock-data __w) 22 | (local ((define x (read-xexpr/web url))) 23 | (make-data (get x "price") 24 | (get x "priceChange")))) 25 | 26 | ;; StockWorld -> Image 27 | (define (render-stock-data w) 28 | (local (; [StockWorld -> String] -> Image 29 | (define (word sel col) 30 | (text (sel w) SIZE col))) 31 | (overlay (beside (word data-price 'black) 32 | (text " " SIZE 'white) 33 | (word data-delta 'red)) 34 | (rectangle 300 35 'solid 'white))))) 35 | (big-bang (retrieve-stock-data 'no-use) 36 | [on-tick retrieve-stock-data 15] 37 | [to-draw render-stock-data]))) 38 | 39 | ;;========================== 40 | ;;386 41 | 42 | ;; Xexpr.v3 String -> String 43 | ;; retrieves the value of the "content" attribute 44 | ;; from a 'meta element that has attribute "itemprop" 45 | ;; with value s 46 | (check-expect 47 | (get '(meta ((content "+1") (itemprop "F"))) "F") 48 | "+1") 49 | (check-error 50 | (get '(meta ((content "+1") (itemprop "F"))) "M") 51 | "not found") 52 | 53 | (define (get x s) 54 | (local ((define result (get-xexpr x s))) 55 | (if (string? result) 56 | result 57 | (error "not found")))) 58 | 59 | ;; AL Symbol -> String 60 | (define (find-attr l s) 61 | (cond 62 | [(empty? l) #false] 63 | [else (if (equal? (first (first l)) s) 64 | (second (first l)) 65 | (find-attr (rest l) s))])) 66 | 67 | ;; [List-of Attribute] or Xexpr.v2 -> Boolean 68 | ;; is the given value a list of attributes 69 | (define (list-of-attributes? x) 70 | (cond 71 | [(empty? x) #true] 72 | [else 73 | (local ((define possible-attribute (first x))) 74 | (cons? possible-attribute))])) 75 | 76 | ;; Xexpr.v3 String -> [Maybe String] 77 | (define (get-xexpr x s) 78 | (local (;; Symbol [AL or Xexpr.v3] -> [Maybe String] 79 | (define (get-content-xexpr name al-or-xexpr) 80 | (if (and (equal? name 'meta) 81 | (equal? s (find-attr al-or-xexpr 'itemprop))) 82 | (find-attr al-or-xexpr 'content) 83 | #false)) 84 | 85 | ;; [AL or Xexpr.v3] XL-> [Maybe String] 86 | (define (get-from-rest al-or-xexpr xl) 87 | (if (list-of-attributes? al-or-xexpr) 88 | (get-xexpr-list xl s) 89 | (get-xexpr-list (cons al-or-xexpr xl s))))) 90 | (match x 91 | [(? symbol?) #false] 92 | [(? string?) #false] 93 | [(? number?) #false] 94 | [(cons symbol (cons al-or-xexpr xl)) 95 | (local ((define potential-data (get-content-xexpr symbol al-or-xexpr))) 96 | (if (string? potential-data) 97 | potential-data 98 | (get-from-rest al-or-xexpr xl)))]))) 99 | 100 | ;; XL String -> [Maybe String] 101 | (define (get-xexpr-list xl s) 102 | (cond 103 | [(empty? xl) #false] 104 | [else (local ((define first-result (get-xexpr (first xl) s))) 105 | (if (string? first-result) 106 | first-result 107 | (get-xexpr-list (rest xl) s)))])) 108 | -------------------------------------------------------------------------------- /19-24 Intertwined Data/387-389.rkt: -------------------------------------------------------------------------------- 1 | ;;======================== 2 | ;;387 3 | 4 | ;; [List-of Symbol] [List-of Number] -> [List-of (list Symbol Number)] 5 | ;; produces all possible pairs of symbols and numbers 6 | (check-expect (cross '(a b c) '( 1 2)) 7 | '((a 1) (a 2) (b 1) (b 2) (c 1) (c 2))) 8 | (define (cross los lon) 9 | (local (;; Symbol [List-of Number] -> [List-of (list Symbol Number) 10 | (define (cross-one s lon) 11 | (cond 12 | [(empty? lon) '()] 13 | [else (cons (list s (first lon)) 14 | (cross-one s (rest lon)))]))) 15 | (cond 16 | [(empty? los) '()] 17 | [else (append (cross-one (first los) lon) 18 | (cross (rest los) lon))]))) 19 | 20 | ;;============================== 21 | ;;388 22 | 23 | (define-struct employee [name security-number pay-rate]) 24 | (define-struct work-record [name hours]) 25 | (define one-list-work-record (list (make-work-record "Adam" 12) (make-work-record "Eve" 12))) 26 | (define one-list-employee (list (make-employee "Adam" 012 40.34) (make-employee "Eve" 013 50.34))) 27 | 28 | ;; [List-of Employee] [List-of Work-Record] -> [List-of Number] 29 | (check-expect (wages*.v2 one-list-employee one-list-work-record) (list (* 12 40.34) (* 12 50.34))) 30 | (define (wages*.v2 loe low) 31 | (cond 32 | [(empty? loe) '()] 33 | [else (cons (weekly-wage (first loe) low) 34 | (wages*.v2 (rest loe) low))])) 35 | 36 | ;; Employee [List-of Work-Record] -> Number 37 | ;; computes the weekly of an employee 38 | (define (weekly-wage e low) 39 | (cond 40 | [(empty? low) 0] 41 | [else (if (equal? (employee-name e) 42 | (work-record-name (first low))) 43 | (* (employee-pay-rate e) 44 | (work-record-hours (first low))) 45 | (weekly-wage e (rest low)))])) 46 | 47 | ;;========================== 48 | ;;389 49 | 50 | (define-struct phone-record [name number]) ;; (make-phone-record String String) 51 | 52 | ;; [List-of String] [List-of String] -> [List-of Phone-record] 53 | (define (zip list-of-name list-of-phone) 54 | (cond 55 | [(empty? list-of-name) '()] 56 | [else (cons (make-phone-record (first list-of-name) 57 | (first list-of-phone)) 58 | (zip (rest list-of-name) (rest list-of-phone)))])) 59 | 60 | ;;========================= 61 | ;;390 62 | 63 | (define-struct branch [left right]) 64 | 65 | ;; a TOS is one of: 66 | ;; - Symbol 67 | ;; - (make-branch Tos Tos) 68 | (define one-tos (make-branch (make-branch (make-branch 'a 'e) (make-branch 'b 'c)) (make-branch 'd 'e))) 69 | 70 | ;; a Direction is one of: 71 | ;; - 'left 72 | ;; - 'right 73 | 74 | ;; a list of Directions is also called a path 75 | (define one-path '(left right right)) 76 | 77 | ;; TOS Path -> Symbol 78 | (check-expect (tree-pick one-tos one-path) 'c) 79 | (check-error (tree-pick one-tos '(left)) "you have reached the end of path") 80 | (check-error (tree-pick one-tos '(left left left left left)) "you have reached the end of tos") 81 | (define (tree-pick tos path) 82 | (cond 83 | [(and (empty? path) 84 | (symbol? tos)) tos] 85 | [(and (empty? path) 86 | (branch? tos)) (error "you have reached the end of path")] 87 | [(symbol? tos) (error "you have reached the end of tos")] 88 | [(branch? tos) 89 | (tree-pick (if (equal? 'left (first path)) 90 | (branch-left tos) 91 | (branch-right tos)) (rest path))])) 92 | -------------------------------------------------------------------------------- /19-24 Intertwined Data/393-395.rkt: -------------------------------------------------------------------------------- 1 | ;;===================== 2 | ;;393 3 | 4 | ;; a Set-of-Number (Son)is one of: 5 | ;; - empty 6 | ;; - (cons Number Set-of-Number) 7 | ;; constrains: numbers in Son should not appear more than once 8 | (define son-1 '(1 4 2 6)) 9 | (define son-2 '(43 12 56 4 6)) 10 | 11 | ;; Son Son -> Boolean 12 | ;; check if the first son is in the second 13 | (check-expect (in-set? '(1 2) '( 1 2 4)) #true) 14 | (check-expect (in-set? '( 1 2) '( 1 3 4)) #false) 15 | (define (in-set? sub sup) 16 | (foldl (lambda (x y) (and y (member? x sup))) #true sub)) 17 | 18 | ;; List -> Boolean 19 | ;; check if the given list is a set 20 | (check-expect (set? '( 1 2)) #true) 21 | (check-expect (set? '( 1 2 2)) #false) 22 | (define (set? l) 23 | (cond 24 | [(empty? l) #true] 25 | [else (if (member? (first l) (rest l)) 26 | #false 27 | (set? (rest l)))])) 28 | 29 | ;; Son Son -> [Son -> Boolean] 30 | (define (union? s1 s2) 31 | (lambda (s) 32 | (and (in-set? s1 s) (in-set? s2 s) (set? s)))) 33 | 34 | ;; Son Son -> Son 35 | ;; make a union out of two sets 36 | (check-satisfied (union son-1 son-2) (union? son-2 son-1)) 37 | (define (union s1 s2) 38 | (cond 39 | [(and (empty? s1) (empty? s2)) '()] 40 | [(empty? s1) s2] 41 | [(empty? s2) s1] 42 | [else (if (member? (first s2) s1) 43 | (union s1 (rest s2)) 44 | (cons (first s2) (union s1 (rest s2))))])) 45 | 46 | ;; Son Son -> [Son -> Boolean] 47 | ;; this function is not complete 48 | (define (intersect? s1 s2) 49 | (lambda (s) 50 | (and (in-set? s s1) (in-set? s s2) (set? s)))) 51 | 52 | ;; Son Son -> Son 53 | (check-satisfied (intersect son-2 son-1) (intersect? son-2 son-1)) 54 | (define (intersect s1 s2) 55 | (cond 56 | [(or (empty? s1) (empty? s2)) '()] 57 | [else (if (member? (first s1) s2) 58 | (cons (first s1) (intersect (rest s1) s2)) 59 | (intersect (rest s1) s2))])) 60 | 61 | (check-satisfied (intersect.v2 son-2 son-1) (intersect? son-2 son-1)) 62 | (define (intersect.v2 s1 s2) 63 | (foldl (lambda (x y) (if (member? x s2) (cons x y) y)) '() s1)) 64 | 65 | 66 | ;;=========================== 67 | ;;394 68 | 69 | ;; [List-of Number] -> Boolean 70 | (check-expect (sort (first l) (first (rest l)))) 77 | (sort [ [List-of Number] -> Boolean] 80 | ;; this function is not complete 81 | (define (merge? l1 l2) 82 | (lambda (l) 83 | (and (in-set? l1 l) (in-set? l2 l) (sort [List-of Number] 86 | ;; inserts a number into a sorted list of numbers 87 | (define (insert n l) 88 | (cond 89 | [(empty? l) (list n)] 90 | [else (if (< n (first l)) 91 | (cons n (cons (first l) (rest l))) 92 | (cons (first l) (insert n (rest l))))])) 93 | 94 | ;; [List-of Number] [List-of Number] -> [List-of Number] 95 | ;; merges two sorted list of numbers into one sorted list of numbers 96 | (check-satisfied (merge '( 1 2 2 3 6 7) '( 2 3 3 4 6 7)) (merge? '( 1 2 2 3 6 7) '( 2 3 3 4 6 7))) 97 | (define (merge l1 l2) 98 | (cond 99 | [(and (empty? l1) (empty? l2)) '()] 100 | [(empty? l2) l1] 101 | [(empty? l1) l2] 102 | [else (merge (rest l1) (insert (first l1) l2))])) 103 | 104 | ;;============================ 105 | ;; 395 106 | 107 | ;; [List-of Number] Number -> [List-of Number] 108 | ;; extracts the first n numbers from the list or the whole list if the list is too short 109 | (check-expect (take '() 2) '()) 110 | (check-expect (take '( 1 2 3) 1) '(1)) 111 | (check-expect (take '( 1 2 3) 2) '( 1 2)) 112 | (check-expect (take '( 1 2 3) 34) '( 1 2 3)) 113 | (define (take l n) 114 | (cond 115 | [(empty? l) l] 116 | [(= n 0) '()] 117 | [else (cons (first l) (take (rest l) (sub1 n)))])) 118 | 119 | ;; [List-of Number] Number -> [List-of Number] 120 | ;; removes the first n numbers from the list or all of them if the list is too short 121 | (check-expect (drop '() 34) '()) 122 | (check-expect (drop '( 1 2) 34) '()) 123 | (check-expect (drop '( 1 2) 0) '(1 2)) 124 | (check-expect (drop '( 1 2 3) 2) '( 3)) 125 | (define (drop l n) 126 | (cond 127 | [(empty? l) '()] 128 | [(= n 0) l] 129 | [else (drop (rest l) (sub1 n))])) 130 | -------------------------------------------------------------------------------- /19-24 Intertwined Data/396.rkt: -------------------------------------------------------------------------------- 1 | (require 2htdp/image) 2 | (require 2htdp/universe) 3 | (require 2htdp/batch-io) 4 | 5 | ;; A HM-Word is a [List-of Letter or "_"] 6 | ;; interpretation "_" represents a letter to be guessed 7 | 8 | (define LETTERS (explode "abcdefghijklmnopqrstABCDEFGHIJKLMNOPQRSTUVWXYZ")) 9 | 10 | ;; HM-Word N -> String 11 | ;; run a simplistic Hangman game, produce the current state 12 | (define (play the-pick time-limit) 13 | (local ((define the-word (explode the-pick)) 14 | (define the-guess (make-list (length the-word) "_")) 15 | ; HM-Word -> HM-Word 16 | (define (do-nothing s) s) 17 | ; HM-Word KeyEvent -> HM-Word 18 | (define (checked-compare current-status ke) 19 | (if (member? ke LETTERS) 20 | (compare-word the-word current-status ke) 21 | current-status))) 22 | (implode 23 | (big-bang the-guess ; HM-Word 24 | [to-draw render-word] 25 | [on-tick do-nothing 1 time-limit] 26 | [on-key checked-compare])))) 27 | 28 | ;; HM-Word -> Image 29 | (define (render-word w) 30 | (text (implode w) 22 "black")) 31 | 32 | ;;=========================== 33 | ;;396 34 | 35 | ;; HM-Word HM-Word KeyEvent -> HM-Word 36 | ;; if ke in the-word, updates the current-status or remains unchanged 37 | (check-expect (compare-word '("a" "b") '("_" "_") "a") '("a" "_")) 38 | (check-expect (compare-word '("a" "b" "a") '("_" "_" "_") "a") '("a" "_" "a")) 39 | (define (compare-word the-word current-status ke) 40 | (local (;; HM-Word HM-Word -> HM-Word 41 | (define (update-status the-word the-status) 42 | (cond 43 | [(empty? the-status) '()] 44 | [else (local ((define rest-updated 45 | (update-status (rest the-word) 46 | (rest the-status)))) 47 | (if (equal? (first the-word) ke) 48 | (cons ke rest-updated) 49 | (cons (first the-status) 50 | rest-updated)))]))) 51 | (if (member? ke the-word) 52 | (update-status the-word current-status) 53 | current-status))) 54 | 55 | (define LOCATION "/usr/share/dict/words") ; on OS X 56 | (define AS-LIST (read-lines LOCATION)) 57 | (define SIZE (length AS-LIST)) 58 | 59 | -------------------------------------------------------------------------------- /19-24 Intertwined Data/397-401.rkt: -------------------------------------------------------------------------------- 1 | ;;===================== 2 | ;;397 3 | 4 | (define WRONG "WRONG") 5 | 6 | (define-struct employee [name no rate]) 7 | (define-struct punch [no time]) 8 | (define-struct wage [name money]) 9 | 10 | ;; e.x. 11 | (define one-loe (list (make-employee "Adam" "012" 40.34) (make-employee "Eve" "013" 50.23))) 12 | (define one-lop (list (make-punch "012" 34) (make-punch "013" 43))) 13 | 14 | ;; [List-of Employee] [List-of Punch] -> [List-of Wage] 15 | (check-expect (wages*.v3 one-loe one-lop) (list (make-wage "Adam" (* 40.34 34)) (make-wage "Eve" (* 50.23 43)))) 16 | (check-error (wages*.v3 one-loe (list (make-punch "Peter" 34))) WRONG) 17 | 18 | (define (wages*.v3 loe lop) 19 | (local (;; [List-of Employee] Punch -> Wage 20 | (define (get-wage loe p) 21 | (cond 22 | [(empty? loe) (error WRONG)] 23 | [else (local ((define first-em (first loe))) 24 | (if (equal? (punch-no p) (employee-no first-em)) 25 | (make-wage (employee-name first-em) 26 | (* (punch-time p) 27 | (employee-rate first-em))) 28 | (get-wage (rest loe) p)))]))) 29 | (cond 30 | [(empty? lop) '()] 31 | [else (cons (get-wage loe (first lop)) 32 | (wages*.v3 loe (rest lop)))]))) 33 | 34 | ;;=============================== 35 | ;; 398 36 | 37 | ;; [List-of Number] [List-of Number] -> Number 38 | (check-expect (value '(1 2 3) '( 2 3 4)) (+ 2 6 12)) 39 | 40 | (define (value lol lov) 41 | (cond 42 | [(empty? lol) 0] 43 | [else (+ (* (first lol) (first lov)) 44 | (value (rest lol) (rest lov)))])) 45 | 46 | ;;================================ 47 | ;;399 48 | 49 | ;; [NEList-of X] -> X 50 | ;; returns a random item from the list 51 | (check-random (random-pick '(1 2 3)) (list-ref '(1 2 3) (random 3))) 52 | 53 | (define (random-pick l) 54 | (list-ref l (random (length l)))) 55 | 56 | ;; [List-of String] [List-of [List-of String]] -> [List-of [List-of String]] 57 | ;; produces the lsit of those lists in ll that do not agree with names at any place 58 | 59 | (define (non-same names ll) 60 | (cond 61 | [(empty? ll) '()] 62 | [else (if (equal? names (first ll)) 63 | (non-same names (rest ll)) 64 | (cons (first ll) (non-same names (rest ll))))])) 65 | 66 | ;;================================== 67 | ;; 400 68 | 69 | (define one-dna-pattern '(a c g t t g)) 70 | (define one-dna-string '(a c g t t g t a c t g)) 71 | 72 | ;; [List-of Symbol] [List-of Symbol] -> Boolean 73 | ;; checks if the string starts with pattern 74 | (check-expect (DNAprefix one-dna-pattern one-dna-string) #true) 75 | (check-expect (DNAprefix one-dna-pattern (cons 'a one-dna-string)) #false) 76 | 77 | (define (DNAprefix pattern string) 78 | (cond 79 | [(empty? pattern) #true] 80 | [(empty? string) #false] 81 | [else (if (equal? (first pattern) (first string)) 82 | (DNAprefix (rest pattern) (rest string)) 83 | #false)])) 84 | 85 | ;; [List-of Symbol] [List-of Symbol] -> [List-of Symbol] 86 | ;; gets the symbols in string beyond the pattern 87 | (check-expect (DNAdelta one-dna-pattern one-dna-string) '(t a c t g)) 88 | (check-expect (DNAdelta one-dna-pattern (cons 'a one-dna-string)) #false) 89 | 90 | (define (DNAdelta pattern string) 91 | (cond 92 | [(empty? pattern) string] 93 | [(empty? string) #false] 94 | [else (if (equal? (first pattern) (first string)) 95 | (DNAdelta (rest pattern) (rest string)) 96 | #false)])) 97 | 98 | ;;================================= 99 | ;; 401 100 | 101 | ;; S-expr S-expr -> Boolean 102 | ;; checks if the two S-exprs are equal 103 | (check-expect (sexp=? 12 12) #true) 104 | (check-expect (sexp=? '( 12 a (34 d) ) '(12 a (34 d))) #true) 105 | (check-expect (sexp=? '( 12 a (34 d) ) '(12 a (34 e))) #false) 106 | 107 | (define (sexp=? s1 s2) 108 | (local (; S-expr -> Boolean 109 | ;; checks if sexpr is an atom 110 | (define (atom? s) (or (number? s) (string? s) (symbol? s) (empty? s)))) 111 | (cond 112 | [(and (atom? s1) (atom? s2)) (equal? s1 s2)] 113 | [(or (atom? s1) (atom? s2)) #false] 114 | [else (if (sexp=? (first s1) (first s2)) 115 | (sexp=? (rest s1) (rest s2)) 116 | #false)]))) 117 | -------------------------------------------------------------------------------- /19-24 Intertwined Data/410-411.rkt: -------------------------------------------------------------------------------- 1 | 2 | (define-struct db [schema content]) 3 | 4 | (define school-schema 5 | `( ( "Name" ,string?) 6 | ( "Age" ,integer?) 7 | ( "Present" ,boolean?))) 8 | (define school-content 9 | '(("Alice" 35 #true) 10 | ("Bob" 25 #false) 11 | ("Carol" 30 #true) 12 | ("Dave" 32 #false))) 13 | (define school-db (make-db school-schema school-content)) 14 | 15 | (define presence-schema `( ( "Present" ,boolean?) 16 | ( "Description" ,string?))) 17 | (define presence-content 18 | '((#true "presence") 19 | (#false "absence"))) 20 | (define presence-content2 21 | '((#true "presence") 22 | (#true "absence") 23 | (#false "presence") 24 | (#false "absence"))) 25 | (define presence-db (make-db presence-schema presence-content)) 26 | (define presence-db-2 (make-db presence-schema presence-content2)) 27 | 28 | 29 | ;;================================ 30 | ;; 410 31 | 32 | ;; Any [List-of Any] -> [List-of Any] 33 | (define (add-at-end x l) 34 | (cond 35 | [(empty? l) (cons x '())] 36 | [else (cons (first l) (add-at-end x (rest l)))])) 37 | 38 | 39 | ;; Set Set -> Set 40 | ;; union two sets 41 | (define (set-union s1 s2) 42 | (foldr (lambda (x y) (if (member? x y) y (cons x y))) s2 s1)) 43 | 44 | 45 | ;; DB DB -> DB 46 | (check-expect (db-union school-db (make-db school-schema '(("Ada" 21 #false)))) (make-db school-schema (add-at-end '("Ada" 21 #false) school-content))) 47 | (define (db-union d1 d2) 48 | (local ((define schema (db-schema d1)) 49 | (define content1 (db-content d1)) 50 | (define content2 (db-content d2))) 51 | (make-db schema (set-union content1 content2)))) 52 | 53 | 54 | ;;======================================== 55 | ;; 411 56 | 57 | ;; List -> Item 58 | ;; extract the last item of a list 59 | (define (last l) 60 | (cond 61 | [(empty? (rest l)) (first l)] 62 | [else (last (rest l))])) 63 | 64 | ;; DB DB -> DB 65 | ;; one row corresponds to one row 66 | (define (join.v1 db-1 db-2) 67 | (local ((define schema1 (db-schema db-1)) 68 | (define schema2 (db-schema db-2)) 69 | (define content1 (db-content db-1)) 70 | (define content2 (db-content db-2)) 71 | 72 | ;; List List -> List 73 | (define (join-lists s1 s2) 74 | (append (reverse (rest (reverse s1))) (rest s2))) 75 | 76 | ;; Row -> Row 77 | (define (join-row row) 78 | (local (;; Any -> Row 79 | (define (find-row key) 80 | (foldl (lambda (row result) 81 | (if (equal? key (first row)) 82 | row result)) '() content2))) 83 | (join-lists row (find-row (last row)))))) 84 | 85 | (make-db (join-lists schema1 schema2) 86 | (map join-row content1)))) 87 | 88 | ;; DB -> DB 89 | ;; one row may correspond to many rows 90 | (define (join.v2 db-1 db-2) 91 | (local ((define schema1 (db-schema db-1)) 92 | (define schema2 (db-schema db-2)) 93 | (define content1 (db-content db-1)) 94 | (define content2 (db-content db-2)) 95 | 96 | ;; List List -> List 97 | (define (join-lists s1 s2) 98 | (append (reverse (rest (reverse s1))) (rest s2))) 99 | 100 | ;; Any -> [List-of Row] 101 | (define (find-row key) 102 | (foldl (lambda (row result) 103 | (if (equal? key (first row)) 104 | (cons row result) result)) '() content2)) 105 | 106 | ;; Row -> [List-of Row] 107 | (define (join-row row) 108 | (map (lambda (x) (join-lists row x)) (find-row (last row))))) 109 | 110 | (make-db (join-lists schema1 schema2) 111 | (foldl (lambda (row result) 112 | (append (join-row row) result)) '() content1)))) 113 | -------------------------------------------------------------------------------- /19-24 Intertwined Data/412.rkt: -------------------------------------------------------------------------------- 1 | ;; N Number N -> Inex 2 | ;; make an instance of Inex after checking the arguments 3 | (define (create-inex m s e) 4 | (cond 5 | [(and (<= 0 m 99) (<= 0 e 99) (or (= s 1) (= s -1))) 6 | (make-inex m s e)] 7 | [else (error "bad values given")])) 8 | 9 | ; Inex -> Number 10 | ; convert an inex into its numeric equivalent 11 | (define (inex->number an-inex) 12 | (* (inex-mantissa an-inex) 13 | (expt 14 | 10 (* (inex-sign an-inex) (inex-exponent an-inex))))) 15 | 16 | (define-struct inex [mantissa sign exponent]) 17 | ;; An Inex is a structure: 18 | ;; (make-inex N99 S N99) 19 | ;; An S is one of: 20 | ;; – 1 21 | ;; – -1 22 | ;; An N99 is an N between 0 and 99 (inclusive). 23 | 24 | ;; ========================= 25 | ;; 412 26 | 27 | ;; Inex Inex -> Inex 28 | ;; add two inexes 29 | (check-expect (inex+ (create-inex 1 1 0) (create-inex 2 1 0)) (create-inex 3 1 0)) 30 | (check-expect (inex+ (create-inex 55 1 0) (create-inex 55 1 0)) (create-inex 11 1 1)) 31 | (check-expect (inex+ (create-inex 56 1 0) (create-inex 56 1 0)) (create-inex 11 1 1)) 32 | 33 | (define (inex+ n1 n2) 34 | (local ((define m1 (inex-mantissa n1)) 35 | (define m2 (inex-mantissa n2)) 36 | (define sign (inex-sign n1)) 37 | (define expo (inex-exponent n1)) 38 | (define possible-m (+ m1 m2)) 39 | 40 | ;; Number -> Number 41 | ;; add1 expo if valid , or signal an error 42 | (define (add1-expo n) 43 | (if (<= -99 n 98) (add1 n) (error "out of range")))) 44 | (cond 45 | [(<= 0 possible-m 99) 46 | (make-inex possible-m sign expo)] 47 | [(> possible-m 99) 48 | (local ((define new-expo (add1-expo expo))) 49 | (make-inex (quotient possible-m 10) 50 | (sgn new-expo) (abs new-expo)))]))) 51 | 52 | ;; Inex Inex -> Inex 53 | (check-expect (inex+.v2 (create-inex 1 1 0) (create-inex 1 -1 1)) (create-inex 11 -1 1)) 54 | (define ( inex+.v2 n1 n2 ) 55 | (local ((define m1 (inex-mantissa n1)) 56 | (define m2 (inex-mantissa n2)) 57 | (define s1 (inex-sign n1)) 58 | (define s2 (inex-sign n2)) 59 | (define e1 (inex-exponent n1)) 60 | (define e2 (inex-exponent n2))) 61 | (cond 62 | [(> (* s1 e1) (* s2 e2)) 63 | (inex+ ( inex*n (make-inex m1 s2 e2) 10) n2)] 64 | [else 65 | (inex+ n1 (inex*n (make-inex m2 s1 e1) 10))]))) 66 | 67 | ;; Inex N -> Inex 68 | ;; multiplay inex by n (>= n 0) 69 | (define (inex*n inex n) 70 | (cond 71 | [(= n 0) (make-inex 0 1 0)] 72 | [(= n 1) inex] 73 | [else (inex+ inex (inex*n inex (sub1 n)))])) 74 | 75 | -------------------------------------------------------------------------------- /25-30 Generative Recursion/422-423.rkt: -------------------------------------------------------------------------------- 1 | ;;=========================== 2 | ;; 422 3 | 4 | ;; [List-of Any] N -> [List-of [List-of Any]] 5 | ;; produce a list of chunks, each of which contains n items 6 | (check-expect (list->chunks '( 1 2 3 4 5) 2) '((1 2) (3 4) (5))) 7 | (define (list->chunks l n) 8 | (cond 9 | [(< (length l) n) (list l)] 10 | [(zero? n) l] 11 | [else (cons (take l n) (list->chunks (drop l n) n))])) 12 | 13 | 14 | ;; [List-of Any] N -> [List-of Any] 15 | ;; extract the first n items from list 16 | (define (take l n) 17 | (cond 18 | [(empty? l) '()] 19 | [(zero? n) '()] 20 | [else (cons (first l) (take (rest l) (sub1 n)))])) 21 | 22 | 23 | ;; [List-of Any] N -> [List-of Any] 24 | ;; remove the first n items from list l 25 | (define (drop l n) 26 | (cond 27 | [(empty? l) '()] 28 | [(zero? n) l] 29 | [else (drop (rest l) (sub1 n))])) 30 | 31 | 32 | ;;============================= 33 | ;; 423 34 | 35 | ;; String N -> [List-of String] 36 | ;; divide a string into chunks, each of which is n 1String long 37 | (check-expect (partition "abcdefg" 3) '("abc" "def" "g")) 38 | (define (partition s n) 39 | (cond 40 | [(< (string-length s) n) (list s)] 41 | [(zero? n) (list s)] 42 | [else (cons (substring s 0 n) 43 | (partition (substring s n (string-length s)) n))])) 44 | -------------------------------------------------------------------------------- /25-30 Generative Recursion/426-430.rkt: -------------------------------------------------------------------------------- 1 | ;;=========================== 2 | ;; 426 3 | 4 | ;; [List-of Number] Number -> [List-of Number] 5 | (check-expect (quick-sort< '( 11 8 14 7)) '( 7 8 11 14)) 6 | (define (quick-sort< alon) 7 | (cond 8 | [(empty? alon) '()] 9 | [(= 1 (length alon)) alon] 10 | ;;[(<= (length alon) threshold) (sort< threshold)] 11 | [else (local ((define pivot (first alon))) 12 | (append (quick-sort< (smallers alon pivot)) 13 | (equal alon pivot) 14 | (quick-sort< (largers alon pivot))))])) 15 | 16 | ;; [List-of Number] Number -> [List-of Number] 17 | (define (largers alon n) 18 | (filter (lambda (x) (> x n)) alon)) 19 | 20 | ;; [List-of Number] Number -> [List-of Number] 21 | (define (smallers alon n) 22 | (filter (lambda (x) (< x n)) alon)) 23 | 24 | ;; [List-of Number] Number -> [List-of Number] 25 | ;; extract all ns from l 26 | (define (equal alon n) 27 | (filter (lambda (x) (= x n)) alon)) 28 | 29 | 30 | ;;====================== 31 | ;; 430 32 | 33 | ;; [X] [List-of X] [X X -> Boolean] -> [List-of X] 34 | ;; sort the list according to the function f 35 | (check-expect (my-sort '( 11 8 14 7) <) '( 7 8 11 14)) 36 | 37 | (define (my-sort alon f) 38 | (cond 39 | [(empty? alon) '()] 40 | [(= 1 (length alon)) alon] 41 | [else 42 | (local ((define pivot (first alon)) 43 | (define leftside (filter (lambda (x) (f x pivot)) alon)) 44 | (define rightside (filter (lambda (x) 45 | (not (or (f x pivot) 46 | (equal? x pivot)))) alon)) 47 | (define same (filter (lambda (x) (equal? x pivot)) alon))) 48 | (append (my-sort leftside f) 49 | same 50 | (my-sort rightside f)))])) 51 | -------------------------------------------------------------------------------- /25-30 Generative Recursion/432-442.rkt: -------------------------------------------------------------------------------- 1 | ;;================================ 2 | ;; 432 3 | 4 | (define MAX 100000000) 5 | 6 | ;; Posn -> Posn 7 | (define (food-create p) 8 | (local ((define new-food (make-posn (random MAX) (random MAX)))) 9 | (if (equal? new-food p) 10 | (food-create p) 11 | new-food))) 12 | 13 | ;;============================= 14 | ;; 433 15 | 16 | ;; [X] [List-of X] N -> [List-of [List-of X]] 17 | ;; bundle every n items together 18 | (define (bundle-check alon n) 19 | (cond 20 | [(and (= n 0) (> (length alon) 0)) 21 | (error "wrong input")] 22 | [else (bundle alon n)])) 23 | 24 | ;; [X] [List-of X] N -> [List-of [List-of X]] 25 | (define (bundle alon n) 26 | (cond 27 | [(<= (length alon) n) alon] 28 | [else (cons (take alon n) 29 | (bundle (drop alon n) n))])) 30 | 31 | ;; [List-of Any] N -> [List-of Any] 32 | ;; extract the first n items from list 33 | (define (take l n) 34 | (cond 35 | [(empty? l) '()] 36 | [(zero? n) '()] 37 | [else (cons (first l) (take (rest l) (sub1 n)))])) 38 | 39 | 40 | ;; [List-of Any] N -> [List-of Any] 41 | ;; remove the first n items from list l 42 | (define (drop l n) 43 | (cond 44 | [(empty? l) '()] 45 | [(zero? n) l] 46 | [else (drop (rest l) (sub1 n))])) 47 | 48 | ;;======================= 49 | ;; 434 50 | 51 | ;; when in l, there are some numbers equal to n, then it forms an infinite loop 52 | 53 | ;;=========================== 54 | ;; 436 55 | 56 | ;; terminate (food-create p) loops until the result is different from p 57 | 58 | ;;======================== 59 | ;; 437 60 | 61 | ;; special computes the length of its input 62 | (define (special.v1 p) 63 | (cond 64 | [(empty? p) 0] 65 | [else (add1 (special.v1 (rest p)))])) 66 | 67 | ;; special negates each number on the given list of number 68 | (define (special.v2 p) 69 | (cond 70 | [(empty? p) '()] 71 | [else (cons (/ (first p) -1) 72 | (special.v2 (rest p)))])) 73 | 74 | 75 | ;;============================= 76 | ;; 442 77 | 78 | ;; [X] [List-of X] [X X -> Boolean] -> [List-of X] 79 | ;; sort the list according to the function f 80 | (check-expect (quick-sort '( 11 8 14 7) <) '( 7 8 11 14)) 81 | 82 | (define (quick-sort alon f) 83 | (cond 84 | [(empty? alon) '()] 85 | [(= 1 (length alon)) alon] 86 | [else 87 | (local ((define pivot (first alon)) 88 | (define leftside (filter (lambda (x) (f x pivot)) alon)) 89 | (define rightside (filter (lambda (x) 90 | (not (or (f x pivot) 91 | (equal? x pivot)))) alon)) 92 | (define same (filter (lambda (x) (equal? x pivot)) alon))) 93 | (append (quick-sort leftside f) 94 | same 95 | (quick-sort rightside f)))])) 96 | 97 | ;; [List-of Number] -> [List-of Number] 98 | (check-expect (sort< '( 11 8 14 7) ) '( 7 8 11 14)) 99 | (define (sort< alon) 100 | (local (;; Number [List-of Number] -> [List-of Number] 101 | ;; inserts a number into a sorted number in a descending order 102 | (define (insert n alon) 103 | (cond 104 | [(empty? alon) (list n)] 105 | [else (if (< n (first alon)) 106 | (cons n alon) 107 | (cons (first alon) (insert n (rest alon))))]))) 108 | (cond 109 | [(empty? alon) '()] 110 | [else (insert (first alon) (sort< (rest alon)))]))) 111 | 112 | ;; Number -> [List-of Number] 113 | ;; create a large list of numbers randomly 114 | (define (create-list n) 115 | (cond 116 | [(zero? n) '()] 117 | [else (cons (random MAX) 118 | (create-list (sub1 n)))])) 119 | -------------------------------------------------------------------------------- /25-30 Generative Recursion/445-451.rkt: -------------------------------------------------------------------------------- 1 | ;;======================= 2 | ;; 445 3 | 4 | (define epsilon 0.00005) 5 | 6 | ;; [Number-> Number] -> [Number -> Boolean] 7 | ;; create a check-function for find-root for f 8 | (define (create-check f) 9 | (lambda (root) 10 | (<= (abs (f root) ) 0.5))) 11 | 12 | ;; Number -> Number 13 | (define (poly x) 14 | (* ( - x 2) (- x 4))) 15 | 16 | ;;=============================== 17 | ;; 446-449 18 | 19 | ;; [Number -> Number] Number Number -> Number 20 | ;; determines R such that f has a root in [R,(+ R ε)] 21 | ;; assume f is continuous 22 | ;; assume (or (<= (f left) 0 (f right)) (<= (f right) 0 (f left))) 23 | ;; generative divide interval in half, the root is in one of the two 24 | ;; halves, pick according to assumption 25 | (check-satisfied (find-root poly 1 3) (create-check poly)) 26 | (check-satisfied (find-root poly 3 4) (create-check poly)) 27 | (define (find-root f left right) 28 | (local ((define (helper left right f@left f@right) 29 | (cond 30 | [(<= (- right left) epsilon) left] 31 | [else 32 | (local ((define mid (/ (+ left right) 2)) 33 | (define f@mid (f mid))) 34 | (cond 35 | [(or (<= f@left 0 f@mid) (<= f@mid 0 f@left)) 36 | (helper left mid f@left f@mid)] 37 | [(or (<= f@mid 0 f@right) (<= f@right 0 f@mid)) 38 | (helper mid right f@mid f@right)]))]))) 39 | (helper left right (f left) (f right)))) 40 | 41 | 42 | ;;============================ 43 | ;; 450 44 | 45 | (define (find-root.v2 f left right) 46 | (local ((define (helper left right f@left f@right) 47 | (cond 48 | [(<= (- right left) epsilon) left] 49 | [else (local ((define mid (/ (+ left right) 2)) 50 | (define f@mid (f mid))) 51 | (cond 52 | [(<= f@left 0 f@mid) 53 | (helper left mid f@left f@mid)] 54 | [(<= f@mid 0 f@right) 55 | (helper mid right f@mid f@right)]))]))) 56 | (helper left right (f left) (f right)))) 57 | 58 | 59 | ;;=================================== 60 | ;; 451 61 | 62 | (define-struct table [length array]) ;; (make-table Number [Number -> Number]) 63 | (define table1 (make-table 10 poly)) 64 | 65 | 66 | ;; Table -> Number 67 | (check-expect (find-linear table1) 2) 68 | (define (find-linear table) 69 | (local ((define len (table-length table)) 70 | (define table-function (table-array table)) 71 | ;; N -> Number 72 | (define (table-ref i) 73 | (cond 74 | [(= i len) (error "no root")] 75 | [else (if (<= (abs (table-function i)) 76 | epsilon) 77 | i 78 | (table-ref (add1 i)))]))) 79 | (table-ref 0))) 80 | 81 | ;; Table -> Number 82 | (check-expect (find-linear table1) 2) 83 | (define (find-binary table) 84 | (local ((define len (table-length table)) 85 | (define func (table-array table)) 86 | (define (helper left right f@left f@right) 87 | (cond 88 | [(= left right) left] 89 | [else (local ((define mid (floor (/ (+ left right) 2))) 90 | (define f@mid (func mid))) 91 | (cond 92 | [(<= f@left 0 f@mid) 93 | (helper left mid f@left f@mid)] 94 | [(<= f@mid 0 f@right) 95 | (helper mid right f@mid f@right)]))]))) 96 | (helper 0 (sub1 len) (func 0) (func (sub1 len))))) 97 | -------------------------------------------------------------------------------- /25-30 Generative Recursion/453-454.rkt: -------------------------------------------------------------------------------- 1 | ;;============================ 2 | ;; 453 3 | 4 | ;; a Token is one of: 5 | ;; - 1String 6 | ;; - [List-of 1String] (where all 1Strings are lower-case letters) 7 | 8 | (define one-line '("h" "e" "l" "l" "o" "," " " "w" "o" "r" "l" "d" "!")) 9 | (define another-line '("/" "h" "e" "l" "l" "o" "," "\t" " " "w" "o" "r" "l" "d" "!" "\n")) 10 | 11 | ;; Line ([List-of 1String]) -> [List-of Token] 12 | (check-expect (tokenize one-line) '(("h" "e" "l" "l" "o") 13 | "," 14 | ("w" "o" "r" "l" "d") 15 | "!")) 16 | (check-expect (tokenize another-line) '("/" 17 | ("h" "e" "l" "l" "o") 18 | "," 19 | ("w" "o" "r" "l" "d") 20 | "!")) 21 | (define (tokenize line) 22 | (cond 23 | [(empty? line) '()] 24 | [else (cons (first-token line) 25 | (tokenize (remove-first-token line)))])) 26 | 27 | ;; Line -> Token 28 | (define (first-token line) 29 | (local (;; Line -> [List-of 1String] 30 | (define (first-word line) 31 | (cond 32 | [(or (empty? line) 33 | (not (string-lower-case? (first line)))) 34 | '()] 35 | [else (cons (first line) 36 | (first-word (rest line)))]))) 37 | (cond 38 | [(empty? line) '()] 39 | [(string-lower-case? (first line)) 40 | (first-word line)] 41 | [else (first line)]))) 42 | 43 | ;; Line -> Line 44 | (define (remove-first-token line) 45 | (local (;; Line -> Line 46 | (define (remove-first-word line) 47 | (cond 48 | [(or (empty? line) 49 | (not (string-lower-case? (first line)))) 50 | line] 51 | [else (remove-first-word (rest line))])) 52 | 53 | ;; Line -> Line 54 | (define (strip-left-whitespaces line) 55 | (cond 56 | [(empty? line) '()] 57 | [(string-whitespace? (first line)) 58 | (strip-left-whitespaces (rest line))] 59 | [else line]))) 60 | (cond 61 | [(empty? line)'()] 62 | [(string-lower-case? (first line)) 63 | (strip-left-whitespaces (remove-first-word line))] 64 | [else (strip-left-whitespaces (rest line))]))) 65 | 66 | ;;================================ 67 | ;; 454 68 | 69 | ;; a Matrix is: 70 | ;; (list [List-of Number*N]*N) 71 | 72 | ;; Number [List-of Number] -> Matrix 73 | (check-expect (create-matrix 2 (list 1 2 3 4)) (list (list 1 2) 74 | (list 3 4))) 75 | (define (create-matrix n l) 76 | (cond 77 | [(empty? l) '()] 78 | [else (cons (take-first-n n l) 79 | (create-matrix n (remove-first-n n l)))])) 80 | 81 | 82 | ;; [X] Number [List-of X] -> [List-of X] 83 | ;; take the first n items from list 84 | (define (take-first-n n l) 85 | (cond 86 | [(zero? n) '()] 87 | [else (cons (first l) 88 | (take-first-n (sub1 n) (rest l)))])) 89 | 90 | 91 | ;; [X] Number [List-of X] -> [List-of X] 92 | ;; remove the first n items from list 93 | (define (remove-first-n n l) 94 | (cond 95 | [(zero? n) l] 96 | [else (remove-first-n (sub1 n) (rest l))])) 97 | -------------------------------------------------------------------------------- /31-34 Accumulators/490-493.rkt: -------------------------------------------------------------------------------- 1 | ;;============================== 2 | ;; 490 3 | 4 | ;; [List-of Number] -> [List-of Number] 5 | ;; convert a list of relative to absolute distances 6 | ;; the first number represents the distance to the origin 7 | 8 | (check-expect (relative->absolute '(50 40 70 30 30)) 9 | '(50 90 160 190 220)) 10 | 11 | (define (relative->absolute l) 12 | (cond 13 | [(empty? l) '()] 14 | [else (local ((define rest-of-l 15 | (relative->absolute (rest l))) 16 | (define adjusted 17 | (add-to-each (first l) rest-of-l))) 18 | (cons (first l) adjusted))])) 19 | 20 | ;; Number [List-of Number] -> [List-of Number] 21 | ;; add n to each number on l 22 | 23 | (check-expect (cons 50 (add-to-each 50 '(40 110 140 170))) 24 | '(50 90 160 190 220)) 25 | 26 | (define (add-to-each n l) 27 | (map (lambda (x) (+ x n)) l)) 28 | 29 | 30 | ;;======================================= 31 | ;; 493 32 | 33 | (define cyclic-graph 34 | '((A B E) 35 | (B E F) 36 | (C B D) 37 | (D) 38 | (E C F) 39 | (F G) 40 | (G))) 41 | 42 | 43 | ;; Node Node Graph -> [Maybe Path] 44 | (define (find-path.v2 origination destination G) 45 | (find-path-helper.v2 origination destination origination G)) 46 | 47 | ;; Node Node Node Graph -> [Maybe Path] 48 | ;; finds a path from origination to destination in G 49 | ;; if there is no path, the function produces #false 50 | (define (find-path-helper.v2 origination destination S G) 51 | (cond 52 | [(symbol=? origination destination) (list destination)] 53 | [else (local ((define next (neighbors origination G)) 54 | (define candidate 55 | (find-path-helper.v2/list next destination S G))) 56 | (cond 57 | [(boolean? candidate) #false] 58 | [else (cons origination candidate)]))])) 59 | 60 | ;; [List-of Node] Node Node Graph -> [Maybe Path] 61 | ;; finds a path from some node on lo-Os to D 62 | ;; if there is no path, the function produces #false 63 | (define (find-path-helper.v2/list lo-Os D S G) 64 | (cond 65 | [(empty? lo-Os) #false] 66 | [(member? S lo-Os) #false] 67 | [else (local ((define candidate 68 | (find-path-helper.v2 (first lo-Os) D S G))) 69 | (cond 70 | [(boolean? candidate) 71 | (find-path-helper.v2/list (rest lo-Os) D S G)] 72 | [else candidate]))])) 73 | -------------------------------------------------------------------------------- /31-34 Accumulators/499.rkt: -------------------------------------------------------------------------------- 1 | ;;=========================== 2 | ;; 499 3 | 4 | (define-struct node [left right]) 5 | ;; a Tree is one of: 6 | ;; - '() 7 | ;; - (make-node Tree Tree) 8 | (define example (make-node (make-node '() 9 | (make-node '() '())) '())) 10 | 11 | 12 | ;; Tree -> Number 13 | (check-expect (height.v1 example) 3) 14 | (define (height.v1 abt) 15 | (cond 16 | [(empty? abt) 0] 17 | [else (+ (max (height.v1 (node-left abt)) 18 | (height.v1 (node-right abt))) 1)])) 19 | 20 | ;; Tree -> Number 21 | (check-expect (height.v1 example) 3) 22 | (define (height.v2 abt) 23 | (local (;; Tree N -> Number 24 | ;; measure the height of abt 25 | ;; accumulator a is the number of steps 26 | ;; it takes to reach abt from abt0 27 | (define (height/a abt a) 28 | (cond 29 | [(empty? abt) a] 30 | [else (max (height/a (node-left abt) (add1 a)) 31 | (height/a (node-right abt) (add1 a)))]))) 32 | (height/a abt 0))) 33 | 34 | 35 | ;; Tree -> Number 36 | (check-expect (height.v1 example) 3) 37 | (define (height.v3 abt) 38 | (local (;; Tree N N -> Number 39 | ;; measure the height of steps 40 | ;; accumulator s is the number of steps 41 | ;; it takes to reach abt from abt0 42 | ;; accumulator m is the maximal height of 43 | ;; the part of abt0 that is to the left of abt 44 | (define (h/a abt s m) 45 | (cond 46 | [(empty? abt) (max s m)] 47 | [else (h/a (node-right abt (add1 s) 48 | (h/a (node-left abt) (add1 s) m)))]))) 49 | (h/a abt 0 0))) 50 | -------------------------------------------------------------------------------- /31-34 Accumulators/500-503.rkt: -------------------------------------------------------------------------------- 1 | ;;======================== 2 | ;; 500 3 | 4 | ;; [List-of Number] -> Number 5 | ;; calculate the product of a list of numbers 6 | (check-expect (product '( 1 2 3)) 6) 7 | (define (product lon) 8 | (local ((define (product/a lon a) 9 | (cond 10 | [(empty? lon) a] 11 | [else (product/a (rest lon) (* a (first lon)))]))) 12 | (product/a lon 1))) 13 | 14 | 15 | ;;=========================== 16 | ;; 501 17 | 18 | ;; [X] [List-of X] -> Number 19 | ;; count the number of items in a given list 20 | (check-expect (how-many '( 2 3 4 5)) 4) 21 | (define (how-many l) 22 | (local ((define (how-many/a l a) 23 | (cond 24 | [(empty? l) a] 25 | [else (how-many/a (rest l) (add1 a))]))) 26 | (how-many/a l 0))) 27 | 28 | 29 | ;;============================= 30 | ;; 502 31 | 32 | ;; Number -> Number 33 | ;; add n to pi without use + 34 | (check-within (add-to-pi 2) (+ 2 pi) 0.001) 35 | (define (add-to-pi n) 36 | (local ((define (add-to-pi/a n a) 37 | (cond 38 | [(zero? n) a] 39 | [else (add-to-pi/a (sub1 n) (add1 a))]))) 40 | (add-to-pi/a n pi))) 41 | 42 | 43 | ;;============================ 44 | ;; 503 45 | 46 | ;; [X] [List-of X] -> [List-of X] 47 | ;; create a polindrome 48 | (check-expect (polindrome (explode "abc")) (explode "abcba")) 49 | (define (polindrome l) 50 | (local ((define (polindrome/a l a) 51 | (cond 52 | [(empty? (rest l)) a] 53 | [else (polindrome/a (rest l) (cons (first l) a))]))) 54 | (append l (polindrome/a l '())))) 55 | 56 | 57 | ;; [X] [List-of X] -> [List-of X] 58 | ;; create a polindrome 59 | (define (mirror s0) 60 | (local ((define (all-but-last l) 61 | (cond 62 | [(empty? (rest l)) '()] 63 | [else (cons (first l) (all-but-last (rest l)))])) 64 | (define (last l) 65 | (cond 66 | [(empty? (rest l)) (first l)] 67 | [else (last (rest l))]))) 68 | (append (all-but-last s0) 69 | (list (last s0)) 70 | (reverse (all-but-last s0))))) 71 | -------------------------------------------------------------------------------- /31-34 Accumulators/504-508.rkt: -------------------------------------------------------------------------------- 1 | ;;======================== 2 | ;; 504 3 | 4 | ;; Matrix -> Matrix 5 | ;; find a row that doesn't start with 0 and 6 | ;; use it as the first one 7 | ;; generative move the first row to last place 8 | ;; no termination if all rows start with 0 9 | (check-expect (rotate.v1 '((0 4 5) (1 2 3))) 10 | '((1 2 3) (0 4 5))) 11 | (define (rotate.v1 M) 12 | (cond 13 | [(not (= (first (first M)) 0)) M] 14 | [else 15 | (rotate.v1 (append (rest M) (list (first M))))])) 16 | 17 | 18 | (check-expect (rotate.v1 '((0 4 5) (1 2 3))) 19 | '((1 2 3) (0 4 5))) 20 | (define (rotate.v2 M) 21 | (local ((define (rotate/a M a) 22 | (cond 23 | [(empty? M) (reverse a)] 24 | [else (if (= (first (first M)) 0) 25 | (rotate/a (rest M) (cons (first M) a)) 26 | (append M (reverse a)))]))) 27 | (rotate/a M '()))) 28 | 29 | 30 | ;; Number -> Matrix 31 | ;; create a n by 1 matrix randomly 32 | ;; with all first (n-1) rows starting with 0 33 | ;; except the last row 34 | (define (create-matrix n) 35 | (cond 36 | [(= n 1) '((1))] 37 | [else (cons '(0) (create-matrix (sub1 n)))])) 38 | (define matrix-1000 (create-matrix 1000)) 39 | (define matrix-2000 (create-matrix 2000)) 40 | 41 | 42 | ;;======================= 43 | ;; 505 44 | 45 | ;; [List-of Number] -> Number 46 | ;; convert a list of digits into a number 47 | (check-expect (to10 '(1 0 2)) 102) 48 | (define (to10 lod) 49 | (local ((define (to10/a lod a) 50 | (cond 51 | [(empty? lod) a] 52 | [else (to10/a (rest lod) (+ (first lod) (* 10 a)))]))) 53 | (to10/a lod 0))) 54 | 55 | 56 | ;;========================== 57 | ;; 506 58 | 59 | ;; Number -> Boolean 60 | ;; check if n is a prime number 61 | (check-expect (is-prime 2) #true) 62 | (check-expect (is-prime 3) #true) 63 | (check-expect (is-prime 12) #false) 64 | (check-expect (is-prime 13) #true) 65 | (define (is-prime n) 66 | (local ((define (is-prime/a n a) 67 | (cond 68 | [(= a 1) #true] 69 | [else (and (not (zero? (remainder n a))) 70 | (is-prime/a n (sub1 a)))]))) 71 | (cond 72 | [(= n 1) #false] 73 | [else (is-prime/a n (sub1 n))]))) 74 | 75 | 76 | ;;========================= 77 | ;; 507 78 | 79 | ;; [X][Y] [X -> Y] [List-of X] -> [List-of Y] 80 | ;; an accumulator-version of map 81 | (check-expect (map-a add1 '(1 2 3)) '( 2 3 4)) 82 | (define (map-a f l) 83 | (local ((define (map-a/a l a) 84 | (cond 85 | [(empty? l) (reverse a)] 86 | [else (map-a/a (rest l) (cons (f (first l)) a))]))) 87 | (map-a/a l '()))) 88 | 89 | 90 | ;;========================= 91 | ;; 508 92 | 93 | ;; [X] Number [Number -> X] -> [List-of X] 94 | ;; build-l*st 95 | (check-expect (build-l*st 45 add1) (build-list 45 add1)) 96 | (define (build-l*st n f) 97 | (local ((define (build-l*st/a n a) 98 | (cond 99 | [(zero? n) a] 100 | [else (build-l*st/a (sub1 n) (cons (f (sub1 n)) a))]))) 101 | (build-l*st/a n '()))) 102 | -------------------------------------------------------------------------------- /31-34 Accumulators/509-510.rkt: -------------------------------------------------------------------------------- 1 | (require 2htdp/image) 2 | (require 2htdp/universe) 3 | 4 | (define HEIGHT 20) 5 | (define WIDTH 200) 6 | (define FONT-SIZE 16) 7 | (define FONT-COLOR "black") 8 | 9 | (define MT (empty-scene WIDTH HEIGHT)) 10 | (define CURSOR (rectangle 1 HEIGHT "solid" "red")) 11 | 12 | ;; [List-of 1String] -> Image 13 | ;; render a string as an image for the editor 14 | (define (editor-text s) 15 | (text (implode s) FONT-SIZE FONT-COLOR)) 16 | 17 | (define-struct editor [pre post]) 18 | ;; an editor is a structure: 19 | ;; (make-editor [List-of 1String] [List-of 1String]) 20 | ;; interpretation if (make-editor p s) is the state of 21 | ;; the text to the left of the cursor and s to the 22 | ;; text on the right 23 | 24 | ;;======================= 25 | ;; 509 -> 510 26 | 27 | ;; [List-of 1String] Number -> Editor 28 | (define (split-structural ed x) 29 | (local ((define (split-structural/a pre post) 30 | (cond 31 | [(empty? post) 32 | (make-editor pre post)] 33 | [else (local ((define d1 (- x (image-width (editor-text pre)))) 34 | (define d2 (- (image-width (editor-text (cons (first post) pre))) x))) 35 | (cond 36 | [(<= 0 d1 d2) 37 | (make-editor pre post)] 38 | [(<= 0 d2 d1) 39 | (make-editor (cons (first post) pre) (rest post))] 40 | [else (split-structural/a (cons (first post) pre) (rest post))]))]))) 41 | (split-structural/a '() ed))) 42 | 43 | 44 | ;;========================== 45 | ;; 510 46 | 47 | ;; Editor -> Editor 48 | (define (main ed) 49 | (big-bang (create-editor ed "") 50 | [on-key editor-kh] 51 | [to-draw editor-render] 52 | [on-mouse split])) 53 | 54 | ;; Editor Number Number MouseEvent-> Editor 55 | (define (split ed x y me) 56 | (split-structural (append (reverse (editor-pre ed)) 57 | (editor-post ed)) x)) 58 | 59 | ;; Editor -> Image 60 | (define (editor-render ed) 61 | (place-image/align 62 | (beside (editor-text (reverse (editor-pre ed))) 63 | CURSOR 64 | (editor-text (editor-post ed))) 65 | 1 1 "left" "top" MT)) 66 | 67 | ;; String String -> Editor 68 | (define (create-editor s1 s2) 69 | (make-editor (reverse (explode s1) ) (explode s2))) 70 | 71 | 72 | ;; Editor KeyEvent -> Editor 73 | (check-expect (editor-kh (create-editor "" "") "e") 74 | (create-editor "e" "")) 75 | (check-expect (editor-kh (create-editor "cd" "fgh") "e") 76 | (create-editor "cde" "fgh")) 77 | (check-expect (editor-kh (create-editor "c" "") "\b") 78 | (create-editor "" "")) 79 | (check-expect (editor-kh (create-editor "" "") "\b") 80 | (create-editor "" "")) 81 | (check-expect (editor-kh (create-editor "cd" "fgh") "left") 82 | (create-editor "c" "dfgh")) 83 | (check-expect (editor-kh (create-editor "" "fgh") "left") 84 | (create-editor "" "fgh")) 85 | (check-expect (editor-kh (create-editor "cd" "") "right") 86 | (create-editor "cd" "")) 87 | (check-expect (editor-kh (create-editor "cd" "fgh") "right") 88 | (create-editor "cdf" "gh")) 89 | (define (editor-kh ed k) 90 | (local ((define pre (editor-pre ed)) 91 | (define post (editor-post ed)) 92 | 93 | 94 | (define (editor-lft ed) 95 | (cond 96 | [(empty? pre) ed] 97 | [else (make-editor (rest pre) (cons (first pre) post))])) 98 | 99 | 100 | (define (editor-rgt ed) 101 | (cond 102 | [(empty? post) ed] 103 | [else (make-editor (cons (first post) pre) (rest post))])) 104 | 105 | (define (editor-del ed) 106 | (cond 107 | [(empty? pre) ed] 108 | [else (make-editor (rest pre) post)])) 109 | 110 | (define (editor-ins ed k) 111 | (make-editor (cons k pre) post))) 112 | (cond 113 | [(key=? k "left") (editor-lft ed)] 114 | [(key=? k "right") (editor-rgt ed)] 115 | [(key=? k "\b") (editor-del ed)] 116 | [(key=? k "\t") ed] 117 | [(key=? k "\r") ed] 118 | [(= (string-length k) 1) (editor-ins ed k)] 119 | [else ed]))) 120 | 121 | -------------------------------------------------------------------------------- /31-34 Accumulators/511.rkt: -------------------------------------------------------------------------------- 1 | (require 2htdp/batch-io) 2 | 3 | 4 | ;;=========================== 5 | ;; 511 6 | 7 | ;; Number String String -> String? 8 | ;; rearrange a file so that the lines have a maximal width 9 | (define (fmt w in-f out-f) 10 | (local ( 11 | ;; [List-of String] -> [List-of String] 12 | (define (rearrange/list los) 13 | (cond 14 | [(empty? los) '()] 15 | [else (append (rearrange/line (first los)) 16 | (rearrange/list (rest los) ) )])) 17 | 18 | ;; String -> [List-of String] 19 | (define (rearrange/line string) 20 | (cond 21 | [(<= (string-length string) w) 22 | (list string)] 23 | [else (rearrange/list (list 24 | (substring string 0 w) 25 | (substring string w (string-length string))))])) 26 | 27 | ;; [List-of String] -> String 28 | (define (list->string los) 29 | (cond 30 | [(empty? los) ""] 31 | [else (string-append (first los) "\n" 32 | (list->string (rest los)))]))) 33 | (write-file out-f (list->string 34 | (rearrange/list (read-lines in-f)) )))) 35 | 36 | 37 | ;;============================= 38 | ;; Accumulator Version 39 | 40 | 41 | ;; Number String String -> String? 42 | ;; rearrange a file so that the lines have a maximal width 43 | (define (fmt.v2 w in-f out-f) 44 | (local ( 45 | ;; [List-of String] String -> [List-of String] 46 | (define (rearrange/list los a) 47 | (cond 48 | [(empty? los) a] 49 | [else (rearrange/list (rest los) 50 | (string-append a 51 | (rearrange/line (first los))))])) 52 | 53 | ;; String -> [List-of String] 54 | (define (rearrange/line string) 55 | (cond 56 | [(<= (string-length string) w) 57 | (string-append string "\n")] 58 | [else (rearrange/list (list (substring string 0 w) 59 | (substring string w (string-length string))) "")]))) 60 | 61 | (write-file out-f 62 | (rearrange/list (read-lines in-f) "") ))) 63 | -------------------------------------------------------------------------------- /31-34 Accumulators/514-517.rkt: -------------------------------------------------------------------------------- 1 | 2 | ;;====================== 3 | ;; 514 4 | 5 | (define-struct la [para body]) 6 | (define-struct ap [arg body]) 7 | 8 | ;; a Lam is one of: 9 | ;; - a Symbol 10 | ;; - (make-la [List-of Symbol] Lam) 11 | ;; - (make-ap Lam Lam) 12 | 13 | (define ex1 (make-la '(x) 'x)) 14 | (define ex2 (make-la '(x) 'y)) 15 | (define ex3 (make-la '(y) (make-la '(x) 'y))) 16 | (define ex4 (make-ap (make-la '(x) '(x x)) (make-la '(x) '(x x)))) 17 | (define ex5 'x) 18 | 19 | 20 | ;;======================== 21 | ;; 517 22 | 23 | ;; Lam -> Lam 24 | (check-expect (undeclareds ex1) (make-la '(x) '*declared:x)) 25 | (check-expect (undeclareds ex2) (make-la '(x) '*undeclared:y)) 26 | (define (undeclareds lam) 27 | (local (;; String Symbol -> Symbol 28 | (define (declare key s) 29 | (string->symbol 30 | (string-append key ":" 31 | (symbol->string s)))) 32 | 33 | ;; Lam [List-of Symbol] -> Lam 34 | (define (undeclareds/a lam declareds) 35 | (cond 36 | [(symbol? lam) 37 | (if (member? lam declareds) 38 | (declare "*declared" lam) 39 | (declare "*undeclared" lam))] 40 | [(la? lam) 41 | (make-la (la-para lam) 42 | (undeclareds/a (la-body lam) 43 | (append (la-para lam) declareds)))] 44 | [(ap? lam) 45 | (make-ap (undeclareds/a (ap-arg lam) declareds) 46 | (undeclareds/a (ap-body lam) declareds))]))) 47 | (undeclareds/a lam '()))) 48 | -------------------------------------------------------------------------------- /31-34 Accumulators/522.rkt: -------------------------------------------------------------------------------- 1 | (require 2htdp/image) 2 | 3 | (define RADIUS 10) 4 | (define CANNIBAL (circle RADIUS "solid" "red")) 5 | (define MISSIONARY (circle RADIUS "solid" "black")) 6 | (define BOAT (above (flip-vertical (triangle RADIUS "solid" "black") ) 7 | (rectangle RADIUS RADIUS "solid" "black"))) 8 | (define BANK (rectangle (* 5 RADIUS) (* 7 RADIUS) "outline" "black")) 9 | (define RIVER (rectangle (* 8 RADIUS) (* 7 RADIUS) "solid" "skyblue")) 10 | 11 | ;;========================== 12 | ;; 522 13 | 14 | (define-struct state [left boat right]) 15 | ;; a *Puzzle State* is a structure: 16 | ;; - (make-state Bank Boat Bank) 17 | 18 | ;; a *Bank* is a list of 2 Numbers (list x y) 19 | ;; where x represents the number of missionaries 20 | ;; and y represents the number of cannibals 21 | 22 | ;; a *Boat* is one of: 23 | ;; - 'left (representing the left side of the river) 24 | ;; - 'right (representing the right side) 25 | 26 | ;; e.x. 27 | (define initial (make-state '( 3 3) 'left '(0 0))) 28 | (define state1 (make-state '(2 2) 'right '(1 1))) 29 | (define final (make-state '(0 0) 'right '(3 3))) 30 | 31 | ;; State -> Boolean 32 | ;; detect where in a given state all people are on the right river bank 33 | (check-expect (final? final) #true) 34 | (check-expect (final? initial) #false) 35 | (define (final? state) 36 | (equal? (state-right state) '(3 3))) 37 | 38 | 39 | ;; State -> Image 40 | ;; render the given state to an image 41 | 42 | (define (render-mc s) 43 | (local (;; Number Image -> Image 44 | (define (render-human n img) 45 | (cond 46 | [(zero? n) empty-image] 47 | [else (above img (render-human (sub1 n) img))])) 48 | 49 | ;; [List-of Number] -> Image 50 | (define (render-bank lon) 51 | (overlay (beside (render-human (first lon) MISSIONARY) 52 | (render-human (second lon) CANNIBAL)) 53 | BANK)) 54 | 55 | ;; Symbol -> Image 56 | (define (render-river location) 57 | (overlay/align location 'middle BOAT RIVER))) 58 | 59 | (beside (render-bank (state-left s)) 60 | (render-river (state-boat s)) 61 | (render-bank (state-right s))))) 62 | 63 | 64 | -------------------------------------------------------------------------------- /31-34 Accumulators/526-527.rkt: -------------------------------------------------------------------------------- 1 | (require 2htdp/image) 2 | 3 | (define COLOR 'red) 4 | (define MT (empty-scene 400 400)) 5 | (define A (make-posn 200 50)) 6 | (define B (make-posn 27 350)) 7 | (define C (make-posn 373 350)) 8 | ;;========================= 9 | ;; 526 10 | 11 | ;; Image Posn Posn Posn -> Image 12 | ;; add the black triangle a, b, c to scene 13 | (define (add-triangle scene a b c) 14 | (local (;; Image [List-of (list Posn Posn)] -> Image 15 | ;; add a list of lines to img 16 | (define (add-triangle/line img lol) 17 | (cond 18 | [(empty? lol) img] 19 | [else (local ((define first-line (first lol))) 20 | (add-triangle/line 21 | (scene+line img (posn-x (first first-line)) 22 | (posn-y (first first-line)) 23 | (posn-x (second first-line)) 24 | (posn-y (second first-line)) 25 | COLOR) 26 | (rest lol)))]))) 27 | (add-triangle/line scene (list (list a b) (list a c) (list b c))))) 28 | 29 | 30 | ;; Posn Posn -> Boolean 31 | ;; calculate the distance between two posns 32 | (define (distance a b) 33 | (sqrt (+ (expt (- (posn-y a) (posn-y b)) 2) 34 | (expt (- (posn-x a) (posn-x b)) 2)))) 35 | 36 | ;; Posn Posn Posn -> Boolean 37 | ;; is the triangle a, b, c too small to be divided 38 | (define (too-small? a b c) 39 | (<= (+ (distance a b) 40 | (distance a c) 41 | (distance b c)) 42 | e)) 43 | 44 | ;; Posn Posn -> Posn 45 | ;; determine the midpoint between a and b 46 | (define (mid-point a b) 47 | (make-posn (/ (+ (posn-x a) (posn-x b)) 2) 48 | (/ (+ (posn-y a) (posn-y b)) 2))) 49 | 50 | 51 | ;; Image Posn Posn Posn -> Image 52 | ;; generative adds the triangle (a, b, c) to s, 53 | ;; sub-divides it into three triangles by taking the 54 | ;; midpoints of its sides; stop if (a, b, c) is too small 55 | ;; accumulator the function accumulates the triangles scene0 56 | 57 | (define (add-sierpinski scene0 a b c) 58 | (cond 59 | [(too-small? a b c) scene0] 60 | [else 61 | (local 62 | ((define scene1 (add-triangle scene0 a b c)) 63 | (define mid-a-b (mid-point a b)) 64 | (define mid-b-c (mid-point b c)) 65 | (define mid-c-a (mid-point c a)) 66 | (define scene2 67 | (add-sierpinski scene1 a mid-a-b mid-c-a)) 68 | (define scene3 69 | (add-sierpinski scene2 b mid-b-c mid-a-b))) 70 | (add-sierpinski scene3 c mid-c-a mid-b-c))])) 71 | 72 | 73 | ;;===================== 74 | ;; 527 75 | 76 | (define CENTER (make-posn 200 200)) 77 | (define RADIUS 200); the radius in pixels 78 | 79 | ;; Number -> Posn 80 | ;; determine the point on the circle with CENTER 81 | ;; and RADIUS whose angle is factor 82 | 83 | ;; e.x. 84 | ;; what are the x and y coordinates of the desired 85 | ;; point, when given: 120/360?? 86 | 87 | (define (circle-pt factor) 88 | (make-posn 89 | (+ 200 (floor (cos (* 2 pi factor)))) 90 | (- 200 (floor (sin (* 2 pi factor)))))) 91 | -------------------------------------------------------------------------------- /31-34 Accumulators/528.rkt: -------------------------------------------------------------------------------- 1 | (require 2htdp/image) 2 | 3 | 4 | (define MT (empty-scene 400 400)) 5 | (define COLOR 'red) 6 | (define LEFT-SHORT 33) 7 | (define LEFT-ROTATE 6) 8 | (define RIGHT-SHORT 20) 9 | (define RIGHT-ROTATE 8) 10 | (define X 200) 11 | (define Y 400) 12 | (define L 200) 13 | (define D 90) 14 | 15 | ;;============================== 16 | ;; 528 17 | 18 | ;; Image Number Number Number Number -> Image 19 | 20 | (define (add-savannah img x y l d) 21 | (cond 22 | [(<= l 8) img] 23 | [else 24 | (local 25 | ((define cos-l (floor (* l (cos (degree->radian d))) )) 26 | (define sin-l (floor (* l (sin (degree->radian d))) )) 27 | (define img1 28 | (scene+line img x y (+ x cos-l) (- y sin-l) COLOR)) 29 | (define left-branch 30 | (add-savannah img1 31 | (+ x (* 1/3 cos-l )) 32 | (- y (* 1/3 sin-l )) 33 | (* l (- 1 (/ LEFT-SHORT 100))) 34 | (+ d LEFT-ROTATE)))) 35 | (add-savannah left-branch 36 | (+ x (* 2/3 cos-l )) 37 | (- y (* 2/3 sin-l )) 38 | (* l (- 1 (/ RIGHT-SHORT 100))) 39 | (- d RIGHT-ROTATE)))])) 40 | 41 | ;; Number -> Number 42 | ;; convert a degree to a radian 43 | (define (degree->radian d) 44 | (* 2 pi (/ d 360))) 45 | 46 | 47 | -------------------------------------------------------------------------------- /31-34 Accumulators/529.rkt: -------------------------------------------------------------------------------- 1 | (require 2htdp/image) 2 | 3 | (define COLOR 'red) 4 | (define MT (empty-scene 400 400)) 5 | (define A (make-posn 10 10)) 6 | (define B (make-posn 200 300)) 7 | (define C (make-posn 400 100)) 8 | 9 | ;;====================== 10 | ;; 529 11 | 12 | ;; Image Posn Posn Posn -> Image 13 | ;; draw a smooth curve between a and c according to the perspective of b 14 | (define (draw-curve img a b c) 15 | (cond 16 | [(<= (distance a c) 1) img] 17 | [else 18 | (local ((define mid-a-b (mid-point a b)) 19 | (define mid-c-b (mid-point b c)) 20 | (define mid-mid (mid-point mid-a-b mid-c-b)) 21 | (define img1 22 | (scene+line img (posn-x mid-mid) (posn-y mid-mid) 23 | (posn-x mid-mid) (posn-y mid-mid) COLOR)) 24 | (define img2 25 | (draw-curve img1 a mid-a-b mid-mid))) 26 | (draw-curve img2 mid-mid mid-c-b c))])) 27 | 28 | 29 | 30 | 31 | 32 | ;;====================== 33 | ;; Auxiliary Functions 34 | 35 | 36 | ;; Posn Posn -> Boolean 37 | ;; calculate the distance between two posns 38 | (define (distance a b) 39 | (sqrt (+ (expt (- (posn-y a) (posn-y b)) 2) 40 | (expt (- (posn-x a) (posn-x b)) 2)))) 41 | 42 | ;; Posn Posn -> Posn 43 | ;; determine the midpoint between a and b 44 | (define (mid-point a b) 45 | (make-posn (/ (+ (posn-x a) (posn-x b)) 2) 46 | (/ (+ (posn-y a) (posn-y b)) 2))) 47 | -------------------------------------------------------------------------------- /8-13 Arbitrarily Large Data/10-163-165.rkt: -------------------------------------------------------------------------------- 1 | ;; The first three lines of this file were inserted by DrRacket. They record metadata 2 | ;; about the language level of this file in a form that our tools can easily process. 3 | #reader(lib "htdp-beginner-reader.ss" "lang")((modname 10-163-165) (read-case-sensitive #t) (teachpacks ()) (htdp-settings #(#t constructor repeating-decimal #f #t none #f () #f))) 4 | ; Number -> Number 5 | ; converts a Fahrenheit to a Celsius 6 | (define (f2c f) 7 | (/ (- f 32) 1.8)) 8 | 9 | ; List-of-numbers -> List-of-numbers 10 | ; converts a list of Fahrenheit to a list of Celsius 11 | (define (f2c* fl) 12 | (cond 13 | [(empty? fl) '()] 14 | [else (cons (f2c (first fl)) (f2c* (rest fl)))])) 15 | 16 | ; List-of-strings -> List-of-strings 17 | ; substitute all "robot" in old with "r2d2" 18 | (check-expect (subst-robot (cons "robot" '())) (cons "r2d2" '())) 19 | (define (subst-robot old) 20 | (cond 21 | [(empty? old) '()] 22 | [else (cons (if (string=? (first old) "robot") 23 | "r2d2" 24 | (first old))(subst-robot (rest old)))])) 25 | -------------------------------------------------------------------------------- /8-13 Arbitrarily Large Data/10-166.rkt: -------------------------------------------------------------------------------- 1 | ;; The first three lines of this file were inserted by DrRacket. They record metadata 2 | ;; about the language level of this file in a form that our tools can easily process. 3 | #reader(lib "htdp-beginner-reader.ss" "lang")((modname 10-166) (read-case-sensitive #t) (teachpacks ()) (htdp-settings #(#t constructor repeating-decimal #f #t none #f () #f))) 4 | (define-struct work [employee rate hours]) 5 | ; a (piece of) Work is a structure: 6 | ; (make-work String Number Number) 7 | ; interpretation (make-work n r h) combines the employee's name 8 | ; with the pay rate r and the number of hours of work 9 | (define w2 (make-work "Robby" 11.95 39)) 10 | (define w3 (make-work "Matthew" 12.95 45)) 11 | 12 | (define-struct pay [employee pay]) 13 | ; a Pay is a structure: 14 | ; (make-pay String Number) 15 | ; interpretation (make-pay n p) combines the employee's name 16 | ; with the money s/he should be paied 17 | (define p2 (make-pay "Robby" (* 11.95 39))) 18 | (define p3 (make-pay "Matthew" (* 12.95 45))) 19 | 20 | ; Low (short for list of works) is one of: 21 | ; - '() 22 | ; - (cons Work Low) 23 | ; interpretation an instance of Low represents the 24 | ; hours worked for a number of employees 25 | (define l2 (cons (make-work "Robby" 11.95 39) 26 | '())) 27 | (define l3 (cons (make-work "Matthew" 12.95 45) 28 | (cons (make-work "Robby" 11.95 39) 29 | '()))) 30 | 31 | ; Lop (short for list of Pays) is one of: 32 | ; - '() 33 | ; - (cons Pay Lop) 34 | ; interpretation an instance of Lop represents the 35 | ; pay checks 36 | (define lop2 (cons p2 '())) 37 | (define lop3 (cons p3 lop2)) 38 | 39 | ; Work -> Number 40 | ; computes the wage for a given work 41 | (check-expect (wage.v2 w2) (* 11.95 39)) 42 | (check-expect (wage.v2 w3) (* 12.95 45)) 43 | (define (wage.v2 w) 44 | (* (work-rate w) (work-hours w))) 45 | 46 | ; Low -> List-of-numbers 47 | ; computes the weekly wages for the given records 48 | (check-expect (wage*.v2 l3) (cons (* 12.95 45) (cons (* 11.95 39) '()))) 49 | (define (wage*.v2 an-low) 50 | (cond 51 | [(empty? an-low) '()] 52 | [else (cons (wage.v2 (first an-low)) 53 | (wage*.v2 (rest an-low)))])) 54 | 55 | ; Work -> Pay 56 | ; computes the wage for a given work 57 | (check-expect (wage.v3 w2) p2) 58 | (check-expect (wage.v3 w3) p3) 59 | (define (wage.v3 w) 60 | (make-pay (work-employee w) (* (work-rate w) (work-hours w)))) 61 | 62 | ; Low -> Lop 63 | ; computes the weekly pay check for the given records 64 | (check-expect (wage*.v3 l2) lop2) 65 | (check-expect (wage*.v3 l3) lop3) 66 | (define (wage*.v3 low) 67 | (cond 68 | [(empty? low) '()] 69 | [else (cons (wage.v3 (first low)) 70 | (wage*.v3 (rest low)))])) 71 | -------------------------------------------------------------------------------- /8-13 Arbitrarily Large Data/10-167-168-169.rkt: -------------------------------------------------------------------------------- 1 | ;; The first three lines of this file were inserted by DrRacket. They record metadata 2 | ;; about the language level of this file in a form that our tools can easily process. 3 | #reader(lib "htdp-beginner-reader.ss" "lang")((modname 10-167-168-169) (read-case-sensitive #t) (teachpacks ()) (htdp-settings #(#t constructor repeating-decimal #f #t none #f () #f))) 4 | ; Lop (short for List of Posns) is one of: 5 | ; - '() 6 | ; - (cons Posn Lop) 7 | ; interpretation an instance of Lop is a list of Posns 8 | (define lop1 '()) 9 | (define lop2 (cons (make-posn 23 4) lop1)) 10 | (define lop3 (cons (make-posn 23 8) lop2)) 11 | 12 | ; Lop -> Number 13 | ; computes the sum of all of x-coordinates of posns int he lop 14 | (check-expect (sum lop1) 0) 15 | (check-expect (sum lop2) 23) 16 | (check-expect (sum lop3) 46) 17 | (define (sum lop) 18 | (cond 19 | [(empty? lop) 0] 20 | [else (+ (posn-x (first lop)) 21 | (sum (rest lop)))]) ) 22 | 23 | ; Lop -> Lop 24 | ; produces a new list of Posns where every y-coordinate has been increased 1 f 25 | (check-expect (translate lop1) '()) 26 | (check-expect (translate lop2) (cons (make-posn 23 5) '())) 27 | (check-expect (translate lop3) (cons (make-posn 23 9) (cons (make-posn 23 5) '()))) 28 | (define (translate lop) 29 | (cond 30 | [(empty? lop) '()] 31 | [else (cons (make-posn (posn-x (first lop)) (+ 1 (posn-y (first lop)))) 32 | (translate (rest lop)))])) 33 | 34 | ; Posn -> Boolean 35 | ; produces #true if the x-coordinate is between 0 and 100 36 | ; and y-coordinate is between 0 and 200 37 | (check-expect (legal? (make-posn 300 100)) #false) 38 | (check-expect (legal? (make-posn 100 300)) #false) 39 | (check-expect (legal? (make-posn 100 100)) #true) 40 | (define (legal? p) 41 | (and (<= 0 (posn-x p) 100) 42 | (<= 0 (posn-y p) 200))) 43 | 44 | ; Lop -> Lop 45 | ; only keep those Posns whose x-coordinates are between 0 and 100 and 46 | ; y-coordinates are between 0 and 200 47 | (check-expect (legal (cons (make-posn 300 300) (cons (make-posn 34 90) '()))) 48 | (cons (make-posn 34 90) '())) 49 | (define (legal lop) 50 | (cond 51 | [(empty? lop) '()] 52 | [else (if (legal? (first lop)) 53 | (cons (first lop) (legal (rest lop))) 54 | (legal (rest lop)))])) 55 | 56 | -------------------------------------------------------------------------------- /8-13 Arbitrarily Large Data/10-170.rkt: -------------------------------------------------------------------------------- 1 | ;; The first three lines of this file were inserted by DrRacket. They record metadata 2 | ;; about the language level of this file in a form that our tools can easily process. 3 | #reader(lib "htdp-beginner-reader.ss" "lang")((modname 10-170) (read-case-sensitive #t) (teachpacks ()) (htdp-settings #(#t constructor repeating-decimal #f #t none #f () #f))) 4 | (define-struct phone [area switch four]) 5 | ; A Phone is a structure: 6 | ; (make-phone Three Three Four) 7 | ; A Three is a Number between 100 and 999 8 | ; A Four is a Number between 1000 and 9999 9 | (define p1 (make-phone 713 234 5678)) 10 | (define p2 (make-phone 234 123 1234)) 11 | 12 | ; Lop (short for list of Phones) is one of: 13 | ; - '() 14 | ; - (cons Phone Lop) 15 | (define l1 (cons p1 '())) 16 | (define l2 (cons p2 l1)) 17 | 18 | ; Lop -> Lop 19 | ; replaces all occurrence of area code 713 with 281 20 | (check-expect (replace l1) (cons (make-phone 281 234 5678) '())) 21 | (check-expect (replace l2) (cons p2 (cons (make-phone 281 234 5678) '()))) 22 | (define (replace lop) 23 | (cond 24 | [(empty? lop) '()] 25 | [else (cons (make-phone (if (= 713 (phone-area (first lop))) 26 | 281 27 | (phone-area (first lop))) 28 | (phone-switch (first lop)) 29 | (phone-four (first lop))) 30 | (replace (rest lop)))])) 31 | -------------------------------------------------------------------------------- /8-13 Arbitrarily Large Data/10-172.rkt: -------------------------------------------------------------------------------- 1 | ;; The first three lines of this file were inserted by DrRacket. They record metadata 2 | ;; about the language level of this file in a form that our tools can easily process. 3 | #reader(lib "htdp-beginner-reader.ss" "lang")((modname 10-172) (read-case-sensitive #t) (teachpacks ()) (htdp-settings #(#t constructor repeating-decimal #f #t none #f () #f))) 4 | (require 2htdp/batch-io) 5 | 6 | ; Low -> String 7 | ; converts a list of words into a string 8 | (define (w2s l) 9 | (cond 10 | [(empty? l) ""] 11 | [else (string-append (first l) " " (w2s (rest l)))])) 12 | 13 | ; LLS -> String 14 | ; converts a list of lines into a string 15 | (define (collapse l) 16 | (cond 17 | [(empty? l) ""] 18 | [else (string-append 19 | (w2s (first l)) "\n" (collapse (rest l)))])) 20 | -------------------------------------------------------------------------------- /8-13 Arbitrarily Large Data/10-173.rkt: -------------------------------------------------------------------------------- 1 | ;; The first three lines of this file were inserted by DrRacket. They record metadata 2 | ;; about the language level of this file in a form that our tools can easily process. 3 | #reader(lib "htdp-beginner-reader.ss" "lang")((modname 10-173) (read-case-sensitive #t) (teachpacks ()) (htdp-settings #(#t constructor repeating-decimal #f #t none #f () #f))) 4 | (require 2htdp/batch-io) 5 | 6 | (define ARTICLES (cons "a" (cons "an" (cons "the" '())))) 7 | 8 | ; String -> String 9 | ; removes all the articles in the given file 10 | (define (remove-article* n) 11 | (remove-article (read-words n))) 12 | 13 | ; Low -> String 14 | ; removes all the articles in the given list of words 15 | (define (remove-article low) 16 | (cond 17 | [(empty? low) ""] 18 | [else (if (member? (first low) ARTICLES) 19 | (remove-article (rest low)) 20 | (string-append (first low) 21 | " " (remove-article (rest low))))])) 22 | -------------------------------------------------------------------------------- /8-13 Arbitrarily Large Data/10-174.rkt: -------------------------------------------------------------------------------- 1 | ;; The first three lines of this file were inserted by DrRacket. They record metadata 2 | ;; about the language level of this file in a form that our tools can easily process. 3 | #reader(lib "htdp-beginner-reader.ss" "lang")((modname 10-174) (read-case-sensitive #t) (teachpacks ()) (htdp-settings #(#t constructor repeating-decimal #f #t none #f () #f))) 4 | (require 2htdp/batch-io) 5 | 6 | ; 1String -> String 7 | ; converts the given 1String to a 3-letter numeric String 8 | (define (encode-letter s) 9 | (cond 10 | [(>= (string->int s) 100) (code1 s)] 11 | [(< (string->int s) 10) 12 | (string-append "00" (code1 s))] 13 | [(< (string->int s) 100) 14 | (string-append "0" (code1 s))])) 15 | 16 | ; 1String -> String 17 | ; convert the given 1String into a String 18 | (check-expect (code1 "z") "122") 19 | (define (code1 c) 20 | (number->string (string->int c))) 21 | 22 | ; String -> String 23 | ; converts the given word into a numeric string 24 | (define (encode-word w) 25 | (cond 26 | [(string=? w "") ""] 27 | [else (string-append (encode-letter (substring w 0 1)) 28 | (encode-word (substring w 1 (string-length w))))])) 29 | 30 | ; Low -> Low 31 | ; encodes a list of words 32 | (check-expect (encode-line (cons "z" (cons "z" '()))) (cons "122" (cons "122" '()))) 33 | (define (encode-line l) 34 | (cond 35 | [(empty? l) '() ] 36 | [else (cons (encode-word (first l)) 37 | (encode-line (rest l)))])) 38 | 39 | ; LLS -> LLS 40 | ; encodes a list of list of strings 41 | (define (encode-lls l) 42 | (cond 43 | [(empty? l) '()] 44 | [else (cons (encode-line (first l)) 45 | (encode-lls (rest l)))])) 46 | 47 | ; String -> LLS 48 | ; encodes a file 49 | (define (encode-file n) 50 | (encode-lls (read-words/line n))) 51 | -------------------------------------------------------------------------------- /8-13 Arbitrarily Large Data/10-175.rkt: -------------------------------------------------------------------------------- 1 | ;; The first three lines of this file were inserted by DrRacket. They record metadata 2 | ;; about the language level of this file in a form that our tools can easily process. 3 | #reader(lib "htdp-beginner-reader.ss" "lang")((modname 10-175) (read-case-sensitive #t) (teachpacks ()) (htdp-settings #(#t constructor repeating-decimal #f #t none #f () #f))) 4 | (require 2htdp/batch-io) 5 | 6 | (define-struct wc [letters words lines]) 7 | ; (make-wc Number Number Number) where letters represents the number of 1Strings 8 | ; the words represents the number of words 9 | ; the lines represents the number of line in a given file 10 | 11 | ; String -> Wc 12 | ; counts the number of letters, words, and lines in a given file 13 | (define (count n) 14 | (make-wc (count-letters (read-words n)) 15 | (length (read-words n)) 16 | (length (read-lines n)))) 17 | 18 | ; Low -> Number 19 | ; counts the number of 1Strings in a given list of words 20 | (define (count-letters l) 21 | (cond 22 | [(empty? l) 0] 23 | [else (+ (string-length (first l)) 24 | (count-letters (rest l)))])) 25 | -------------------------------------------------------------------------------- /8-13 Arbitrarily Large Data/10-176.rkt: -------------------------------------------------------------------------------- 1 | ;; The first three lines of this file were inserted by DrRacket. They record metadata 2 | ;; about the language level of this file in a form that our tools can easily process. 3 | #reader(lib "htdp-beginner-reader.ss" "lang")((modname 10-176) (read-case-sensitive #t) (teachpacks ()) (htdp-settings #(#t constructor repeating-decimal #f #t none #f () #f))) 4 | ; A Matrix is one of: 5 | ; – (cons Row '()) 6 | ; – (cons Row Matrix) 7 | ; constraint all rows in matrix are of the same length 8 | 9 | ; An Row is one of: 10 | ; – '() 11 | ; – (cons Number Row) 12 | 13 | (define row1 (cons 11 (cons 12 '()))) 14 | (define row2 (cons 21 (cons 22 '()))) 15 | (define mat1 (cons row1 (cons row2 '()))) 16 | 17 | ; Matrix -> Matrix 18 | ; transpose the given matrix along the diagonal 19 | 20 | (define wor1 (cons 11 (cons 21 '()))) 21 | (define wor2 (cons 12 (cons 22 '()))) 22 | (define tam1 (cons wor1 (cons wor2 '()))) 23 | 24 | (check-expect (transpose mat1) tam1) 25 | 26 | (define (transpose lln) 27 | (cond 28 | [(empty? (first lln)) '()] 29 | [else (cons (first* lln) (transpose (rest* lln)))])) 30 | 31 | ; Matrix -> Row 32 | ;get the first column of the matrix m 33 | (check-expect (first* mat1) (cons 11 (cons 21 '()))) 34 | (define (first* m) 35 | (cond 36 | [(empty? m) '()] 37 | [else (cons (first (first m)) 38 | (first* (rest m)))])) 39 | 40 | ; Matrix -> Matrix 41 | ; get the rest columns of the matrix except for the first one 42 | (define (rest* m) 43 | (cond 44 | [(empty? m) '()] 45 | [else (cons (rest (first m)) 46 | (rest* (rest m)))])) 47 | -------------------------------------------------------------------------------- /8-13 Arbitrarily Large Data/11-181-184.rkt: -------------------------------------------------------------------------------- 1 | ;; The first three lines of this file were inserted by DrRacket. They record metadata 2 | ;; about the language level of this file in a form that our tools can easily process. 3 | #reader(lib "htdp-beginner-abbr-reader.ss" "lang")((modname 11-181-184) (read-case-sensitive #t) (teachpacks ()) (htdp-settings #(#t constructor repeating-decimal #f #t none #f () #f))) 4 | ; Exercise 181 5 | (check-expect (list "a" "b" "c" "d") (cons "a" (cons "b" (cons "c" (cons "d" '()))))) 6 | (check-expect (list (list 1 2)) (cons (cons 1 (cons 2 '())) '())) 7 | (check-expect (list "a" (list 1) #false) (cons "a" (cons (cons 1 '()) (cons #false '())))) 8 | (check-expect (list (list "a" 2) "hello") (cons (cons "a" (cons 2 '())) (cons "hello" '()))) 9 | (check-expect (list (list 1 2) 10 | (list 2)) 11 | (cons (cons 1 (cons 2 '())) 12 | (cons (cons 2 '()) 13 | '()))) 14 | 15 | ; Exercise 182 16 | (check-expect (cons 0 (cons 1 (cons 2 (cons 3 (cons 4 (cons 5 '())))))) 17 | (list 0 1 2 3 4 5)) 18 | (check-expect (cons (cons "he" (cons 0 '())) 19 | (cons (cons "it" (cons 1 '())) 20 | (cons (cons "lui" (cons 14 '())) 21 | '()))) 22 | (list (list "he" 0) (list "it" 1) (list "lui" 14))) 23 | (check-expect (cons 1 24 | (cons (cons 1 (cons 2 '())) 25 | (cons (cons 1 (cons 2 (cons 3 '()))) 26 | '()))) 27 | (list 1 (list 1 2) (list 1 2 3))) 28 | 29 | ; Exercise 183 30 | (check-expect (list "a" 0 #false) 31 | (cons "a" (list 0 #false))) 32 | (check-expect (list (list 1 13)) 33 | (list (cons 1 (cons 13 '())))) 34 | (check-expect (list (list 1 (list 13 '()))) 35 | (cons (list 1 (list 13 '())) '())) 36 | (check-expect (list '() '() (list 1)) 37 | (list '() '() (cons 1 '()))) 38 | (check-expect (list "a" (list 1) #false '()) 39 | (cons "a" (cons (list 1) (list #false '())))) 40 | 41 | ; Exercise 184 42 | (check-expect (list #false #false) 43 | (list (string=? "a" "b") #false)) 44 | (check-expect (list 30 200 1/2) 45 | (list (+ 10 20) (* 10 20) (/ 10 20))) 46 | (check-expect (list "dana" "jane" "mary" "laura") 47 | (list "dana" "jane" "mary" "laura")) 48 | -------------------------------------------------------------------------------- /8-13 Arbitrarily Large Data/11-186.rkt: -------------------------------------------------------------------------------- 1 | ;; The first three lines of this file were inserted by DrRacket. They record metadata 2 | ;; about the language level of this file in a form that our tools can easily process. 3 | #reader(lib "htdp-beginner-abbr-reader.ss" "lang")((modname 11-186) (read-case-sensitive #t) (teachpacks ()) (htdp-settings #(#t constructor repeating-decimal #f #t none #f () #f))) 4 | ; List-of-numbers -> Boolean 5 | ; determines if a list of numbers is sorted in a descending order 6 | (check-expect (sort>? '()) #true) 7 | (check-expect (sort>? (list 12)) #true) 8 | (check-expect (sort>? (list 2 3)) #false) 9 | (check-expect (sort>? (list 3 2)) #true) 10 | (define (sort>? l) 11 | (cond 12 | [(empty? l) #true] 13 | [(empty? (rest l)) #true] 14 | [else (and (> (first l) (first (rest l))) 15 | (sort>? (rest l)))])) 16 | 17 | ; List-of-numbers -> List-of-numbers 18 | ; produces a sorted version of l 19 | (check-satisfied (sort> '()) sort>?) 20 | (check-satisfied (sort> (list 2)) sort>?) 21 | (check-satisfied (sort> (list 3 2)) sort>?) 22 | (define (sort> l) 23 | (cond 24 | [(empty? l) '()] 25 | [(cons? l) (insert (first l) (sort> (rest l)))])) 26 | 27 | ; Number List-of-numbers -> List-of-numbers 28 | ; inserts n into the sorted list of numbers l 29 | (define (insert n l) 30 | (cond 31 | [(empty? l) (cons n '())] 32 | [else (if (>= n (first l)) 33 | (cons n l) 34 | (cons (first l) (insert n (rest l))))])) 35 | 36 | ; List-of-numbers -> List-of-numbers 37 | ; produces a sorted version of l 38 | (check-satisfied (sort>/bad (list 2 3)) sort>?) 39 | (define (sort>/bad l) 40 | '(9 8 7 6 5 4 3 2 1 0)) 41 | -------------------------------------------------------------------------------- /8-13 Arbitrarily Large Data/11-187.rkt: -------------------------------------------------------------------------------- 1 | ;; The first three lines of this file were inserted by DrRacket. They record metadata 2 | ;; about the language level of this file in a form that our tools can easily process. 3 | #reader(lib "htdp-beginner-abbr-reader.ss" "lang")((modname 11-187) (read-case-sensitive #t) (teachpacks ()) (htdp-settings #(#t constructor repeating-decimal #f #t none #f () #f))) 4 | (define-struct gp [name score]) 5 | ; A GamePlayer is a structure: 6 | ; (make-gp String Number) 7 | ; interpretation (make-gp p s) represents player p who 8 | ; scored a maximum of s points 9 | (define g1 (make-gp "Player1" 34)) 10 | (define g2 (make-gp "Player2" 44)) 11 | 12 | ; a Log (short for List-of-game-players) is one of: 13 | ; - '() 14 | ; - (cons gp Log) 15 | (define l1 (list g1 g2)) 16 | (define l3 (list g2 g1)) 17 | (define l2 (list g1)) 18 | 19 | ; Log -> Boolean 20 | ; determines if the list of game players is in a descending order 21 | (check-expect (sort>? l1) #false) 22 | (check-expect (sort>? l2) #true) 23 | (check-expect (sort>? '()) #true) 24 | (check-expect (sort>? l3) #true) 25 | (define (sort>? l) 26 | (cond 27 | [(empty? l) #true] 28 | [(empty? (rest l)) #true] 29 | [else (and (> (gp-score (first l)) 30 | (gp-score (first (rest l)))) 31 | (sort>? (rest l)))])) 32 | 33 | ; gp Log -> Log 34 | ; inserts a player p into the sorted list of players l 35 | (check-expect (insert g2 l2) l3) 36 | (check-expect (insert g1 '()) l2) 37 | (define (insert p l) 38 | (cond 39 | [(empty? l) (list p)] 40 | [else (if (>= (gp-score p) (gp-score (first l))) 41 | (cons p l) 42 | (cons (first l) 43 | (insert p (rest l))))])) 44 | 45 | ; Log -> Log 46 | ; sorts a list of game players in a descending order 47 | (check-satisfied (sort> l1) sort>?) 48 | (check-satisfied (sort> l2) sort>?) 49 | (check-satisfied (sort> l3) sort>?) 50 | (check-satisfied (sort> '()) sort>?) 51 | (define (sort> l) 52 | (cond 53 | [(empty? l) '()] 54 | [else (insert (first l) 55 | (sort> (rest l)))])) 56 | 57 | -------------------------------------------------------------------------------- /8-13 Arbitrarily Large Data/11-188.rkt: -------------------------------------------------------------------------------- 1 | ;; The first three lines of this file were inserted by DrRacket. They record metadata 2 | ;; about the language level of this file in a form that our tools can easily process. 3 | #reader(lib "htdp-beginner-abbr-reader.ss" "lang")((modname 11-188) (read-case-sensitive #t) (teachpacks ()) (htdp-settings #(#t constructor repeating-decimal #f #t none #f () #f))) 4 | (define-struct email [from date message]) 5 | ; A Email Message is a structure: 6 | ; (make-email String Number String) 7 | ; interpretation (make-email f d m) represents text m 8 | ; sent by f, d seconds after the beginning of time 9 | (define e1 (make-email "user1" 12 "hello")) 10 | (define e2 (make-email "user2" 22 "hello")) 11 | 12 | ; a Loe (short for list of emails) is one of: 13 | ; - '() 14 | ; - (cons email Loe) 15 | (define l1 (list e1)) 16 | (define l2 (list e2)) 17 | (define l3 (list e1 e2)) 18 | (define l4 (list e2 e1)) 19 | 20 | ; Loe -> Loe 21 | ; sorts list of emails by name 22 | (check-satisfied (sort> l1) sort>?) 23 | (check-satisfied (sort> l2) sort>?) 24 | (check-satisfied (sort> l3) sort>?) 25 | (check-satisfied (sort> l4) sort>?) 26 | (define (sort> l) 27 | (cond 28 | [(empty? l) '()] 29 | [else (insert (first l) 30 | (sort> (rest l)))])) 31 | 32 | ; email Loe -> Loe 33 | ; inserts an email into a sorted list of emails 34 | (check-expect (insert e1 '()) l1) 35 | (check-expect (insert e1 l2) l4) 36 | (define (insert e l) 37 | (cond 38 | [(empty? l) (list e)] 39 | [else (if (>= (email-date e) 40 | (email-date (first l))) 41 | (cons e l) 42 | (cons (first l) 43 | (insert e (rest l))))])) 44 | 45 | ; Loe -> Boolean 46 | ; determines if a list of emails is in a descending order by name 47 | (check-expect (sort>? '()) #true) 48 | (check-expect (sort>? l1) #true) 49 | (check-expect (sort>? l3) #false) 50 | (check-expect (sort>? l4) #true) 51 | (define (sort>? l) 52 | (cond 53 | [(empty? l) #true] 54 | [(empty? (rest l)) #true] 55 | [else (and (> (email-date (first l)) 56 | (email-date (first (rest l)))) 57 | (sort>? (rest l)))])) 58 | -------------------------------------------------------------------------------- /8-13 Arbitrarily Large Data/11-189.rkt: -------------------------------------------------------------------------------- 1 | ;; The first three lines of this file were inserted by DrRacket. They record metadata 2 | ;; about the language level of this file in a form that our tools can easily process. 3 | #reader(lib "htdp-beginner-abbr-reader.ss" "lang")((modname 11-189) (read-case-sensitive #t) (teachpacks ()) (htdp-settings #(#t constructor repeating-decimal #f #t none #f () #f))) 4 | ; Number List-of-numbers -> Boolean 5 | (define (search n alon) 6 | (cond 7 | [(empty? alon) #false] 8 | [else (or (= (first alon) n) 9 | (search n (rest alon)))])) 10 | 11 | ; Number List-of-numbers -> Boolean 12 | ; determines if a number exists in a sorted list 13 | (check-expect (search-sorted 1 '()) #false) 14 | (check-expect (search-sorted 1 (list 3 2)) #false) 15 | (check-expect (search-sorted 1 (list 3 1)) #true) 16 | (check-expect (search-sorted 1 (list 0 -1)) #false) 17 | (check-expect (search-sorted 1 (list 1)) #true) 18 | (define (search-sorted n alon) 19 | (cond 20 | [(empty? alon) #false] 21 | [(> n (first alon)) #false] 22 | [else (or (= (first alon) n) 23 | (search n (rest alon)))])) 24 | -------------------------------------------------------------------------------- /8-13 Arbitrarily Large Data/11-190.rkt: -------------------------------------------------------------------------------- 1 | ;; The first three lines of this file were inserted by DrRacket. They record metadata 2 | ;; about the language level of this file in a form that our tools can easily process. 3 | #reader(lib "htdp-beginner-abbr-reader.ss" "lang")((modname 11-190) (read-case-sensitive #t) (teachpacks ()) (htdp-settings #(#t constructor repeating-decimal #f #t none #f () #f))) 4 | ; Lo1s -> Lol 5 | ; produces the list of all prefixes (in the form of Lo1S) 6 | (define (prefixes l) 7 | (cond 8 | [(empty? l) '()] 9 | [else 10 | (cons l (prefixes (cut-tail l)))])) 11 | 12 | ; Lo1S -> Lo1s 13 | ; cuts the last 1String from the given list 14 | (check-expect (cut-tail (list 1 2 3)) (list 1 2)) 15 | (check-expect (cut-tail (list 1)) '()) 16 | (define (cut-tail l) 17 | (cond 18 | [(empty? l) '()] 19 | [(empty? (rest l)) '()] 20 | [else (cons (first l) 21 | (cut-tail (rest l)))])) 22 | 23 | ; Lo1S -> Lol 24 | ; produces the list of all suffixes 25 | (define (suffixes l) 26 | (cond 27 | [(empty? l) '()] 28 | [else (cons l (suffixes (rest l)))])) 29 | -------------------------------------------------------------------------------- /8-13 Arbitrarily Large Data/11-193.rkt: -------------------------------------------------------------------------------- 1 | ;; The first three lines of this file were inserted by DrRacket. They record metadata 2 | ;; about the language level of this file in a form that our tools can easily process. 3 | #reader(lib "htdp-beginner-abbr-reader.ss" "lang")((modname 11-193) (read-case-sensitive #t) (teachpacks ()) (htdp-settings #(#t constructor repeating-decimal #f #t none #f () #f))) 4 | (require 2htdp/image) 5 | 6 | ;-------------------------------- 7 | (define MT (empty-scene 50 50)) 8 | ;-------------------------------- 9 | ; Image NELoP -> Image 10 | ; connects the Posns in p in an image 11 | (define (connect-dots img p) 12 | (cond 13 | [(empty? (rest p)) MT] 14 | [else (render-line (connect-dots img (rest p)) 15 | (first p) 16 | (second p))])) 17 | 18 | ; Image Posn Posn -> Image 19 | ; draws a red line from Posn p to Posn q into im 20 | (define (render-line im p q) 21 | (scene+line 22 | im (posn-x p) (posn-y p) (posn-x q) (posn-y q) "red")) 23 | 24 | ; Polygon -> Posn 25 | ; extracts the last item from p 26 | (define (last p) 27 | (cond 28 | [(empty? (rest (rest (rest p)))) (third p)] 29 | [else (last (rest p))])) 30 | 31 | ;----------------------------------- 32 | ; Image Polygon -> Image 33 | ; adds an image of p to MT 34 | (define (render-poly img p) 35 | (connect-dots img (cons (last p) p))) 36 | -------------------------------------------------------------------------------- /8-13 Arbitrarily Large Data/11-194.rkt: -------------------------------------------------------------------------------- 1 | ;; The first three lines of this file were inserted by DrRacket. They record metadata 2 | ;; about the language level of this file in a form that our tools can easily process. 3 | #reader(lib "htdp-beginner-abbr-reader.ss" "lang")((modname 11-194) (read-case-sensitive #t) (teachpacks ()) (htdp-settings #(#t constructor repeating-decimal #f #t none #f () #f))) 4 | (require 2htdp/image) 5 | 6 | ;-------------------------------- 7 | (define MT (empty-scene 50 50)) 8 | ;-------------------------------- 9 | ; Image NELoP Posn-> Image 10 | ; connects the Posns to the last Posn in p in an image 11 | (define (connect-dots img p pos) 12 | (cond 13 | [(empty? (rest p)) (render-line img (first p) pos)] 14 | [else (render-line (connect-dots img (rest p) pos) 15 | (first p) 16 | (second p))])) 17 | 18 | ; Image Posn Posn -> Image 19 | ; draws a red line from Posn p to Posn q into im 20 | (define (render-line im p q) 21 | (scene+line 22 | im (posn-x p) (posn-y p) (posn-x q) (posn-y q) "red")) 23 | 24 | ; Polygon -> Posn 25 | ; extracts the last item from p 26 | (define (last p) 27 | (cond 28 | [(empty? (rest (rest (rest p)))) (third p)] 29 | [else (last (rest p))])) 30 | 31 | ;----------------------------------- 32 | ; Image Polygon -> Image 33 | ; adds an image of p to MT 34 | (define (render-poly img p) 35 | (connect-dots img p (first p))) 36 | -------------------------------------------------------------------------------- /8-13 Arbitrarily Large Data/12-205-208.rkt: -------------------------------------------------------------------------------- 1 | ;; The first three lines of this file were inserted by DrRacket. They record metadata 2 | ;; about the language level of this file in a form that our tools can easily process. 3 | #reader(lib "htdp-beginner-abbr-reader.ss" "lang")((modname 12-205-208) (read-case-sensitive #t) (teachpacks ()) (htdp-settings #(#t constructor repeating-decimal #f #t none #f () #f))) 4 | ;----------------------------------- 5 | ; DATE DEFINITIONS 6 | ;----------------------------------- 7 | ; A BSDN is one of: 8 | ; – Boolean 9 | ; – Number 10 | ; – String 11 | ; – Date 12 | 13 | ; An Association is a list of two items: 14 | ; (cons String (cons BSDN '())) 15 | (define asso1 (list "time" 23)) 16 | (define asso2 (list "name" "Love Story")) 17 | (define asso3 (list "boolean" #false)) 18 | (define asso4 (list "time" 34)) 19 | (define asso5 (list "name" "May It Be")) 20 | (define asso6 (list "love?" #true)) 21 | 22 | ; An LAssoc is one of: 23 | ; – '() 24 | ; – (cons Association LAssoc) 25 | (define la1 (list asso1 asso2 asso3)) 26 | (define la2 (list asso4 asso5 asso6)) 27 | 28 | ; An LLists is one of: 29 | ; – '() 30 | ; – (cons LAssoc LLists) 31 | (define ll (list la1 la2)) 32 | 33 | ;----------------------------- 34 | ; EXERCISE 206 35 | ;---------------------------- 36 | ; String LAssoc Any -> Any 37 | ; produces the first Association whose first item is key 38 | ; or default if there is no such Association 39 | (check-expect (find-association "name" la1 "none") asso2) 40 | (check-expect (find-association "album" la2 "none") "none") 41 | (define (find-association key l default) 42 | (cond 43 | [(empty? l) default] 44 | [else (if (string=? key (first (first l))) 45 | (first l) 46 | (find-association key (rest l) default))])) 47 | 48 | ;----------------------------- 49 | ; EXERCISE 207 50 | ;----------------------------- 51 | ; LLists -> Number 52 | ; produces the total amount of play time 53 | (check-expect (total-time/list ll) 57) 54 | (define (total-time/list l) 55 | (cond 56 | [(empty? l) 0] 57 | [else (+ (if (list? (find-association "time" (first l) #false)) 58 | (second (find-association "time" (first l) #false)) 59 | 0) 60 | (total-time/list (rest l)))])) 61 | 62 | ;------------------------------- 63 | ; EXERCISE 208 64 | ;------------------------------ 65 | ; LLists -> List-of-strings 66 | ; produces the strings that are associated with a Boolean attribute 67 | (define (boolean-attributes l) 68 | (create-set (collapse (boolean-keys l))) 69 | ) 70 | 71 | ; LLists -> List-of-strings 72 | (define (boolean-keys l) 73 | (cond 74 | [(empty? l) '()] 75 | [else (cons (boolean-keys-assoc (first l)) 76 | (boolean-keys (rest l)))])) 77 | 78 | ; Any LAssoc Any -> Any 79 | ; produces the strings that are associated with a Boolean attribute 80 | (check-expect (boolean-keys-assoc la1) (list "boolean")) 81 | (define (boolean-keys-assoc a) 82 | (cond 83 | [(empty? a) '()] 84 | [else (if (boolean? (second (first a))) 85 | (cons (first (first a)) (boolean-keys-assoc (rest a))) 86 | (boolean-keys-assoc (rest a)))])) 87 | 88 | ; List-of-lists -> List 89 | ; removes all nestings 90 | (check-expect (collapse (list (list 1 2) (list 4 5))) (list 1 2 4 5)) 91 | (define (collapse l) 92 | (cond 93 | [(empty? l) '()] 94 | [else (cond 95 | [(empty? (first l)) (collapse (rest l))] 96 | [(list? (first l)) (cons (first (first l)) 97 | (collapse (cons (rest (first l)) 98 | (rest l))))] 99 | [else (cons (first l) (collapse (rest l)))])] 100 | )) 101 | 102 | ; List -> List 103 | ; leaves only 1 occurrence of each item 104 | (check-expect (create-set (list 1 1 2)) (list 1 2)) 105 | (define (create-set l) 106 | (cond 107 | [(empty? l) '()] 108 | [else (if (member? (first l) (rest l)) 109 | (create-set (rest l)) 110 | (cons (first l) (create-set (rest l))))])) 111 | -------------------------------------------------------------------------------- /8-13 Arbitrarily Large Data/12-209-211.rkt: -------------------------------------------------------------------------------- 1 | ;; The first three lines of this file were inserted by DrRacket. They record metadata 2 | ;; about the language level of this file in a form that our tools can easily process. 3 | #reader(lib "htdp-beginner-abbr-reader.ss" "lang")((modname 12-209-211) (read-case-sensitive #t) (teachpacks ()) (htdp-settings #(#t constructor repeating-decimal #f #t none #f () #f))) 4 | ;------------------------------ 5 | ; REQUIREMENTS 6 | ;----------------------------- 7 | 8 | (require 2htdp/batch-io) 9 | 10 | ;------------------------------- 11 | ; DATA DEFINITION 12 | ;------------------------------ 13 | 14 | ; a Word is one of: 15 | ; - '() 16 | ; - (cons 1String Word) 17 | (define cat (list "c" "a" "t")) 18 | (define act (list "a" "c" "t")) 19 | 20 | ; a List-of-words is one of: 21 | ; - '() 22 | ; - (cons Word List-of-words) 23 | (define lwcat (list cat act)) 24 | 25 | ;--------------------------------- 26 | ; CONSTANTS 27 | ;--------------------------------- 28 | 29 | (define DICTIONARY-LOCATION "/usr/share/dict/words") 30 | (define DICTIONARY-AS-LIST (read-lines DICTIONARY-LOCATION)) 31 | 32 | ;-------------------------------- 33 | ; EXERCISE 209 34 | ;-------------------------------- 35 | 36 | ; String -> Word 37 | ; converts s to the chosen word representation 38 | (check-expect (string->word "cat") cat) 39 | (define (string->word s) 40 | (cond 41 | [(zero? (string-length s)) '()] 42 | [else (cons (substring s 0 1) 43 | (string->word 44 | (substring s 1 (string-length s))))])) 45 | 46 | ; Word -> String 47 | ; converts w to a string 48 | (check-expect (word->string cat) "cat") 49 | (define (word->string w) 50 | (cond 51 | [(empty? w) ""] 52 | [else (string-append (first w) 53 | (word->string (rest w)))])) 54 | 55 | ;----------------------------- 56 | ; EXERCISE 210 57 | ;----------------------------- 58 | 59 | ; List-of-words -> List-of-strings 60 | ; converts ws to a list of strings 61 | (check-expect (words->strings lwcat) (list "cat" "act")) 62 | (define (words->strings ws) 63 | (cond 64 | [(empty? ws) '()] 65 | [else (cons (word->string (first ws)) 66 | (words->strings (rest ws)))])) 67 | 68 | ;--------------------------------- 69 | ; EXERCISE 211 70 | ;--------------------------------- 71 | 72 | ; List-of-strings -> List-of-strings 73 | ; extracts from the given s only words that are in dictionary 74 | (check-expect (in-dictionary (list "cat" "tac")) (list "cat")) 75 | (define (in-dictionary s) 76 | (cond 77 | [(empty? s) '()] 78 | [else (if (member? (first s) DICTIONARY-AS-LIST) 79 | (cons (first s) (in-dictionary (rest s))) 80 | (in-dictionary (rest s)))])) 81 | -------------------------------------------------------------------------------- /8-13 Arbitrarily Large Data/12-212-214.rkt: -------------------------------------------------------------------------------- 1 | ;; The first three lines of this file were inserted by DrRacket. They record metadata 2 | ;; about the language level of this file in a form that our tools can easily process. 3 | #reader(lib "htdp-beginner-abbr-reader.ss" "lang")((modname 12-212-214) (read-case-sensitive #t) (teachpacks ()) (htdp-settings #(#t constructor repeating-decimal #f #t none #f () #f))) 4 | (require 2htdp/batch-io) 5 | 6 | ;---------------------- 7 | ; DATA DEFINITIONS 8 | ;---------------------- 9 | 10 | ; a Word is one of: 11 | ; - '() or 12 | ; - (cons 1String Word) 13 | ; interpretation a String as a list of 1String 14 | (define de (list "d" "e")) 15 | (define ed (list "e" "d")) 16 | (define cat (list "c" "a" "t")) 17 | (define act (list "a" "c" "t")) 18 | 19 | ; a List-of-words is one of: 20 | ; - '() 21 | ; - (cons Word List-of-words) 22 | (define lw (list de ed)) 23 | (define lwcat (list cat act)) 24 | 25 | ;-------------------------------- 26 | ; CONSTANTS 27 | ;-------------------------------- 28 | (define DICTIONARY-LOCATION "/usr/share/dict/words") ; My OS is Fedora 29 | (define DICTIONARY-AS-LIST (read-lines DICTIONARY-LOCATION)) 30 | ;--------------------- 31 | ; EXERCISE 213 32 | ;--------------------- 33 | 34 | ; 1String List-of-words -> List-of-words 35 | ; inserts a letter into a list of words 36 | (check-expect (insert-everywhere/in-all-words "d" (list '())) (list (list "d"))) 37 | (check-expect (insert-everywhere/in-all-words "d" (list (list "e"))) (list de ed)) 38 | (define (insert-everywhere/in-all-words l w) 39 | (cond 40 | [(empty? w) '()] 41 | [else (append (insert-everywhere/one-word l (first w)) 42 | (insert-everywhere/in-all-words l (rest w)))])) 43 | 44 | ; 1String Word -> List-of-words 45 | ; inserts a letter into a word 46 | (check-expect (insert-everywhere/one-word "d" '()) (list (list "d"))) 47 | (check-expect (insert-everywhere/one-word "d" (list "e")) (list de ed)) 48 | (define (insert-everywhere/one-word l w) 49 | (cond 50 | [(empty? w) (list (list l))] 51 | [else (cons (cons l w) 52 | (add-at-first (first w) 53 | (insert-everywhere/one-word l (rest w))))])) 54 | 55 | ; 1String List-of-words -> List-of-words 56 | ; adds letter l at all the beginnings of words in the given w 57 | (check-expect (add-at-first "d" (list (list "e" "r") (list "r" "e"))) 58 | (list (list "d" "e" "r") (list "d" "r" "e"))) 59 | (define (add-at-first l w) 60 | (cond 61 | [(empty? w) '()] 62 | [else (cons (cons l (first w)) 63 | (add-at-first l (rest w)))])) 64 | 65 | ;------------------------------- 66 | ; EXERCISE 214 67 | ;------------------------------- 68 | 69 | ; String -> List-of-strings 70 | ; find all words that the letters of some given word spell 71 | (check-member-of (alternative-words "cat") 72 | (list "act" "cat") 73 | (list "cat" "act")) 74 | (define (alternative-words s) 75 | (in-dictionary 76 | (words->strings (arrangements (string->word s))))) 77 | 78 | ;--------------------- 79 | ; OTHER FUNCTIONS 80 | ;--------------------- 81 | 82 | ; Word -> List-of-words 83 | ; creates all rearrangements of the letters in w 84 | (define (arrangements w) 85 | (cond 86 | [(empty? w) (list '())] 87 | [else (insert-everywhere/in-all-words (first w) 88 | (arrangements (rest w)))])) 89 | 90 | ; String -> Word 91 | ; converts s to the chosen word representation 92 | (check-expect (string->word "cat") cat) 93 | (define (string->word s) 94 | (cond 95 | [(zero? (string-length s)) '()] 96 | [else (cons (substring s 0 1) 97 | (string->word 98 | (substring s 1 (string-length s))))])) 99 | 100 | ; Word -> String 101 | ; converts w to a string 102 | (check-expect (word->string cat) "cat") 103 | (define (word->string w) 104 | (cond 105 | [(empty? w) ""] 106 | [else (string-append (first w) 107 | (word->string (rest w)))])) 108 | 109 | ; List-of-words -> List-of-strings 110 | ; converts ws to a list of strings 111 | (check-expect (words->strings lwcat) (list "cat" "act")) 112 | (define (words->strings ws) 113 | (cond 114 | [(empty? ws) '()] 115 | [else (cons (word->string (first ws)) 116 | (words->strings (rest ws)))])) 117 | 118 | ; List-of-strings -> List-of-strings 119 | ; extracts from the given s only words that are in dictionary 120 | (check-expect (in-dictionary (list "cat" "tac")) (list "cat")) 121 | (define (in-dictionary s) 122 | (cond 123 | [(empty? s) '()] 124 | [else (if (member? (first s) DICTIONARY-AS-LIST) 125 | (cons (first s) (in-dictionary (rest s))) 126 | (in-dictionary (rest s)))])) 127 | 128 | 129 | -------------------------------------------------------------------------------- /8-13 Arbitrarily Large Data/12-226.228.rkt: -------------------------------------------------------------------------------- 1 | ;;========================== 2 | ; A FSM is one of: 3 | ; – '() 4 | ; – (cons Transition FSM) 5 | 6 | (define-struct transition [current next]) 7 | ; A Transition is a structure: 8 | ; (make-transition FSM-State FSM-State) 9 | 10 | ; FSM-State is a Color. 11 | 12 | ; interpretation A FSM represents the transitions that a 13 | ; finite state machine can take from one state to another 14 | ; in reaction to key strokes 15 | 16 | (define fsm-traffic 17 | (list (make-transition "red" "green") 18 | (make-transition "green" "yellow") 19 | (make-transition "yellow" "red"))) 20 | 21 | ;;============================ 22 | ;;226 23 | 24 | ; State State -> Boolean 25 | (define (state=? a b) 26 | (string=? a b)) 27 | 28 | 29 | ;;=========================== 30 | ;;228 31 | 32 | ; FSM FSM-State -> FSM-State 33 | ; finds the state representing current in transition 34 | ; and retrieve the next field 35 | (check-expect (find fsm-traffic "red") "green") 36 | (check-expect (find fsm-traffic "green") "yellow") 37 | (define (find transitions current) 38 | (cond 39 | [(empty? transitions) (string-append "not found: " current)] 40 | [else (if (state=? current (transition-current (first transitions))) 41 | (transition-next (first transitions)) 42 | (find (rest transitions) current))])) 43 | 44 | -------------------------------------------------------------------------------- /8-13 Arbitrarily Large Data/9-137-138.rkt: -------------------------------------------------------------------------------- 1 | ;; The first three lines of this file were inserted by DrRacket. They record metadata 2 | ;; about the language level of this file in a form that our tools can easily process. 3 | #reader(lib "htdp-beginner-reader.ss" "lang")((modname 9-137) (read-case-sensitive #t) (teachpacks ()) (htdp-settings #(#t constructor repeating-decimal #f #t none #f () #f))) 4 | ; A List-of-amounts is one of: 5 | ; - '() 6 | ; - (cons PositiveNumber List-of-amounts) 7 | ; Examples: 8 | (define e1'()) 9 | (define e2 (cons 12 e1)) 10 | (define e3 (cons 12 e2)) 11 | 12 | ; A List-of-numbers is one of: 13 | ; - '() 14 | ; - (cons Number List-of-numbers) 15 | (define n1 '()) 16 | (define n2 (cons 0 n1)) 17 | (define n3 (cons -1 n2)) 18 | (define n4 (cons 1 n1)) 19 | (define n5 (cons -3 n4)) 20 | 21 | 22 | ; List-of-amounts -> Number 23 | ; computes the sum of the amounts 24 | (check-expect (sum e1) 0) 25 | (check-expect (sum e2) 12) 26 | (check-expect (sum e3) 24) 27 | (define (sum l) 28 | (cond 29 | [(empty? l) 0] 30 | [(cons? l) 31 | (+ (first l) (sum (rest l)))])) 32 | 33 | 34 | ; List-of-numbers -> Boolean 35 | ; determines whether all numbers are positive numbers 36 | (check-expect (pos? n1) #true) 37 | (check-expect (pos? n2) #false) 38 | (check-expect (pos? n3) #false) 39 | (check-expect (pos? n4) #true) 40 | (check-expect (pos? n5) #false) 41 | (define (pos? l) 42 | (cond 43 | [(empty? l) #true] 44 | [(cons? l) 45 | (and (> (first l) 0) 46 | (pos? (rest l)))])) 47 | 48 | ; List-of-numbers -> Number 49 | ;produces their sum if the input also belongs to List-of-amounts; 50 | ;otherwise it signals an error 51 | (check-expect (checked-sum n1) 0) 52 | (check-expect (checked-sum n4) 1) 53 | (check-error (checked-sum n5)) 54 | (define (checked-sum l) 55 | (if (pos? l) 56 | (sum l) 57 | (error "This is not a List-of-amounts."))) -------------------------------------------------------------------------------- /8-13 Arbitrarily Large Data/9-140.rkt: -------------------------------------------------------------------------------- 1 | ;; The first three lines of this file were inserted by DrRacket. They record metadata 2 | ;; about the language level of this file in a form that our tools can easily process. 3 | #reader(lib "htdp-beginner-reader.ss" "lang")((modname 9-140) (read-case-sensitive #t) (teachpacks ()) (htdp-settings #(#t constructor repeating-decimal #f #t none #f () #f))) 4 | ; A List-of-booleans is one of: 5 | ; - '() 6 | ; - (cons #true List-of-booleans) 7 | ; - (cons #false List-of-booleans) 8 | (define b1 (cons #true '())) 9 | (define b2 (cons #false '())) 10 | (define b3 (cons #true (cons #false '()))) 11 | 12 | ; List-of-booleans -> Boolean 13 | ; return #true if all of elements of the list are #true; 14 | ; otherwise return #false 15 | (check-expect (all-true b1) #true) 16 | (check-expect (all-true b2) #false) 17 | (check-expect (all-true b3) #false) 18 | (define (all-true l) 19 | (cond 20 | [(empty? l) #true] 21 | [(cons? l) 22 | (and (first l) (all-true (rest l)))])) 23 | 24 | ; List-of-booleans -> Boolean 25 | ; return #true if one of the elements of the list is #true 26 | ; otherwise #false 27 | (check-expect (one-true '()) #false) 28 | (check-expect (one-true b1) #true) 29 | (check-expect (one-true b2) #false) 30 | (check-expect (one-true b3) #true) 31 | (define (one-true l) 32 | (cond 33 | [(empty? l) #false] 34 | [(cons? l) 35 | (or (first l) (one-true (rest l)))])) 36 | 37 | -------------------------------------------------------------------------------- /8-13 Arbitrarily Large Data/9-141.rkt: -------------------------------------------------------------------------------- 1 | ;; The first three lines of this file were inserted by DrRacket. They record metadata 2 | ;; about the language level of this file in a form that our tools can easily process. 3 | #reader(lib "htdp-beginner-reader.ss" "lang")((modname 9-141) (read-case-sensitive #t) (teachpacks ()) (htdp-settings #(#t constructor repeating-decimal #f #t none #f () #f))) 4 | ; A List-of-strings is one of: 5 | ; - '() 6 | ; - (cons String List-of-strings) 7 | (define s1 '()) 8 | (define s2 (cons "a" (cons "b" s1))) 9 | (define s3 (cons "ab" (cons "cd" (cons "ef" s1)))) 10 | 11 | ; List-of-strings -> String 12 | ; appends all the elements of a List-of-strings into one long string 13 | (check-expect (cat s1) "") 14 | (check-expect (cat s2) "ab") 15 | (check-expect (cat s3) "abcdef") 16 | (define (cat l) 17 | (cond 18 | [(empty? l) ""] 19 | [(cons? l) 20 | (string-append (first l) (cat (rest l)))])) -------------------------------------------------------------------------------- /8-13 Arbitrarily Large Data/9-142.rkt: -------------------------------------------------------------------------------- 1 | ;; The first three lines of this file were inserted by DrRacket. They record metadata 2 | ;; about the language level of this file in a form that our tools can easily process. 3 | #reader(lib "htdp-beginner-reader.ss" "lang")((modname 9-142) (read-case-sensitive #t) (teachpacks ()) (htdp-settings #(#t constructor repeating-decimal #f #t none #f () #f))) 4 | (require 2htdp/image) 5 | ; ImageOrFalse is one of: 6 | ; - Image 7 | ; - #false 8 | 9 | ; a List-of-iamges if one of: 10 | ; - '() 11 | ; - (cons Image List-of-image) 12 | 13 | ; List-of-images Number -> ImageOrFalse 14 | ; produces the first image on loi that is not an n by n square; 15 | ; if it cannot find such an image, it produces #false 16 | 17 | (define (ill-sized? loi n) 18 | (cond 19 | [(empty? loi) #false] 20 | [(cons? loi) 21 | (if (and (= n (image-width (first loi))) 22 | (= n (image-height (first loi)))) 23 | (ill-sized (rest loi)) 24 | (first loi))])) -------------------------------------------------------------------------------- /8-13 Arbitrarily Large Data/9-145-146.rkt: -------------------------------------------------------------------------------- 1 | ;; The first three lines of this file were inserted by DrRacket. They record metadata 2 | ;; about the language level of this file in a form that our tools can easily process. 3 | #reader(lib "htdp-beginner-reader.ss" "lang")((modname 9-145) (read-case-sensitive #t) (teachpacks ()) (htdp-settings #(#t constructor repeating-decimal #f #t none #f () #f))) 4 | ; a NEList-of-temperatures is one of: 5 | ; - (cons CTemperature '()) 6 | ; - (cons CTemperature NEList-of-temperatures) 7 | (define t1 (cons -273 '())) 8 | (define t2 (cons 1 (cons 2 (cons 3 '())))) 9 | (define t3 (cons 3 (cons 2 (cons 1 '())))) 10 | 11 | ; NEList-of-temperature -> Number 12 | ; computes the average of all temperatures 13 | (check-expect (average t1) -273) 14 | (check-expect (average t2) 2) 15 | (check-expect (average t3) 2) 16 | (define (average l) 17 | (/ (sum l) (how-many l))) 18 | 19 | ; NEList-of-temperatures -> Number 20 | ; computes the sum of all the temperatures 21 | (check-expect (sum t1) -273) 22 | (check-expect (sum t2) 6) 23 | (check-expect (sum t3) 6) 24 | (define (sum l) 25 | (cond 26 | [(empty? (rest l)) (first l)] 27 | [else (+ (first l) (sum (rest l)))])) 28 | 29 | ; NEList-of-temperatures -> Number 30 | ; counts the temperatures on the list 31 | (check-expect (how-many t1) 1) 32 | (check-expect (how-many t2) 3) 33 | (check-expect (how-many t3) 3) 34 | (define (how-many l) 35 | (cond 36 | [(empty? (rest l)) 1] 37 | [else 38 | (+ 1 (how-many (rest l)))])) 39 | 40 | ; NEList-of-temperature -> Boolean 41 | ; return #true if the temperatures are sorted in descending order 42 | ; otherwise return #false 43 | (check-expect (sorted>? t1) #true) 44 | (check-expect (sorted>? t2) #false) 45 | (check-expect (sorted>? t3) #true) 46 | (define (sorted>? ne-l) 47 | (cond 48 | [(empty? (rest ne-l)) #true] 49 | [else (and (>= (first ne-l) (first (rest ne-l))) 50 | (sorted>? (rest ne-l)))])) -------------------------------------------------------------------------------- /8-13 Arbitrarily Large Data/9-147.rkt: -------------------------------------------------------------------------------- 1 | ;; The first three lines of this file were inserted by DrRacket. They record metadata 2 | ;; about the language level of this file in a form that our tools can easily process. 3 | #reader(lib "htdp-beginner-reader.ss" "lang")((modname 9-147) (read-case-sensitive #t) (teachpacks ()) (htdp-settings #(#t constructor repeating-decimal #f #t none #f () #f))) 4 | ; a NEList-of-booleans is one of: 5 | ; - (cons Boolean '()) 6 | ; - (cons Boolean NEList-of-booleans) 7 | (define b1 (cons #true '())) 8 | (define b2 (cons #false b1)) 9 | (define b3 (cons #true b1)) 10 | (define b4 (cons #false '())) 11 | ; NEList-of-booleans -> Boolean 12 | ; produces #true if all elements are #true 13 | (check-expect (all-true b1) #true) 14 | (check-expect (all-true b2) #false) 15 | (check-expect (all-true b3) #true) 16 | (check-expect (all-true b4) #false) 17 | (define (all-true l) 18 | (cond 19 | [(empty? (rest l)) (first l)] 20 | [else (and (first l) (all-true (rest l)))])) 21 | 22 | ; NEList-of-booleans -> Boolean 23 | ; produces #ture if one of the list's elements is #true 24 | ; otherwise produces #false 25 | (check-expect (one-true b1) #true) 26 | (check-expect (one-true b2) #true) 27 | (check-expect (one-true b3) #true) 28 | (check-expect (one-true b4) #false) 29 | (define (one-true l) 30 | (cond 31 | [(empty? (rest l)) (first l)] 32 | [else (or (first l) (one-true (rest l)))])) -------------------------------------------------------------------------------- /8-13 Arbitrarily Large Data/9-150-151.rkt: -------------------------------------------------------------------------------- 1 | ;; The first three lines of this file were inserted by DrRacket. They record metadata 2 | ;; about the language level of this file in a form that our tools can easily process. 3 | #reader(lib "htdp-beginner-reader.ss" "lang")((modname 9-150-151) (read-case-sensitive #t) (teachpacks ()) (htdp-settings #(#t constructor repeating-decimal #f #t none #f () #f))) 4 | ; a N is one of: 5 | ; - 0 6 | ; - (add1 N) 7 | ; interpretation represents the counting numbers 8 | 9 | ; N -> Number 10 | ; computes (+ n pi) without using + 11 | (check-within (add-to-pi 3) (+ 3 pi) 0.001) 12 | (define (add-to-pi n) 13 | (cond 14 | [(zero? n) pi] 15 | [(positive? n) (add1 (add-to-pi (sub1 n)))])) 16 | 17 | ; N Number -> Number 18 | ; computes (+ n x) without using + 19 | (check-within (add 3 3) (+ 3 3) 0.001) 20 | (define (add n x) 21 | (cond 22 | [(zero? n) x] 23 | [(positive? n) (add1 (add (sub1 n) x))])) 24 | 25 | ; N Number -> Number 26 | ; computes (* n x) without using * 27 | (check-within (multiply 3 3 ) (* 3 3) 0.001) 28 | (define (multiply n x) 29 | (cond 30 | [(zero? n) 0] 31 | [(positive? n) (+ x (multiply (sub1 n) x))])) -------------------------------------------------------------------------------- /8-13 Arbitrarily Large Data/9-152-153.rkt: -------------------------------------------------------------------------------- 1 | ;; The first three lines of this file were inserted by DrRacket. They record metadata 2 | ;; about the language level of this file in a form that our tools can easily process. 3 | #reader(lib "htdp-beginner-reader.ss" "lang")((modname 9-152-153) (read-case-sensitive #t) (teachpacks ()) (htdp-settings #(#t constructor repeating-decimal #f #t none #f () #f))) 4 | (require 2htdp/image) 5 | 6 | ; a N is one of: 7 | ; - 0 8 | ; - (add1 N) 9 | ; interpretation represents the counting numbers 10 | 11 | ; a List-Posns is one of: 12 | ; - '() 13 | ; - (cons Posn List-Posn) 14 | ; interpretation represents a list of Posns 15 | (define p1 '()) 16 | (define p2 (cons (make-posn 12 34) p1)) 17 | (define p3 (cons (make-posn 50 150) p2)) 18 | 19 | (define cell (rectangle 10 10 "outline" "black")) 20 | 21 | ; N Image -> Image 22 | ; produces a column - a vertical arrangement - of n copies of imge 23 | (define (col n img) 24 | (cond 25 | [(zero? n) (error "n must be positive")] 26 | [(= 1 n) img] 27 | [else (beside (col (sub1 n) img) img)])) 28 | 29 | ; N Image -> Image 30 | ; produces a row-a horizontal arrangment-of n copies of img 31 | (define (row n img) 32 | (cond 33 | [(zero? n) (error "n must be positive")] 34 | [(= 1 n) img] 35 | [else (above (row (sub1 n) img) img)])) 36 | 37 | (define HALL (place-image (row 18 (col 8 cell)) 38 | 40 90 39 | (empty-scene 80 180))) 40 | (define DOT (circle 3 "solid" "red")) 41 | 42 | ; List-Posns -> Image 43 | ; produces a image with red dots scattered on Hall-image 44 | (define (add-balloons l) 45 | (cond 46 | [(empty? l) HALL] 47 | [else 48 | (place-image DOT 49 | (posn-x (first l)) 50 | (posn-y (first l)) 51 | (add-balloons (rest l)))])) -------------------------------------------------------------------------------- /8-13 Arbitrarily Large Data/9-154.rkt: -------------------------------------------------------------------------------- 1 | ;; The first three lines of this file were inserted by DrRacket. They record metadata 2 | ;; about the language level of this file in a form that our tools can easily process. 3 | #reader(lib "htdp-beginner-reader.ss" "lang")((modname 9-154) (read-case-sensitive #t) (teachpacks ()) (htdp-settings #(#t constructor repeating-decimal #f #t none #f () #f))) 4 | (define-struct layer [color doll]) 5 | 6 | ; an RD (Russion doll) is one of: 7 | ; - String 8 | ; - (make-layer String RD) 9 | (define r1 "red") 10 | (define r2 (make-layer "green" r1)) 11 | (define r3 (make-layer "yellow" r2)) 12 | 13 | ; RD -> String 14 | ; produces a string of all colors of RD 15 | (check-expect (colors r1) "red") 16 | (check-expect (colors r2) "green, red") 17 | (check-expect (colors r3) "yellow, green, red") 18 | (define (colors rd) 19 | (cond 20 | [(string? rd) rd] 21 | [else (string-append (layer-color rd) 22 | ", " 23 | (colors (layer-doll rd)))])) 24 | 25 | ; RD -> String 26 | ; produces the color of the innermost doll 27 | (check-expect (inner r1) "red") 28 | (check-expect (inner r2) "red") 29 | (check-expect (inner r3) "red") 30 | (define (inner rd) 31 | (cond 32 | [(string? rd) rd] 33 | [(layer? rd) (inner (layer-doll rd))])) 34 | -------------------------------------------------------------------------------- /8-13 Arbitrarily Large Data/9-158.rkt: -------------------------------------------------------------------------------- 1 | ;; The first three lines of this file were inserted by DrRacket. They record metadata 2 | ;; about the language level of this file in a form that our tools can easily process. 3 | #reader(lib "htdp-beginner-reader.ss" "lang")((modname 9-158) (read-case-sensitive #t) (teachpacks ()) (htdp-settings #(#t constructor repeating-decimal #f #t none #f () #f))) 4 | (require 2htdp/image) 5 | (require 2htdp/universe) 6 | 7 | (define HEIGHT 80) ; distances in terms of pixels 8 | (define WIDTH 100) 9 | (define XSHOTS (/ WIDTH 2)) 10 | ; graphical constants 11 | (define BACKGROUND (empty-scene WIDTH HEIGHT)) 12 | (define SHOT (triangle 3 "solid" "red")) 13 | 14 | ;A List-of-shots is one of: 15 | ; – '() 16 | ; – (cons Shot List-of-shots) 17 | ; interpretation the collection of shots fired 18 | 19 | ; A Shot is a Number. 20 | ; interpretation represents the shot's y-coordinate 21 | 22 | ; A ShotWorld is List-of-numbers. 23 | ; interpretation each number on such a list 24 | ; represents the y-coordinate of a shot 25 | 26 | ; ShotWorld -> ShotWorld 27 | (define (main w0) 28 | (big-bang w0 29 | [on-tick tock] 30 | [on-key keyh] 31 | [to-draw to-image])) 32 | 33 | ; ShotWorld -> ShotWorld 34 | ; moves each shot up by one pixel 35 | (define (tock w) 36 | (cond 37 | [(empty? w) '()] 38 | [else 39 | (if (< (sub1 (first w)) 0) 40 | (tock (rest w)) 41 | (cons (sub1 (first w)) (tock (rest w))))])) 42 | ; ShotWorld KeyEvent -> ShotWorld 43 | ; adds a shot to the world if the space bar was hit 44 | (define (keyh w ke) 45 | (if (key=? ke " ") (cons HEIGHT w) w)) 46 | 47 | ; ShotWorld -> Image 48 | ; adds each shot y on w at (XSHOTS,y} to BACKGROUND 49 | (define (to-image w) 50 | (cond 51 | [(empty? w) BACKGROUND] 52 | [else (place-image SHOT XSHOTS (first w) 53 | (to-image (rest w)))])) -------------------------------------------------------------------------------- /8-13 Arbitrarily Large Data/9-159.rkt: -------------------------------------------------------------------------------- 1 | ;; The first three lines of this file were inserted by DrRacket. They record metadata 2 | ;; about the language level of this file in a form that our tools can easily process. 3 | #reader(lib "htdp-beginner-reader.ss" "lang")((modname 9-159) (read-case-sensitive #t) (teachpacks ()) (htdp-settings #(#t constructor repeating-decimal #f #t none #f () #f))) 4 | (require 2htdp/image) 5 | (require 2htdp/universe) 6 | 7 | ; a N is one of: 8 | ; - 0 9 | ; - (add1 N) 10 | ; interpretation represents the counting numbers 11 | 12 | ; a List-Posns is one of: 13 | ; - '() 14 | ; - (cons Posn List-Posn) 15 | ; interpretation represents a list of Posns 16 | (define p1 '()) 17 | (define p2 (cons (make-posn 12 34) p1)) 18 | (define p3 (cons (make-posn 50 150) p2)) 19 | 20 | (define-struct rstate [left already]) 21 | ; (make-rstate Number List-Posns) 22 | ; interpretation represents the riot-state including how many balloons to throw (left) 23 | ; and the list of balloons already thrown. 24 | 25 | ; a RState is: 26 | ;- rstate 27 | 28 | (define cell (rectangle 10 10 "outline" "black")) 29 | 30 | ; N Image -> Image 31 | ; produces a column - a vertical arrangement - of n copies of imge 32 | (define (col n img) 33 | (cond 34 | [(zero? n) (error "n must be positive")] 35 | [(= 1 n) img] 36 | [else (beside (col (sub1 n) img) img)])) 37 | 38 | ; N Image -> Image 39 | ; produces a row-a horizontal arrangment-of n copies of img 40 | (define (row n img) 41 | (cond 42 | [(zero? n) (error "n must be positive")] 43 | [(= 1 n) img] 44 | [else (above (row (sub1 n) img) img)])) 45 | 46 | (define HALL (place-image (row 18 (col 8 cell)) 47 | 40 90 48 | (empty-scene 80 180))) 49 | (define BALLOON (circle 3 "solid" "red")) 50 | 51 | ; Number -> RState 52 | (define (riot n) 53 | (big-bang (make-rstate n '()) 54 | [on-tick throw-balloons 1] 55 | [to-draw render] 56 | [stop-when stop-riot?])) 57 | 58 | ; RState -> Boolean 59 | ; stop when left balloons become 0 (all have been thrown) 60 | (define (stop-riot? s) 61 | (zero? (rstate-left s))) 62 | 63 | ; RState -> RState 64 | ; throw a randomly produced balloon for every second 65 | (define (throw-balloons s) 66 | (make-rstate (sub1 (rstate-left s)) 67 | (cons (make-posn (random 81) (random 181)) 68 | (rstate-already s)))) 69 | 70 | ; List-Posns -> Image 71 | ; produces a image with red dots scattered on Hall-image 72 | (define (add-balloons l) 73 | (cond 74 | [(empty? l) HALL] 75 | [else 76 | (place-image BALLOON 77 | (posn-x (first l)) 78 | (posn-y (first l)) 79 | (add-balloons (rest l)))])) 80 | 81 | 82 | ; RState -> Image 83 | ; renders the already thrown balloon on the HALL image 84 | (define (render s) 85 | (add-balloons (rstate-already s))) -------------------------------------------------------------------------------- /8-13 Arbitrarily Large Data/9-160.rkt: -------------------------------------------------------------------------------- 1 | ;; The first three lines of this file were inserted by DrRacket. They record metadata 2 | ;; about the language level of this file in a form that our tools can easily process. 3 | #reader(lib "htdp-beginner-reader.ss" "lang")((modname 9-160) (read-case-sensitive #t) (teachpacks ()) (htdp-settings #(#t constructor repeating-decimal #f #t none #f () #f))) 4 | ; List-of-string String -> N 5 | ; determines how often s occurs in los 6 | (define (count los s) 7 | (cond 8 | [(empty? los) 0] 9 | [else 10 | (+ (if (string=? s (first los)) 11 | 1 12 | 0) 13 | (count (rest los) s))])) 14 | 15 | (define set123.v1 (cons 1 (cons 2 ( cons 3 '())))) 16 | (define set123.v2 (cons 1 (cons 3 ( cons 2 '())))) 17 | (define set23.v1 (cons 2(cons 3 '()))) 18 | (define set23.v2 (cons 3 (cons 2 '()))) 19 | 20 | ; SON.v1 Number -> SON.v1 21 | ; subtracts n from son 22 | (define (set-.v1 n son) 23 | (remove-all n son)) 24 | 25 | ; Son.v1 Number -> Son.v1 26 | ; adds n to son 27 | (define (set+.v1 son n) 28 | (cons n son)) 29 | 30 | ; Son.v2 Number -> Son.v2 31 | ; adds n to son 32 | (define (set+.v2 son n) 33 | (if (member? n son) 34 | son 35 | (cons n son))) -------------------------------------------------------------------------------- /8-13 Arbitrarily Large Data/itunes.xml: -------------------------------------------------------------------------------- 1 | 2 | 3 | 4 | 5 | Playlists 6 | 7 | 8 | NameLibrary 9 | Master 10 | Playlist ID4053 11 | Playlist Items 12 | 13 | 14 | Track ID35 15 | NameLandslide 16 | ArtistFleetwood Mac 17 | AlbumThe Dance 18 | GenreRock 19 | KindProtected AAC audio file 20 | Size4285488 21 | Total Time268283 22 | Track Number9 23 | Track Count17 24 | Year1997 25 | Date Added2004-06-16T18:08:31Z 26 | Play Count10 27 | Play Date-1119376103 28 | Play Date UTC2004-08-17T16:39:53Z 29 | 30 | 31 | Track ID839 32 | NameSweet Georgia Brown 33 | ArtistCount Basie & His Orchestra 34 | ComposerBernie/Pinkard/Casey 35 | AlbumPrime Time 36 | GenreJazz 37 | KindProtected AAC audio file 38 | Size3771502 39 | Total Time219173 40 | Disc Number1 41 | Disc Count1 42 | Track Number3 43 | Track Count8 44 | Year1977 45 | Date Modified2004-06-16T18:10:55Z 46 | Date Added2004-06-16T18:08:31Z 47 | Bit Rate128 48 | Sample Rate44100 49 | Play Count3 50 | Play Date-1119376103 51 | Play Date UTC2004-08-17T16:39:53Z 52 | Rating100 53 | 54 | 55 | 56 | -------------------------------------------------------------------------------- /LICENSE.txt: -------------------------------------------------------------------------------- 1 | MIT License 2 | 3 | Copyright (c) 2017 Ada 4 | 5 | Permission is hereby granted, free of charge, to any person obtaining a copy 6 | of this software and associated documentation files (the "Software"), to deal 7 | in the Software without restriction, including without limitation the rights 8 | to use, copy, modify, merge, publish, distribute, sublicense, and/or sell 9 | copies of the Software, and to permit persons to whom the Software is 10 | furnished to do so, subject to the following conditions: 11 | 12 | The above copyright notice and this permission notice shall be included in all 13 | copies or substantial portions of the Software. 14 | 15 | THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR 16 | IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, 17 | FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE 18 | AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER 19 | LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, 20 | OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE 21 | SOFTWARE. 22 | -------------------------------------------------------------------------------- /_config.yml: -------------------------------------------------------------------------------- 1 | theme: jekyll-theme-hacker --------------------------------------------------------------------------------