How To Design Programs - 2nd Ed

Wednesday, 21 November 2012

Exercise 185: Create the function make-ranking, which consumes a list of ranked song titles and produces an HTML table representation.

Consider this example:

(define one-list

  '("Asia: Heat of the Moment"

    "U2: One"

    "The White Stripes: Seven Nation Army"))

The type of output expected here isn't really clarified. You could argue we should provide an html string (eg "<html><body>...</body></html>") or the HTML table representation we were given as an example in the previous question. I'm opting for the latter as it matches better the previous question in the book.

(define (ranking los)
(reverse (add-ranks (reverse los))))

(define (add-ranks los)
(cond
[(empty? los) '()]
[else (cons (list (length los) (first los))
(add-ranks (rest los)))]))

(define one-list
'("Asia: Heat of the Moment"
"U2: One"
"The White Stripes: Seven Nation Army"))

; draws a single cell of data wrapped in a td
; Song -> Nested List
(define (make-cell data)
`(td ,data))

; makes a row for the song table based on a list of values (eg ranking + title)
(define (make-row l)
(cond ((empty? l) '())
(else (cons (make-cell (first l))
(make-row (rest l))))))

; simple test on a single row. These tests are the same, I am just practising the new list notation.
(check-expect (make-row '(1 "A"))
(list (list 'td 1) (list 'td "A") ))
(check-expect (make-row '(1 "A"))
'((td 1) (td "A")))

; creates a list row for each song in the list
(define (make-rows los)
(cond ((empty? los) empty)
(else `( (tr ,@(make-row (first los)))
,@(make-rows (rest los))))))

; a short happy test. should split our short list into two rows
; I really struggled to get this function working before I wrote this test.
; Once I had the test, the function was simple.
(check-expect(make-rows (ranking short-list))
'((tr (td 1) (td "A")) (tr (td 2) (td "B"))))

; creates a list based table structure
(define (make-table-list los)
`(table ((border 1))
,@los))

; happy test - this should produce a complete table list
(check-expect (make-table-list (make-rows (ranking short-list)))
'(table ((border 1))
(tr (td 1) (td "A"))
(tr (td 2) (td "B"))))

; helper function that wraps the ranking and name into a table list from a list
(define (make-table-helper list)
(make-table-list (make-rows (ranking list))))

When run, we get:

(make-table-helper one-list)

(list 'table (list (list 'border 1)) (list 'tr (list 'td 1) (list 'td "Asia: Heat of the Moment")) (list 'tr (list 'td 2) (list 'td "U2: One")) (list 'tr (list 'td 3) (list 'td "The White Stripes: Seven Nation Army")))

Wednesday, 14 November 2012

Exercise 184: Eliminate quasiquote, unquote, and unquote-splicing from the following expressions so that they are written with list instead

Eliminate quasiquote, unquote, and unquote-splicing from the following expressions so that they are written with list instead:

`(0 ,@'(1 2 3) 4)

this table-like shape:

`(("alan" ,(* 2 500))

  ("barb" 2000)

  (,@'(list "carl" " , the great")   1500)

  ("dawn" 2300))

and this third web page:

`(html

   (body

     (table ((border "1"))

       (tr ((width "200")) ,@(make-row '( 1  2)))

       (tr ((width "200")) ,@(make-row '(99 65))))))

where make-row is the function from above.

Also write down the nested lists that the expressions produce.

Question One

`(0 ,@'(1 2 3) 4)

becomes

(list 0 1 2 3 4)

This is very straight forward. The ` operator will start creating a list, the ,@'(1 2 3) will execute the ' creating (list 1 2 3) which will will be spliced back into our main list.

Question Two

`(("alan" ,(* 2 500)) ("barb" 2000) (,@'(list "carl" " , the great") 1500) ("dawn" 2300))

This is what I thought the list would produce - I was wrong.

(list (list "alan" 1000) (list "barb" 2000) (list "carl the great" 1500) ("dawn" 2300))

What it actually produced was:

(list (list "alan" 1000) (list "barb" 2000) (list 'list "carl" " , the great" 1500) (list "dawn" 2300))

I'm not sure if this was meant to be a trick question, but it got me =)
With the answer in front of me, I now interpret the line (,@'(list "carl" " , the great") 1500) as (list "carl" ", the great) as create a list containing the symbol 'list, the word "carl" and ", the great") and splice this list back into the result.

Nest listed Representation - I'm not 100% sure about this - I think the representation for carl the great is wrong:

'((alan 1000) (barb 2000) ('(carl (the great)) 1500) (dawn 2300))

Question Three

`(html (body (table ((border "1")) (tr ((width "200")) ,@(make-row '( 1 2))) (tr ((width "200")) ,@(make-row '(99 65))))))

My first cut - this was pretty much 100% wrong.

(list "html" (list "body" (list "table" (list "border 1") (list "tr" (list "width" "200") (list (list "td" 1) (list "td" 2)))) (list "tr" (list "width" "200") (list (list "td" 99) (list "td" 65)))))

This is the actual answer as given by racket. I've forgotten to use symbols completely, and messed up the double list wrapping for the border styles.

(list 'html (list 'body (list 'table (list (list 'border "1")) (list 'tr (list (list 'width "200")) (list 'td "1") (list 'td "2")) (list 'tr (list (list 'width "200")) (list 'td "99") (list 'td "65")))))

Nested List Representation:

'(html (body (table (border "1") (tr (width "200") (td 1) (td 2)) (tr (width "200") (td 99) (td 65)))))

Tuesday, 2 October 2012

Exercise 183: Eliminate quasiquote and unquote from the following expressions

Eliminate quasiquote and unquote from the following expressions:

`(1 "a" 2 #f 3 "c")
this table-like shape:

`(("alan" ,(* 2 500))

  ("barb" 2000)

  (,(string-append "carl" " , the great") 1500)

  ("dawn" 2300))
and this second web page:

`(html

   (head

     (title ,title))

   (body

     (h1 ,title)

     (p "A second web page")))

where (define title "ratings").

Also write down the nested lists that the expressions produce.

Answers

There are two answers for each question - the normal list, and the nested list representation.

1)

(list 1 "a" 2 false 3 "c")

'(1 "a" 2 false 3 "c")

2)

(list (list "alan" (* 2 5000))
(list "barb" 2000)
(list (string-append "carl" " , the great") 1500)
(list "dawn" 2300))
(list "html" (list "head" (list title))
(list "body" (list "h1" title)
(list "p" "A second web page")))

'(("allan" 1000)
("barb" 2000)
("carl" 1500)
("dawn" 3000))

3)

(cons
"html"
(cons (cons "head" (cons (cons "ratings" empty) empty)) (cons (cons "body" (cons (cons "h1" (cons "ratings" empty)) (cons (cons "p" (cons "A second web page" empty)) empty))) empty)))

'("html"
("head" ("title" "ratings"))
("body" ("h1" "ratings")
("p" "A second web page")))

Tuesday, 11 September 2012

Exercise 182: Eliminate quote from the following expressions

Eliminate quote from the following expressions so that they use list instead:

'(1 "a" 2 #f 3 "c")
'()
and this table-like shape:

'(("alan" 1000)

  ("barb" 2000)

  ("carl" 1500)

  ("dawn" 2300))

Now eliminate list in favor of cons where needed.

Eliminate in favour of list

This is very straight forward.

(list 1 "a" 2 false 3 "c")
(list)
(list (list "alan" 1000)
(list "barb" 2000)
(list "carl" 1500)
(list "dawn" 3000))

Eliminate in favour of cons

This is not hard, but painful. Constructing lists like this is frustrating - which is the point of the exercise.

(cons 1 (cons "a" (cons 2 (cons false (cons 3 (cons "c" empty))))))

empty

(cons (cons "allan" (cons 1000 empty))
(cons (cons "barb" (cons 2000 empty))
(cons (cons "carl" (cons 1500 empty))
(cons (cons "dawn" (cons 3000 empty))
empty ))))

Wednesday, 29 August 2012

Special Exercise - Space Invaders Part 4

Space Invaders Part 4

My goals for the 4th iteration were to:

allow the tank to shoot at the invaders
have invaders 'die' when hit

To implement these goals we need a number of new elements and behaviours:

the world now has a collection of bullets.
bullets have a location and consist of a single block.
bullets move upwards until they collide with a space invader (cause the invader to disappear)

In addition play testing showed that we need to restrict the number of bullets on the screen (or introduce a delay between shots). Without this you can just fire a lethal stream of bullets taking out all the UFO's very quickly.

Bullets, tanks and ufos turned out to be structured very similarly. I should have implemented these using plain posn's as this would have allowed more function sharing.

Code

(require racket/base)
(define-struct ufo (x y direction) #:transparent)
(define-struct bullet (x y) #:transparent )
(define-struct tank (x y) #:transparent)
(define-struct world (ufos tank bullets))

; constants
(define WIDTH 300) ; the maximal number of blocks horizontally
(define HEIGHT 300) ; the maximal number of blocks horizontally
(define BULLET_DIST 5) ; the distance travelled by a bullet
(define SIZE 10) ; the size of the block making up the ufo
(define UFO-WIDTH 50)
(define MAX-BULLETS 2) ; max number of bullets on screen at a time

(define BLOCK ;rendered as red squares with black rims - stolen from tetris
(overlay (rectangle (- SIZE 1) (- SIZE 1) "solid" "red")
(rectangle SIZE SIZE "outline" "black")))

(define TEST-UFO (make-ufo 30 30 1)) ; for testing
(define TEST-UFOS (list (make-ufo 30 30 1)
(make-ufo 80 30 1)
(make-ufo 130 30 1))); for testing

; initial tank position should be middle of the screen, one block up
; from the bottom
(define TANK (make-tank (/ WIDTH 2) (- HEIGHT (* SIZE 2))))

; creates a row of ufos on the y-cordinate
; Integer Ufos -> Ufos
(define (make-ufos-for-y y-cordinate ufos)
(cond ((empty? ufos) (make-ufos-for-y y-cordinate
(cons (make-ufo 20 y-cordinate 1) ufos)))
((> (+ (ufo-x (first ufos)) UFO-WIDTH) WIDTH) ufos)
(else (printf "first ~a" (+ (ufo-x (first ufos))))
(make-ufos-for-y y-cordinate
(cons (make-ufo (+ (ufo-x (first ufos))
UFO-WIDTH) y-cordinate 1) ufos )))))

; create a collection of rows of ufos
; Integer Ufos -> Ufos
(define (make-ufos rows ufos)
(cond ((= 0 rows) ufos)
(else (make-ufos (- rows 1)
(append ufos (make-ufos-for-y (- ( * rows 60) 30)
empty))))))

; draw a triangular shaped alien
(define (draw-ufo ufo background)
(place-image/align BLOCK (ufo-x ufo) (ufo-y ufo) "left" "bottom"
(place-image/align BLOCK (- (ufo-x ufo) SIZE) (ufo-y ufo) "left" "bottom"
(place-image/align BLOCK (+ (ufo-x ufo) SIZE) (ufo-y ufo) "left" "bottom"
(place-image/align BLOCK (ufo-x ufo) (+ (ufo-y ufo) SIZE) "left" "bottom"
background)))))

; draw a tank shaped tank
(define (draw-tank tank background)
(place-image/align BLOCK (tank-x tank) (tank-y tank) "left" "bottom"
(place-image/align BLOCK (- (tank-x tank) SIZE) (tank-y tank) "left" "bottom"
(place-image/align BLOCK (+ (tank-x tank) SIZE) (tank-y tank) "left" "bottom"
(place-image/align BLOCK (tank-x tank) (+ (tank-y tank) SIZE)
"left" "bottom"
(place-image/align BLOCK (- (tank-x tank) SIZE) (+ (tank-y tank) SIZE )
"left" "bottom"
(place-image/align BLOCK (+ (tank-x tank) SIZE) (+ (tank-y tank) SIZE)
"left" "bottom"
(place-image/align BLOCK (tank-x tank) (- (tank-y tank) SIZE)
"left" "bottom"
background))))))))

; Draw a bullet on the background
; bullet, scene -> scene
(define (draw-bullet bullet background)
(place-image/align BLOCK (bullet-x bullet)
(bullet-y bullet) "left" "bottom" background))

; Draw a collection of bullets
(define (draw-bullets bullets background)
(cond ((empty? bullets) background)
(else (draw-bullet (first bullets)
(draw-bullets (rest bullets) background)))))

; Move the bullets;
; If the bullet moves past the top of the screen, remove it.
(define (move-bullets bullets)
(cond ((empty? bullets) bullets)
(else (cond ((> 0 (bullet-y (first bullets)))
(move-bullets (rest bullets)))
(else
(cons (move-bullet (first bullets))
(move-bullets (rest bullets))))))))

; simple test case for moving a list of bullets
(check-expect (move-bullets (list (make-bullet 100 100) (make-bullet 90 100)))
(list (make-bullet 100 (- 100 BULLET_DIST))
(make-bullet 90 (- 100 BULLET_DIST))))

; Move a bullet
(define (move-bullet bullet)
(make-bullet (bullet-x bullet) (- (bullet-y bullet) BULLET_DIST)))

; basic bullet moving test
(check-expect (move-bullet (make-bullet 50 50)) (make-bullet 50 (- 50 BULLET_DIST)))

; draw the collection of ufos on to the background.
; a simple recursive function
; Ufos Scene -> Scene
(define (draw-ufos ufos background)
(cond ((empty? ufos) background)
(else (draw-ufo (first ufos) (draw-ufos (rest ufos) background)))))

; draws the world as a scene
; World -> Scene
(define (render-scene world)
(draw-ufos (world-ufos world)
(draw-tank (world-tank world)
(draw-bullets (world-bullets world)
(empty-scene WIDTH HEIGHT)))))

; move the ufo left or right according to it's current direction
; when it reaches the edge of the screen, flip the direction the ufo
; is travelling
(define (move-ufo ufo)
(future-ufo-x ufo) (ufo-direction ufo) WIDTH)
(cond ((> 10 (future-ufo-x ufo)) (change-ufo-direction ufo))
((< (- WIDTH 10) (future-ufo-x ufo)) (change-ufo-direction ufo))
(else (make-ufo (future-ufo-x ufo)
(ufo-y ufo) (ufo-direction ufo)))))

; returns an identical ufo but with the direction changed
(define (change-ufo-direction ufo)
(make-ufo (ufo-x ufo) (+ (ufo-y ufo) 30) (* -1 (ufo-direction ufo))))

; simplest test for changing direction.
(check-expect (change-ufo-direction (make-ufo 10 10 1)) (make-ufo 10 40 -1))

; moves each ufo one at a time
(define (move-ufos ufos)
(cond ((empty? ufos) ufos)
(else (cons (move-ufo (first ufos)) (move-ufos (rest ufos))))))

; moves the tank left or right
; the direction is positive/negative mulitplier that will
; determine in which direction the tank moves
; we use the future-tank-x function to determine if the tank would be moved
; into a position outside of the game word.
; tank direction -> tank
(define (move-tank tank direction)
(cond ((> 10 (future-tank-x direction tank)) tank)
((< (- WIDTH 20) (future-tank-x direction tank)) tank)
(else (make-tank (future-tank-x direction tank) (tank-y tank) ))))

; returns the position the tank will be in if it moves in *direction*
; used for collision detection with walls and actual moving of tank
; Integer Tank -> Integer
(define (future-tank-x direction tank)
(+ (* SIZE direction) (tank-x tank) ))

; just like future-tank-x but for ufos
; the diference is that the ufo holds the direction internally
(define (future-ufo-x ufo)
(+ (* 1 (ufo-direction ufo)) (ufo-x ufo) ))

; Fire a bullet and returns new collection of bullets
; Allows only MAX-BULLETS on screen
; World -> Bullets
(define (fire-tank world)
(cond ((eq? MAX-BULLETS (length (world-bullets world))) (world-bullets world))
(else
(cons (make-bullet (tank-x (world-tank world) )
(tank-y (world-tank world) )) (world-bullets world) ))))

; respond to keyboard input.
; Left - Move tank left
; Right - Move tank right
; Space - Fire (not yet)
(define (handle-key-events world ke)
(make-world (world-ufos world)
(cond
[(string=? "left" ke) (move-tank (world-tank world) -1)]
[(string=? "right" ke) (move-tank (world-tank world) 1) ]
[else (world-tank world)])
(cond
[(key=? " " ke) (fire-tank world)]
[else (world-bullets world)]
)))

; bullets/ufo collision detector
; returns true in the event of a collision
; ufo, bullets -> boolean
(define (collide? ufo bullets)
(cond ((empty? bullets) false)
((collide-helper? (first bullets) ufo) true)
( else (collide? ufo (rest bullets)))))

; bullet/ufo collision helper. detects collision between a single bullet and
; a ufo
; ufo, bullet -> boolean
(define (collide-helper? bullet ufo)
(cond ((and (between? (bullet-x bullet) (- (ufo-x ufo) SIZE 5)
(+ (ufo-x ufo) SIZE 5))
(between? (bullet-y bullet) (- (ufo-y ufo) SIZE 5)
(+ (ufo-y ufo) SIZE 5)))
true)
(else false)))

; helper function to determine if a number is within a range.
; i'm sure there must be a similar one defined in the libs, but I
; couldn't find it.
; Integer, Integr, Integer -> Boolean
(define (between? x low high)
(cond ((and (> x low) (< x high) true))
(else false)))

(check-expect (between? 50 10 100) true)
(check-expect (between? 10 50 100) false)

; remove any ufos from the collection that have been hit by a bullet
; ufos, bullets -> ufos
(define (bullet-collision-ufos ufos bullets)
(cond ((empty? ufos) ufos )
(else (cond ((collide? (first ufos) bullets)
(bullet-collision-ufos (rest ufos) bullets))
(else (cons (first ufos)
(bullet-collision-ufos (rest ufos) bullets)))))))

; On each clock tick, move the world further in time.
; this calls the bullet-collision-ufos function twice - this calculates which
; bullets and ufos are left. I wish I didn't have to call this twice but not
; sure how else to save the value...
(define (progress-world world)
(make-world
(bullet-collision-ufos (move-ufos (world-ufos world))
(world-bullets world))
(world-tank world)
(move-bullets (world-bullets world))))

; This is the big bang function that drives the game.
(define (space-invaders-main rate)
(big-bang (make-world (make-ufos 3 empty ) TANK empty)
(on-key handle-key-events)
(on-tick progress-world rate)
(to-draw render-scene)))

(space-invaders-main 0.01)

; TESTS

; check moving ufo left and right works as expected
(check-expect (move-ufo (make-ufo 10 10 1)) (make-ufo 20 10 1))
(check-expect (move-ufo (make-ufo 20 10 -1)) (make-ufo 10 10 1))
; check hitting the edge of the screen changes the ufos direction
(check-expect (move-ufo (make-ufo WIDTH 10 1)) (make-ufo WIDTH 10 -1))

; check the ufo change direction changes left and right
(check-expect (change-ufo-direction (make-ufo 10 10 1)) (make-ufo 10 10 -1))
(check-expect (change-ufo-direction (make-ufo 10 10 -1)) (make-ufo 10 10 1))

; simple example - a single block in an empty landscape
(check-expect (draw-ufo TEST-UFO (empty-scene WIDTH HEIGHT))
(place-image/align BLOCK (ufo-x TEST-UFO) (ufo-y TEST-UFO) "left" "bottom"
(place-image/align BLOCK (- (ufo-x TEST-UFO) SIZE) (ufo-y TEST-UFO)
"left" "bottom"
(place-image/align BLOCK (+ (ufo-x TEST-UFO) SIZE) (ufo-y TEST-UFO)
"left" "bottom"
(place-image/align BLOCK (ufo-x TEST-UFO) (+ (ufo-y TEST-UFO) SIZE)
"left" "bottom"
(empty-scene WIDTH HEIGHT))))))

; test drawing three ufo's via the draw-ufos function
(check-expect (draw-ufos TEST-UFOS (empty-scene WIDTH HEIGHT))
(draw-ufo (first TEST-UFOS)
(draw-ufo (second TEST-UFOS)
(draw-ufo (third TEST-UFOS) (empty-scene WIDTH HEIGHT)))))

; test the tank drawing works
(check-expect (draw-tank TANK (empty-scene WIDTH HEIGHT))
(place-image/align BLOCK (tank-x TANK) (tank-y TANK) "left" "bottom"
(place-image/align BLOCK (- (tank-x TANK) SIZE) (tank-y TANK) "left" "bottom"
(place-image/align BLOCK (+ (tank-x TANK) SIZE) (tank-y TANK) "left" "bottom"
(place-image/align BLOCK (tank-x TANK) (+ (tank-y TANK) SIZE) "left" "bottom"
(place-image/align BLOCK (- (tank-x TANK) SIZE) (+ (tank-y TANK) SIZE )
"left" "bottom"
(place-image/align BLOCK (+ (tank-x TANK) SIZE) (+ (tank-y TANK) SIZE)
"left" "bottom"
(place-image/align BLOCK (tank-x TANK) (- (tank-y TANK) SIZE)
"left" "bottom"
(empty-scene WIDTH HEIGHT)))))))))