How To Design Programs - 2nd Ed - Code Solutions

Exercise 196: Develop a-function=.

2013-02-12T16:35:00.000-08:00

Exercise 196: Develop a-function=. The function determines whether two functions from numbers to numbers produce the same results for 1.2, 3, and -5.775.

Can we hope to define function=?, which determines whether two functions from numbers to numbers are equal?

Answer

; returns true if the functions supplied return the same value for 3
; different numbers
; Function, Function -> Booleas
(define (a-function= x y)
(and (a-helper x y 1.2) (a-helper x y 3) (a-helper x y -5.775)))

; tests if the two functions supplied return the same number
; Function, Function, Number -> Boolean
(define (a-helper x y number)
(= (x number) (y number)))

; some test functions - both 1 and 3 should return the same value, 2 should not.
(define (test1 x) (* 2 x))
(define (test2 x) (* 3 x))
(define (test3 x) (+ x x))

; and some tests
(check-expect (a-function= test1 test2) false)
(check-expect (a-function= test1 test3) true)

Can we hope to define function=?, which determines whether two functions from numbers to numbers are equal?

We cannot (depending on how you define 'equal functions'). We can check to see the return value of the functions are equal for a specified set of arguments, but without the code introspection offered by languages such as Ruby, you can't see what is inside these black box functions.

Exercise 195: Argue why the following sentences are now legal definitions

2013-02-05T16:20:00.000-08:00

Exercise 195: Argue why the following sentences are now legal definitions:

(define (f x) (x 10))
(define (f x) (x f))
(define (f x y) (x 'a y 'b))

Explain your reasoning.

1) (define (f x) (x 10))

We are now allowed to:

include the names of functions and primitive operations in the definition.
use variables and function parameters in the first position in a definition

In this case the parameter x is a function that will have the value 10 applied to it. As we can include functions in a function definition this is legal.

2) (define (f x) (x f))

In this case, both x and f are functions. This function will call the function x passing in the value of itself (ie f). As we can include functions in function definitions, this is now legal.

3) (define (f x y) (x 'a y 'b))

In this case f and x are functions, and y is a value (that could potentially be a function!). The function x will be called, with the values 'a, y and 'b being passed into it. At this point y could either be a value, or a function and provided that the function x is expected the actual item in, this code is legal.

Exercise 194: Identify the values among the following expressions:

2013-01-29T17:00:00.000-08:00

Exercise 194: Assume the definitions area in DrRacket contains (define (f x) x). Identify the values among the following expressions:

(cons f empty)

(f f)

(cons f (cons 10 (cons (f 10) empty)))

Explain why they are values and why the remaining expressions are not values.

Answer

I'm not completely confident on this answer - my understanding is that a value is being used in an expression, and a function will be using one (or more or less) values as input.

1. (cons f empty)

In this case f and empty are values. They are being operated on by the cons.

2. (f f)

In this case the first f is a function, and the second f is a value - it is being operated on f

3. (cons f (cons 10 (cons (f 10) empty)))

In this case all the cons's are functions. The first f is a value (being operated on by the first cons). The second f is a function (operating on the 10). The remaining 10 and empty are simple values.

Exercise 193: Take a look at this data definition

2013-01-22T16:14:00.000-08:00

Exercise 193: Take a look at this data definition:

; A [Bucket ITEM] is

; (make-bucket N [List-of ITEM])

; interp. the n in (make-bucket n l) is the length of l

; i.e., (= (length l) n) is always true

When you instantiate Bucket with String, IR, and Posn, you get three different data collections. Describe each of them with a sentence and with two distinct examples.

Now consider this instantiations:

; [Bucket [List-of [List-of String]]]

Construct three distinct pieces of data that belong to this collection.

Answer

String
This is a data structure containing a number and a list of strings, where the number is the same as (length List-of-Strings)

eg (make-bucket 2 (list "The" "cat"))
eg (make-bucket 4 (list "The" "cat" "in" "the" "hat"))

IR
Assuming that 'IR' in this case refers back to the Inventory Records discussed previously, then this is a data structure containing a number and a list of Inventory Records, where the number is the same as (length List-of-IR)

eg (make-bucket 2 (list (make-ir "widget" 3) (make-ir "gadget" 4)))
eg (make-bucket 3 (list (make-ir "widget" 3)
(make-ir "gadget" 4)
(make-ir "midget" 9)))

Posn

This is a data structure containing a number and a list of Posns, where the number is the same as (length List-of-Posn)

eg (make-bucket 2 (list (make-posn 1 2) (make-posn 4 2)))
eg (make-bucket 3 (list (make-posn 1 2) (make-posn 4 2) (make-posn 9 1)))

[Bucket [List-of [List-of String]]]
Construct three distinct pieces of data that belong to this collection.
;
We construct 3 lists here. Note that the number (1 2 and 3) refers to the number of Lists-of-strings we have, *not* the number of strings in the Lists-of-strings.

(make-bucket 1 (list (list "this" "is" "a" "string")))
(make-bucket 2 (list (list "this" "is" "a" "string")
(list "this" "is" "another" "string")))
(make-bucket 3 (list (list "this" "is" "a" "string")
(list "this" "is" "another" "string")
(list "this" "is" "a" "third" "string")
))

Exercise 192: Here are two strange but similar data definitions:

2013-01-15T17:53:00.000-08:00

Exercise 192: Here are two strange but similar data definitions:

; A Nested-string is one of:

; – String

; – (make-layer Nested-string)

; A Nested-number is one of:

; – Number

; – (make-layer Nested-number)

Both data definitions exploit this structure type definition:

(define-struct layer (stuff))

Both define nested forms of data’ one is about numbers and the other about strings. Make examples for both. Abstract over the two. Then instantiate the abstract definition to get back the originals.

Answer

A Nested String and Neste Number are data constructs that contain further datastructures of the same time.
This seems very similar to a list, but it's not quite the same...

; Nested-string examples - a simple example and then a nested example

(make-layer "cat")
(make-layer (make-layer "bob"))

; Nested-number examples - a simple example and then a nested example

(make-layer 1)
(make-layer (make-layer 2))

Abstraction of the two - this question seems a little strangely worded. I think it means to define an astract function definition.

; A [Nested ITEM] is one of:
; – empty
; – (make-layer [Nested ITEM])

Instantiate to get back to the originals. This part seems to simple - probably I am overlooking something here. This is just reversing our abstraction for each type

; String

; A Nested-string is one of:
; – empty
; – (make-layer [Nested-string])

; Number

; A Nested-number is one of:
; – empty
; – (make-layer [Nested-number])

Exercise 191: Abstract the following two functions into a single function:

2013-01-08T16:40:00.000-08:00

Exercise 191: Abstract the following two functions into a single function:

; Nelon -> Number

; to determine the smallest

; number on l

(define (inf l)

  (cond

    [(empty? (rest l))

     (first l)]

    [else

     (cond

       [(< (first l) (inf (rest l)))

        (first l)]

       [else

        (inf (rest l))])]))

; Nelon -> Number

; to determine the largest

; number on l

(define (sup l)

  (cond

    [(empty? (rest l))

     (first l)]

    [else

     (cond

       [(> (first l) (sup (rest l)))

        (first l)]

       [else

        (sup (rest l))])]))

Both consume non-empty lists of numbers (Nelon) and produce a single number. The left one produces the smallest number in the list, the right one the largest.

Define inf-1 and sup-1 in terms of the abstract function. Test each of them with these two lists:

(list 25 24 23 22 21 20 19 18 17 16 15 14 13 12 11 10 9 8 7 6 5 4 3 2 1)

(list 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25)

Why are these functions slow on some of the long lists?

Answer

This is the same type of function as on the last question - to abstract it we can just pass in the conditional operator that we need.

; Condition, Nelon -> Number
; to determine the smallest/largest
; number on l
(define (function c l)
(cond
[(empty? (rest l))
(first l)]
[else
(cond
[(c (first l) (function c (rest l)))
(first l)]
[else
(function c (rest l))])]))

; Nelon -> Number
; to determine the largest
; number on l
(define (sup-1 l)
(function > l))

; Nelon -> Number
; to determine the smallest
; number on l
(define (inf-1 l)
(function < l))

; some happy tests
(check-expect (inf-1 (list 1 2 3)) 1)
(check-expect (sup-1 (list 1 2 3)) 3)

Why do these take so long to process some of the lists?
This is dependent on the operator and the order of the list passed in. The function as given above will recurse to the end of the list or until the condition passed in is met. At each point that it recurses (with a slightly smaller list), that list will also require to be fully recursed all the way down. This leads to an exponential increase in the number of function calls as the list size increases.

Part Two - rewrite using min/max

; Condition, comparator, Nelon -> Number
; to determine the smallest/largest
; number on l
; c is < / >
; m is min / max
(define (function-2 c m l)
(cond
[(empty? (rest l))
(first l)]
[else
(cond
[(c (first l) (m (first (rest l))))
(first l)]
[else
(function-2 c m (rest l))])]))

; Nelon -> Number
; to determine the largest
; number on l
(define (sup-2 l)
(function-2 > max l))

; Nelon -> Number
; to determine the smallest
; number on l
(define (inf-2 l)
(function-2 < min l))

; some happy tests
(check-expect (inf-2 (list 1 2 3)) 1)
(check-expect (sup-2 (list 1 2 3)) 3)

I'm not 100% happy with these definitions - it feels like I shouldn't need to be passing in both the min/max function name and the comparator (less-than and greater-than) but I cant see a better way of structuring these.

Why is this so much faster? If you turn on tracing within racket you can get a visual representation of what's going on - you can see that the number of function calls is not increasing exponentially with the size of the list. As min/max take in only two numbers, and don't require recursion through the entire list to get the next result the function is only called a maximum of 25 times.

Exercise 190: Evaluate (squared>? 3 10), (squared>? 4 10), and (squared>? 5 10) by hand

2013-01-01T16:51:00.000-08:00

Exercise 190: Evaluate (squared>? 3 10), (squared>? 4 10), and (squared>? 510) by hand. Then show that

(extract squared>? (list 3 4 5) 10)

evaluates to (list 4 5).

; Number Number -> Boolean

; is the area of a square with side x larger than c

(define (squared>? x c)

(> (* x x) c))

(squared>? 3 10)

(squared>? 3 10)
=
(> (* 3 3) 10)
=
(> 9 10)
= false

(squared>? 4 10)

(squared>? 4 10)
=
(> (* 4 4) 10)
=
(> 16 10)
= true

(squared>? 5 10)

(squared>? 5 10)
=
(> (* 5 5) 10)
=
(> 15 10)
= true

Part Two

Show that (extract squared>? (list 3 4 5) 10) evaluates to (list 4 5)

This exercise I found very long winded but it was very useful to step through and see how the recursion built up the final result. Even though I am comfortable using recursion, it's not often you step through it like this.

(extract squared>? (list 3 4 5) 10)
=
(cond
[(empty? (list 3 4 5)) empty]
[else (cond
[(squared>? (first (list 3 4 5) 10))
(cons (first (list 3 4 5)
(extract squared>? (rest (list 3 4 5)) 10)))]
[else (extract squared>? (rest (list 3 4 5)) 10)])])

=
(cond
[false empty]
[else (cond
[(squared>? (first (list 3 4 5) 10))
(cons (first (list 3 4 5)
(extract squared>? (rest (list 3 4 5)) 10)))]
[else (extract squared>? (rest (list 3 4 5)) 10)])])
=
(cond
[(squared>? (first (list 3 4 5) 10))
(cons (first (list 3 4 5)
(extract squared>? (rest (list 3 4 5)) 10)))]
[else (extract squared>? (rest (list 3 4 5)) 10)])
=
(cond
[(squared>? 3 10)
(cons (first (list 3 4 5)
(extract squared>? (rest (list 3 4 5)) 10)))]
[else (extract squared>? (rest (list 3 4 5)) 10)])
=
(cond
[false
(cons (first (list 3 4 5)
(extract squared>? (rest (list 3 4 5)) 10)))]
[else (extract squared>? (rest (list 3 4 5)) 10)])

=
(extract squared>? (rest (list 3 4 5)) 10)

=
; time to recurse
(extract squared>? (list 4 5) 10)
=
(cond
[(empty? (list 4 5)) empty]
[else (cond
[(squared>? (first (list 4 5) 10))
(cons (first (list 4 5)
(extract squared>? (rest (list 4 5)) 10)))]
[else (extract squared>? (rest (list 4 5)) 10)])])
=
(cond
[false empty]
[else (cond
[(squared>? (first (list 4 5) 10))
(cons (first (list 4 5)
(extract squared>? (rest (list 4 5)) 10)))]
[else (extract squared>? (rest (list 4 5)) 10)])])
=
(cond
[(squared>? 4 10))
(cons (first (list 4 5)
(extract squared>? (rest (list 4 5)) 10)))]
[else (extract squared>? (rest (list 4 5)) 10)])])

=
(cond
[true
(cons (first (list 4 5)
(extract squared>? (rest (list 4 5)) 10)))]
[else (extract squared>? (rest (list 4 5)) 10)])])

=

(cons (first (list 4 5)
(extract squared>? (rest (list 4 5)) 10)))

=
(cons 4 (extract squared>? (rest (list 4 5)) 10)))
; recurse again.
=
(cons 4 (extract squared>? (list 5)) 10)

=
(cons 4
(cond
[empty? (list 5) empty]
[else (cond
[(squared>? (first (list 5) 10))
(cons (first (list 5)
(extract squared>? (rest (list 5)) 10)))]
[else (extract squared>? (rest (list 5)) 10)])]))

=
(cons 4
(cond
[false empty]
[else (cond
[(squared>? (first (list 5) 10))
(cons (first (list 5)
(extract squared>? (rest (list 5)) 10)))]
[else (extract squared>? (rest (list 5)) 10)])]))

=
(cons 4
(cond
[(squared>? (first (list 5) 10))
(cons (first (list 5)
(extract squared>? (rest (list 5)) 10)))]
[else (extract squared>? (rest (list 5)) 10)]))

=
(cons 4
(cond
[(squared>? ( 5 10))
(cons (first (list 5)
(extract squared>? (rest (list 5)) 10)))]
[else (extract squared>? (rest (list 5)) 10)]))

=
(cons 4
(cond
[true
(cons (first (list 5)
(extract squared>? (rest (list 5)) 10)))]
[else (extract squared>? (rest (list 5)) 10)]))

=
(cons 4
(cons (first (list 5)
(extract squared>? (rest (list 5)) 10))))

=
(cons 4
(cons 5
(extract squared>? (rest (list 5)) 10)))

=
(cons 4
(cons 5
(extract squared>? empty 10)))

; recurse again
=
(cons 4
(cons 5
(cond
[empty? empty] empty)
[else (cond
[(squared>? (first empty 10))
(cons (first empty
(extract squared>? (rest empty) 10)))]
[else (extract squared>? (rest empty) 10)])])))

=
(cons 4
(cons 5
(cond
[true empty]
[else (cond
[(squared>? (first empty 10))
(cons (first empty
(extract squared>? (rest empty) 10)))]
[else (extract squared>? (rest empty) 10)])])))

=
(cons 4
(cons 5
empty))

= (list 4 5)

Exercise 189: Evaluate the expression

2012-12-25T16:48:00.000-08:00

Exercise 189: Evaluate the expression
(extract < (cons 8 (cons 6 (cons 4 empty))) 5)

;extract function from question(define (extract R l t)
(cond [(empty? l) empty] [else (cond [(R (first l) t) (cons (first l) (extract R (rest l) t))] [else (extract R (rest l) t)])]))

Answer

(extract < (cons 8 (cons 6 (cons 4 empty))) 5)

=
(cond
[(empty? (cons 8 (cons 6 (cons 4 empty))) empty]
[else (cond
[(< (first (cons 8 (cons 6 (cons 4 empty))) 5)
(cons (first (cons 8 (cons 6 (cons 4 empty))))
(extract < (rest (cons 8 (cons 6 (cons 4 empty)))) 5))]
[else (extract < (rest (cons 8 (cons 6 (cons 4 empty)))) 5)])])

=
(cond
[false empty]
[else (cond
[(< (first (cons 8 (cons 6 (cons 4 empty))) 5)
(cons (first (cons 8 (cons 6 (cons 4 empty))))
(extract < (rest (cons 8 (cons 6 (cons 4 empty)))) 5))]
[else (extract < (rest (cons 8 (cons 6 (cons 4 empty)))) 5)])])

=
(cond
[else (cond
[(< 8 5)
(cons (first (cons 8 (cons 6 (cons 4 empty))))
(extract < (rest (cons 8 (cons 6 (cons 4 empty)))) 5))]
[else (extract < (rest (cons 8 (cons 6 (cons 4 empty)))) 5)])])

=
(cond
[else (cond
[false
(cons (first (cons 8 (cons 6 (cons 4 empty))))
(extract < (rest (cons 8 (cons 6 (cons 4 empty)))) 5))]
[else (extract < (rest (cons 8 (cons 6 (cons 4 empty)))) 5)])])

=
(extract < (rest (cons 8 (cons 6 (cons 4 empty)))) 5)

=
(extract < (cons 6 (cons 4 empty)) 5)

This takes us right back to the problem from the last exercise and we can use the rest of the solution from there.

Exercise 188: Check step 1 of the last calculation

2012-12-18T16:44:00.000-08:00

Exercise 188: Check step 1 of the last calculation

Show every step.

(extract < (cons 6 (cons 4 empty)) 5)

= (extract < (cons 4 empty) 5)

Answer

; extract function in question.
(define (extract R l t)
(cond
[(empty? l) empty]
[else (cond
[(R (first l) t)
(cons (first l) (extract R (rest l) t))]
[else
(extract R (rest l) t)])]))

I have answered this as a series of steps. This anwer is a bit verbose, but I have shown each change an a seperate step.

=
(cond
[(empty? (cons 6 (cons 4 empty))) empty]
[else (cond
[(< (first (cons 6 (cons 4 empty))) 5)
(cons (first (cons 6 (cons 4 empty)))
(extract < (rest (cons 6 (cons 4 empty))) 5))]
[else (extract < (rest (cons 6 (cons 4 empty))) 5)])])

=
(cond
[false empty]
[else (cond
[(< (first (cons 6 (cons 4 empty))) 5)
(cons (first (cons 6 (cons 4 empty)))
(extract < (rest (cons 6 (cons 4 empty))) 5))]
[else (extract < (rest (cons 6 (cons 4 empty))) 5)])])

=
(cond
[else (cond
[(< (first (cons 6 (cons 4 empty))) 5)
(cons (first (cons 6 (cons 4 empty)))
(extract < (rest (cons 6 (cons 4 empty))) 5))]
[else (extract < (rest (cons 6 (cons 4 empty))) 5)])])

=
(cond
[else (cond
[(< 6 5)
(cons (first (cons 6 (cons 4 empty)))
(extract < (rest (cons 6 (cons 4 empty))) 5))]
[else (extract < (rest (cons 6 (cons 4 empty))) 5)])])

=
(cond
[else (cond
[true
(cons (first (cons 6 (cons 4 empty)))
(extract < (rest (cons 6 (cons 4 empty))) 5))]
[else (extract < (rest (cons 6 (cons 4 empty))) 5)])])

=
(cons (first (cons 6 (cons 4 empty)))
(extract < (rest (cons 6 (cons 4 empty))) 5))]

=
(cons 6 (extract < (rest (cons 6 (cons 4 empty))) 5))

= ; step seven - and we get the result we are looking for
(cons 6 (extract < (cons 4 empty)) 5)

*******
= ; recursing now...
(cond
[(empty? (cons 4 empty)) empty]
[else (cond
[(< (first (cons 4 empty)) 5)
(cons (first (cons 4 empty))
(extract < (rest (cons 4 empty)) 5))]
[else (extract < (rest (cons 4 empty)) 5)])])

=
(cond
[false empty]
[else (cond
[(< (first (cons 4 empty)) 5)
(cons (first (cons 4 empty))
(extract < (rest (cons 4 empty)) 5))]
[else (extract < (rest (cons 4 empty)) 5)])])

=
(cond
[else (cond
[(< (first (cons 4 empty)) 5)
(cons (first (cons 4 empty))
(extract < (rest (cons 4 empty)) 5))]
[else (extract < (rest (cons 4 empty)) 5)])])
=
(cond
[else (cond
[(< 4 5)
(cons (first (cons 4 empty))
(extract < (rest (cons 4 empty)) 5))]
[else (extract < (rest (cons 4 empty)) 5)])])

=
(cond
[else (cond
[(< 4 5)
(cons (first (cons 4 empty))
(extract < (rest (cons 4 empty)) 5))]
[else (extract < (rest (cons 4 empty)) 5)])])

Exercise 187: Create test suites for the following two functions:

2012-12-11T16:40:00.000-08:00

Exercise 187: Create test suites for the following two functions:

; Lon -> Lon

; add 1 to each number on l

(define (add1* l)

  (cond

    [(empty? l) false]

    [else

     (cons (add1 (first l))

           (add1* (rest l)))]))

; Lon -> Lon

; add 5 to each number on l

(define (plus5 l)

  (cond

    [(empty? l) false]

    [else

     (cons (+ (first l) 5)

           (plus5 (rest l)))]))

Then abstract over them. Define above two functions in terms of the abstraction as one-liners and use the existing test suites to confirm that the revised definitions work properly. Finally, design a function that subtracts 2 from each number on a given list.

I had to fix the above functions to do this exercise - the empty case is returning false in the book which will make the cons fail as you can't cons a list to false.

Test Cases

; simple happy test - all numbers should be increased by one
(check-expect (add1* '(1 2 3))
'(2 3 4))

; test empty list returns empty
(check-expect (add1* empty)
empty)

; simple happy test - all numbers should be increased by five
(check-expect (plus5 '(1 2 3))
'(6 7 8))

; test empty list returns empty
(check-expect (plus5 empty)
empty)

; My abstraction - allow them to pass in the size of the increment
; Number, Lon -> Lon
(define (inc* amount l)
(cond
[(empty? l) empty]
[else
(cons (+ (first l) amount)
(inc* amount (rest l) ))]))

; Lon -> Lon
; add 1 to each number on l
(define (add1* l)
(inc* 1 l))

; Lon -> Lon
; add 5 to each number on l
(define (plus5 l)
(inc* 5 l))

Part Two

Define a function that subtracts 2 from each member of a list.

; a function that subtracts 2 from each member of a list
; Lon -> Lon
(define (minus2 l)
(inc* -2 l))

; happy test
(check-expect (minus2 '(5 7 9))
'(3 5 7))

Exercise 186: Use contains? to define functions that search for "atom", "basic", and "zoo", respectively

2012-12-04T15:38:00.000-08:00

Exercise 186: Use contains? to define functions that search for "atom", "basic", and "zoo", respectively.

The contains function is supplied by the text

; String Los -> Boolean

; to determine whether l contains the string s

(define (contains? s l)

  (cond

    [(empty? l) false]

    [else (or (string=? (first l) s)

              (contains? s (rest l)))]))

Answer

; String Los -> Boolean
; to determine whether l contains the string s
(define (contains? s l)
(cond
[(empty? l) false]
[else (or (string=? (first l) s)
(contains? s (rest l)))]))

; Los -> Boolean
; to determine whether l contains the string "atom"
(define (contains-atom l)
(contains? "atom" l))

; Los -> Boolean
; to determine whether l contains the string "basic"
(define (contains-basic l)
(contains? "basic" l))

; Los -> Boolean
; to determine whether l contains the string "zoo"
(define (contains-zoo l)
(contains? "zoo" l))

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

2012-11-21T15:51:00.000-08:00

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")))

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

2012-11-14T15:37:00.003-08:00

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)))))

Exercise 183: Eliminate quasiquote and unquote from the following expressions

2012-10-02T16:59:00.001-07:00

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")))

Exercise 182: Eliminate quote from the following expressions

2012-09-11T15:12:00.000-07:00

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 ))))

Special Exercise - Space Invaders Part 4

2012-08-29T18:13:00.000-07:00

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)))))))))

Special Exercise - Space Invaders Part 3

2012-08-21T18:22:00.000-07:00

Special Exercise - Space Invaders Part 3

For this third iteration my goals were to

Make the tank move left and right.
Make the ufos move left and right and (always) down.

While I found it is nice and simple to make the pieces move as needed, I always struggle with the bounds checking. It this case we needed to stop the tank and the ufo's from moving off the side of the screen.

It's not that bounds checking is hard to do, just it always ends up looking messy and detracting from the simplicity of the code. Instead of "move left", it's "move left . . . unless this, or that or something else". The way I have written it below works, but there is bound to be a better way to do it.

In addition to the changes needed to support the goals above, ufos' now hold a direction integer to say which direction (left or right) they are currently travelling in.

Code

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

; physical constants
(define WIDTH 300) ; the maximal number of blocks horizontally
(define HEIGHT 300) ; the maximal number of blocks horizontally

; graphical constants
(define SIZE 10) ; the size of the block making up the ufo
(define UFO-WIDTH 50)

(define BLOCK ; they are rendered as red squares with black rims
(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 (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 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) (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))))

; 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) ))

; 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) ])))

; On each clock tick, move the world further in time.
(define (progress-world world)
(make-world (move-ufos (world-ufos world)) (world-tank world)))

; This is the big bang function that drives the game.
(define (space-invaders-main rate)
(big-bang (make-world (make-ufos 2 empty) TANK)
;(big-bang (make-world (list (make-ufo 10 10 1)) TANK)

(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))

;(other tests are unchanged)

Special Exercise - Space Invaders Part 2

2012-08-14T18:20:00.000-07:00

Design a complete Space Invaders Game - Part 2

For the second iteration I am going to add a big-bang function to the game and draw the game as a game world. The game world current consists of a collection of ufos and our tank.

As adding the game code here for drawing the world is pretty simple I have also added a function that will programatically generate a collection of ufos. This is to save specifying the initial position of each ufo by hand. To start with I am drawing 3 rows of how ever many ufos will currently fit.

Code

(require racket/base)
(define-struct ufo (x y) #:transparent)
(define-struct tank (x y) #:transparent)
(define-struct world (ufos tank))
; physical constants
(define WIDTH 300) ; the maximal number of blocks horizontally
(define HEIGHT 300) ; the maximal number of blocks horizontally

; graphical constants
(define SIZE 10) ; the size of the block making up the ufo
(define UFO-WIDTH 50)

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

(define TEST-UFO (make-ufo 30 30)) ; for testing
(define TEST-UFOS (list (make-ufo 30 30)
(make-ufo 80 30)
(make-ufo 130 30))); 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 supplied 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) ufos)))
((> (+ (ufo-x (first ufos)) UFO-WIDTH) WIDTH) ufos)
(else (make-ufos-for-y y-cordinate
(cons (make-ufo (+ (ufo-x (first ufos)) UFO-WIDTH)
y-cordinate) ufos )))))

; create a complete 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 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 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) (empty-scene WIDTH HEIGHT))))

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

(space-invaders-main 0.2)

; tests

; 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)))))))))

Special Exercise - Space Invaders Part 1

2012-08-07T00:14:00.000-07:00

Design a complete Space Invaders Game

The description of the space invader game we are given is very sparse. This is probably because the details don't matter so much as the act of actually designing the game. For lack of further specification I'm going to try for something similar to the original space invader game.

We will have a few rows of aliens that will be moving slowly closer (and left and right). At the moment I am not planning on letting them shoot, but that may change. On the ground there will be a tank that can move left and right and shoot at and destroy the aliens. (With possibly some blocks to hide behind if the aliens end up being able to shoot. If any of the aliens reach earth, the player loses. If he manages to destroy all the ufo's the player wins.

For this first iteration I'm going to create the functions to:

draw the ufo,
draw a collection of ufos
draw our tank

Code

(require racket/base)
(define-struct ufo (x y) #:transparent)
(define-struct tank (x y) #:transparent)

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

; physical constants
(define WIDTH 300) ; the maximal number of blocks horizontally
(define HEIGHT 300) ; the maximal number of blocks horizontally

; graphical constants
(define SIZE 10) ; the size of the block making up the ufo
(define BLOCK ; they are rendered as red squares with black rims - stolen from tetris
(overlay (rectangle (- SIZE 1) (- SIZE 1) "solid" "red")
(rectangle SIZE SIZE "outline" "black")))

; 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))))))))

(define (draw-ufos ufos background)
(cond ((empty? ufos) background)
(else (draw-ufo (first ufos)
(draw-ufos (rest ufos) background)))))

; tests

; 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)))))))))

Exercise 178: Equip the program from exercise 177 with a stop-when clause.

2012-07-31T18:29:00.000-07:00

Exercise 178: Equip the program from exercise 177 with a stop-when clause. The game ends when one of the columns contains HEIGHT blocks.

Download code for this exercise here.

I implemented the stop-when handler slightly differently than suggested in the book. The way it was described did not make sense to me. The suggestion was to 1) create a function that will create a column of blocks/landscape to determine the end of the game. 2) Create a function to function to get the height of a particular column, and 3) stop when the height of a column exceeds HEIGHT.

It seems that if you do steps 2 and 3, then you don't need step 1) at all. All you need to do is to check each column for the height. This is how I have chosen to implement it.

The score function was reasonably straight forward to create - we just needed to count all the blocks in the landscape and then convert that number to a string.

In the end we have a reasonably functional game. I did contemplate trying to extend this to do shapes, but the next exercise (creating a space invaders game) looked too interesting to be put off!

Code

(require racket/base)
(define-struct block (x y) #:transparent)
(define-struct tetris (block landscape))

; physical constants
(define WIDTH 10) ; the maximal number of blocks horizontally

; graphical constants
(define SIZE 10) ; blocks are square
(define BLOCK ; they are rendered as red squares with black rims
(overlay (rectangle (- SIZE 1) (- SIZE 1) "solid" "red")
(rectangle SIZE SIZE "outline" "black")))

; this is just an example/test Tetris scene.
(define TETRIS (make-tetris (make-block 10 60)
(list (make-block 20 40) )))

(define SCENE-SIZE (* WIDTH SIZE) )

; new function
(define (game-over-scene tetris)
(place-image (text (string-append "Score: " (score tetris)) 15 "black") 50 70
(place-image (text "game over" 20 "black") 50 50
(tetris-render tetris))))

; Returns the score - the number of blocks in the landscape
(define (score tetris);
(number->string (length (tetris-landscape tetris))))

; takes in a landscape and an x co-ordinate.
; produces a list (landscape) of blocks with that co-ordinate.
; standard recursion - if the landscape is empty, we're at the end so return it.
; if the block at the top has the right x co-ordinate, create a list out of it
; + the recursion
; if the block at the top doesn't match, just recurse further
; landscape, number -> landscape
(define (get-column landscape x)
(cond ((empty? landscape) landscape)
((= x (block-x (first landscape)))
(cons (first landscape)
(get-column (rest landscape) x)))
(else (get-column (rest landscape) x))))
; test the happy case - should get all the blocks in the 10 x-cordinate
(check-expect (get-column (list (make-block 10 10)
(make-block 10 20)
(make-block 20 20)) 10)
(list (make-block 10 10)
(make-block 10 20)))

; returns true any of the columns in the landscape exceed the maximum height
; landscape: the game landscape
; height: the max height
; column: the current column as we recurse down. Start at the far right column
(define (height-exceeded landscape height column)
; if we reach last column without finding an exceeded column then return false
; if the current column exceeds the height, return true
; else recurse....
(cond
((empty? landscape) false)
((= 0 column) false)
; get the column for the current co-ordinates
((= height (length (get-column landscape (* column SIZE)))) true)
(else (height-exceeded landscape height (- column 1)))))

; test the happy case - should get all the blocks in the 10 x-cordinate
(check-expect (height-exceeded empty 10 1) false)
(check-expect (height-exceeded (list (make-block 10 10)
(make-block 10 20)
(make-block 10 20)) 3 1)
true)

(define (end-game? tetris)
(height-exceeded (tetris-landscape tetris) 2 WIDTH))

; start the block in the middle
(define INITIAL-BLOCK (make-block (/ SCENE-SIZE 2) 0))

; Block -> Block
; Creates a new block at random, anywhere but the current column
(define (block-create b)
(block-check-create b (make-block (* (random WIDTH) SIZE) 0)))

; Block Bloc -> Block
; generative recursion
; checks that the candidate and b are in different colums on the screen.
; if they are at the same point, create a new candiate by recursing into
; block-create, otherwise return the new candidate (which will then be returned
; via block-create)
(define (block-check-create b candidate)
(if (equal? (block-x b) (block-x candidate))
(block-create b) candidate))

; This tetris-render function is a wrapper around the main function.
; This just splits the tetris into the initial block/landscape tuple and
; calls the main tetris-render-helper function.
(define (tetris-render tetris)
(tetris-render-helper (tetris-block tetris)
(tetris-landscape tetris)))

; draw a tetris scene. This is the function that does the guts of the work.
; If our landscape is empty, just draw the block onto an empty scene
; otherwise recurse, and draw draw the current block on the result of drawing the rest of the
; blocks.
(define (tetris-render-helper block landscape)
(draw-block block
(cond ((empty? landscape )
(empty-scene SCENE-SIZE SCENE-SIZE))
(else (tetris-render-helper (first landscape)
(rest landscape))))))

; Draw a block on our background. I'm using place-image/align instead of
; place-image as we need to define where our block is appearing. By default
; place-image will center the image at the x/y co-ordinates. This would leave
; a block drawn at 0,0 to be drawn half off the left of the screen and half
; off the top of the screen.
(define (draw-block block background)
(place-image/align BLOCK
(block-x block)
(block-y block) "left" "bottom"
background))

; Handle keyboard events.
; The move-block function is called by both handle-key-events and progress world. ; To keep it simple it only takes in a block . This means we
; need to construct the new tetris around the cond clauses - if the user hasn't
; pressed left or right, we just pass the unaltered block straight back in
; Also we are checking to see if the moved block (left/right) would collide with
; an existing block. Without this check, you can move inside a column of blocks.
; This probably shouldn't be handled here - it would be better extracted out and
; handled in a dedicated function.
(define (handle-key-events tetris ke)
(make-tetris
(cond
[(string=? "left" ke)
(cond ((landscape-collision? tetris "left") (tetris-block tetris))
(else (move-block (tetris-block tetris) "left")))]
[(string=? "right" ke)
(cond ((landscape-collision? tetris "right") (tetris-block tetris))
(else (move-block (tetris-block tetris) "right"))) ] )
(tetris-landscape tetris)))

; On each clock tick, move the world further in time.
(define (progress-world tetris)
(check-collisions
(make-tetris (move-block (tetris-block tetris) "down")
(tetris-landscape tetris)
)))

; moves the block and returns a new block.
; we do bounds checking for each direction - make sure we can't go off the
; right or the left of the screen.
(define (move-block block direction)
(cond ((string=? direction "left")
(cond ((> SIZE (block-x block)) block)
(else (make-block (- (block-x block) SIZE) (block-y block)))))

((string=? direction "right")
(cond ((= (- SCENE-SIZE SIZE) (block-x block)) block)
(else (make-block (+ (block-x block) SIZE ) (block-y block)))))

((string=? direction "down")
(make-block (block-x block) (+ SIZE ( block-y block))))))

; checks for collisions between the block and the landscape. if this is the case,
; the block becomes part of the landscape and we generate a new block.
; In order for the blocks to stack, we need to forecast a collision - ie,
; look at where the block will be if it moved down one more square)
; I'm not overly happy with this - I need a special case to handle if the
; landscape is empty (which it will be at the start of the game). I'm not sure
; if this means I'm structuring this wrong, or if this is a genuine need...
(define (check-collisions tetris)
(cond
; collision - either with another block, or with the floor
; make block part of landscape and create new block
((or (landscape-collision? tetris "down") (floor-collision? tetris))
(make-tetris (block-create (tetris-block tetris))
(append (tetris-landscape tetris)
(cons (tetris-block tetris) empty))
))
; no collision - just return
(else tetris)
))

; detects block collision with the landscape
(define (landscape-collision? tetris direction)
(and (not (empty? (tetris-landscape tetris)))
(member? (move-block (tetris-block tetris) direction)
(tetris-landscape tetris) ))
)

; checks for a collision with the floor
; we don't check if we've exceeded the height, we check we haven't exceeded
; the height less the width of the block. otherwise our block won't trigger
; the collision until they are below the floor
(define (floor-collision? tetris)
(> (block-y (tetris-block tetris)) (- SCENE-SIZE SIZE)))

; This is the big bang function that drives the game.
(define (tetris-main rate)
(big-bang (make-tetris INITIAL-BLOCK empty)
(to-draw tetris-render)
(on-key handle-key-events)
(on-tick progress-world rate)
(stop-when end-game? game-over-scene)
))

(tetris-main 0.2)

; ## TESTS ##

; simple example - a single block in an empty landscape
(check-expect (tetris-render (make-tetris (make-block 20 40) empty))
(place-image/align BLOCK 20 40 "left" "bottom"
(empty-scene SCENE-SIZE SCENE-SIZE)))

; a slightly more complex test - drawing two blocks
(check-expect (tetris-render (make-tetris (make-block 10 60)
(list (make-block 20 40) )))
(place-image/align BLOCK 10 60 "left" "bottom"
(place-image/align BLOCK 20 40 "left" "bottom"
(empty-scene SCENE-SIZE SCENE-SIZE))))

; landscape collision - no collision
(check-expect (landscape-collision? (make-tetris (make-block 10 60)
(list (make-block 20 40))) "down")
false)

; floor collision - no collision
(check-expect (floor-collision? (make-tetris (make-block 10 60)
(list empty)))
false)

; floor collision - collision
(check-expect (floor-collision? (make-tetris (make-block 10 SCENE-SIZE )
(list empty)))
true)

Exercise 177: Modify the program from exercise 176 so that a player can control the left or right movement of the dropping block.

2012-07-24T23:20:00.000-07:00

Modify the program from exercise 176 so that a player can control the left or right movement of the dropping block.

Each time the player presses the "left" arrow key, the dropping block should shift one column to the left unless it is in column 0 or there is already a stack of resting blocks to its left. Similarly, each time the player presses the "right" arrow key, the dropping block should move one column to the right if possible.

Download code for this exercise here.

Code

(require racket/base)
(define-struct block (x y) #:transparent)
(define-struct tetris (block landscape))

; physical constants
(define WIDTH 10) ; the maximal number of blocks horizontally

; graphical constants
(define SIZE 10) ; blocks are square
(define BLOCK ; they are rendered as red squares with black rims
(overlay (rectangle (- SIZE 1) (- SIZE 1) "solid" "red")
(rectangle SIZE SIZE "outline" "black")))

; this is just an example/test Tetris scene.
(define TETRIS (make-tetris (make-block 10 60)
(list (make-block 20 40) )))

(define SCENE-SIZE (* WIDTH SIZE) )

; start the block in the middle
(define INITIAL-BLOCK (make-block (/ SCENE-SIZE 2) 0))

; Block -> Block
; Creates a new block at random, anywhere but the current column
(define (block-create b)
(block-check-create b (make-block (* (random WIDTH) SIZE) 0)))

; Block Bloc -> Block
; generative recursion
; checks that the candidate and b are in different colums on the screen.
; if they are at the same point, create a new candiate by recursing into
; block-create, otherwise return the new candidate (which will then be returned
; via block-create)
(define (block-check-create b candidate)
(if (equal? (block-x b) (block-x candidate))
(block-create b) candidate))

; This tetris-render function is a wrapper around the main function.
; This just splits the tetris into the initial block/landscape tuple and
; calls the main tetris-render-helper function.
(define (tetris-render tetris)
(tetris-render-helper (tetris-block tetris)
(tetris-landscape tetris)))

; draw a tetris scene. This is the function that does the guts of the work.
; If our landscape is empty, just draw the block onto an empty scene
; otherwise recurse, and draw draw the current block on the result of drawing the rest of the
; blocks.
(define (tetris-render-helper block landscape)
(draw-block block
(cond ((empty? landscape )
(empty-scene SCENE-SIZE SCENE-SIZE))
(else (tetris-render-helper (first landscape)
(rest landscape))))))

; Draw a block on our background. I'm using place-image/align instead of
; place-image as we need to define where our block is appearing. By default
; place-image will center the image at the x/y co-ordinates. This would leave
; a block drawn at 0,0 to be drawn half off the left of the screen and half
; off the top of the screen.
(define (draw-block block background)
(place-image/align BLOCK
(block-x block)
(block-y block) "left" "bottom"
background))

; Handle keyboard events.
; The move-block function is called by both handle-key-events and progress world. ; ; To keep it simple it only takes in a block (rather than a tetris). This means we
; need  to construct the new tetris around the cond clauses - if the user hasn't
; pressed left or right, we just pass the unaltered block straight back in

; Also we are checking to see if the moved block (left/right) would collide with
; an existing block. Without this check, you can move 'inside' a column of blocks.
; This probably shouldn't be handled here - it would be better extracted out and
; handled in a dedicated function.
(define (handle-key-events tetris ke)
(make-tetris
(cond
[(string=? "left" ke)
(cond ((landscape-collision? tetris "left") (tetris-block tetris))
(else (move-block (tetris-block tetris) "left")))]
[(string=? "right" ke)
(cond ((landscape-collision? tetris "right") (tetris-block tetris))
(else (move-block (tetris-block tetris) "right"))) ] )
(tetris-landscape tetris)))

; On each clock tick, move the world further in time.
(define (progress-world tetris)
(check-collisions
(make-tetris (move-block (tetris-block tetris) "down")
(tetris-landscape tetris)
)))

; moves the block and returns a new block.
; we do bounds checking for each direction - make sure we can't go off the
; right or the left of the screen.
(define (move-block block direction)
(cond ((string=? direction "left")
(cond ((> SIZE (block-x block)) block)
(else (make-block (- (block-x block) SIZE) (block-y block)))))

((string=? direction "right")
(cond ((= (- SCENE-SIZE SIZE) (block-x block)) block)
(else (make-block (+ (block-x block) SIZE ) (block-y block)))))

((string=? direction "down")
(make-block (block-x block) (+ SIZE ( block-y block))))))

; checks for collisions between the block and the landscape. if this is the case,
; the block becomes part of the landscape and we generate a new block.
; In order for the blocks to stack, we need to forecast a collision - ie,
; look at where the block will be if it moved down one more square)
; I'm not overly happy with this - I need a special case to handle if the
; landscape is empty (which it will be at the start of the game). I'm not sure
; if this means I'm structuring this wrong, or if this is a genuine need...
(define (check-collisions tetris)
(cond
; collision - either with another block, or with the floor
; make block part of landscape and create new block
((or (landscape-collision? tetris "down") (floor-collision? tetris))
(make-tetris (block-create (tetris-block tetris))
(append (tetris-landscape tetris)
(cons (tetris-block tetris) empty))
))
; no collision - just return
(else tetris)
))

; detects block collision with the landscape
(define (landscape-collision? tetris direction)
(and (not (empty? (tetris-landscape tetris)))
(member? (move-block (tetris-block tetris) direction)
(tetris-landscape tetris) ))
)

; checks for a collision with the floor
; we don't check if we've exceeded the height, we check we haven't exceeded
; the height less the width of the block. otherwise our block won't trigger
; the collision until they are below the floor
(define (floor-collision? tetris)
(> (block-y (tetris-block tetris)) (- SCENE-SIZE SIZE)))

; This is the big bang function that drives the game.
(define (tetris-main rate)
(big-bang (make-tetris INITIAL-BLOCK empty)
(to-draw tetris-render)
(on-key handle-key-events)
(on-tick progress-world rate)
))

(tetris-main 0.2)

; ## TESTS ##

; simple example - a single block in an empty landscape
(check-expect (tetris-render (make-tetris (make-block 20 40) empty))
(place-image/align BLOCK 20 40 "left" "bottom"
(empty-scene SCENE-SIZE SCENE-SIZE)))

; a slightly more complex test - drawing two blocks
(check-expect (tetris-render (make-tetris (make-block 10 60)
(list (make-block 20 40) )))
(place-image/align BLOCK 10 60 "left" "bottom"
(place-image/align BLOCK 20 40 "left" "bottom"
(empty-scene SCENE-SIZE SCENE-SIZE))))

; landscape collision - no collision
(check-expect (landscape-collision? (make-tetris (make-block 10 60)
(list (make-block 20 40))) "down")
false)

; floor collision - no collision
(check-expect (floor-collision? (make-tetris (make-block 10 60)
(list empty)))
false)

; floor collision - collision
(check-expect (floor-collision? (make-tetris (make-block 10 SCENE-SIZE )
(list empty)))
true)

Exercise 176: Design the interactive program tetris-main...

2012-07-17T18:26:00.000-07:00

Design the interactive program tetris-main, which displays blocks dropping in a straight line from the top of the canvas and landing on the floor or on blocks that are already resting.

Download the code for this exercise here.

This was a fairly straight forward extension to the previous exercise. The main 'gotcha' I came across involved the member? function which was used to determine if a block had collided with a landscape. The problem was that my tests were returning false (that there was no collision), when I knew that there should be a collision. This led to two discoveries - firstly, in order for member? to be able to look into an arbitrary struct, the struct needs to be declared as #:transparent. Secondly, in order for a struct to be able to be declared as transparent, we need to specifically require 'racket/base'.

One aspect changed since my solution for exercise 175 is the use of place-image/align instead of place-image. This is to ensure that the blocks are correctly placed within the boundaries of the screen
using the native co-ordinate points stored for them. Without the use of this method I would have need to manually shift each block by 5 pixels in order to make them appear correctly.

Code

(require racket/base)

; The struct block contains the blocks that make up landscape and the
; current falling block. We need to define this struct as transparent or
; the member? function won't be able to look inside it.
(define-struct block (x y) #:transparent)

; A tetris consists of a block, and a landscape
(define-struct tetris (block landscape))

; physical constants
(define WIDTH 10) ; the maximal number of blocks horizontally/vertically
(define SIZE 10) ; blocks are square

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

(define SCENE-SIZE (* WIDTH SIZE) )

; an initial block, starting the block in the middle of the screen
(define INITIAL-BLOCK (make-block (/ SCENE-SIZE 2) 0))

; Block -> Block
; Creates a new block at random, anywhere but the current column
; These are essentially the same as the generative recursion functions used in
; the worm game exercises
(define (block-create b)
(block-check-create b (make-block (* (random WIDTH) SIZE) 0)))

; Block Bloc -> Block
; Checks that the candidate and b are in different colums on the screen.
; If they are at the same point, create a new candiate by recursing into
; block-create, otherwise return the new candidate (which will then be returned
; via block-create)
(define (block-check-create b candidate)
(if (equal? (block-x b) (block-x candidate))
(block-create b) candidate))

; This tetris-render function is a wrapper around the main function.
; This just splits the tetris into the initial block/landscape tuple and
; calls the main tetris-render-helper function.
(define (tetris-render tetris)
(tetris-render-helper (tetris-block tetris)
(tetris-landscape tetris)))

; Draw a tetris scene. This is the function that does the guts of the work.
; If our landscape is empty, just draw the block onto an empty scene
; otherwise recurse, and draw draw the current block on the result of drawing the rest of the
; blocks.
(define (tetris-render-helper block landscape)
(draw-block block
(cond ((empty? landscape )
(empty-scene SCENE-SIZE SCENE-SIZE))
(else (tetris-render-helper (first landscape)
(rest landscape))))))

; Draw a block on our background. I'm using place-image/align instead of
; place-image as we need to define where our block is appearing. By default
; place-image will center the image at the x/y co-ordinates. This would leave
; a block drawn at 0,0 to be drawn half off the left of the screen and half off the top of the screen.
(define (draw-block block background)
(place-image/align BLOCK
(block-x block)
(block-y block) "left" "bottom"
background))

; On each clock tick, move the world further in time. This currently just
; moves our block down one square
; This is pretty clunky, but I'm okay with it for now as it is only moving
; the block down one square - as soon as the tetris needs to move in 3
; directions this will be separated out into a separate function
(define (progress-world tetris)
(check-collisions
(make-tetris (move-block (tetris-block tetris))
(tetris-landscape tetris)
)))

; moves the block and returns a new block. Currently this only moves in one direction - down
(define (move-block block)
(make-block (block-x block)
(+ SIZE ( block-y block))))

; checks for collisions between the block and the landscape. if this is the
; case, the block becomes part of the landscape and we generate a new block.
; In order for the blocks to stack, we need to forecast a collision - ie,
; look at where the block will be if it moved down one more square)
(define (check-collisions tetris)
(cond
; collision - either with another block, or with the floor
; make block part of landscape and create new block
((or (landscape-collision? tetris) (floor-collision? tetris))
(make-tetris (block-create (tetris-block tetris))
(append (tetris-landscape tetris)
(cons (tetris-block tetris) empty))
))
; no collision - just return
(else tetris)
))

; detects block collision with the landscape

; I'm not overly happy with this - I need a special check to handle if
; the landscape is empty (which it will be at the start of the game).
; I'm not sure if this means I'm structuring this wrong, or if this is a
; genuine need...

(define (landscape-collision? tetris)
(and (not (empty? (tetris-landscape tetris)))
(member? (move-block (tetris-block tetris))
(tetris-landscape tetris) ))
)

; checks for a collision with the floor
; we don't check if we've exceeded the height, we check we haven't
; exceeded the height less the width of the block. otherwise our block
; won't trigger the collision until they are below the floor
(define (floor-collision? tetris)
(> (block-y (tetris-block tetris)) (- SCENE-SIZE SIZE)))

; This is the big bang function that drives the game.
(define (tetris-main rate)
(big-bang (make-tetris INITIAL-BLOCK empty)
(to-draw tetris-render)
(on-tick progress-world rate)))

(tetris-main 0.04)

; ## TESTS ##

; simple example - a single block in an empty landscape
(check-expect (tetris-render (make-tetris (make-block 20 40) empty))
(place-image/align BLOCK 20 40 "left" "bottom"
(empty-scene SCENE-SIZE SCENE-SIZE)))

; a slightly more complex test - drawing two blocks
(check-expect (tetris-render (make-tetris (make-block 10 60)
(list (make-block 20 40) )))
(place-image/align BLOCK 10 60 "left" "bottom"
(place-image/align BLOCK 20 40 "left" "bottom"
(empty-scene SCENE-SIZE SCENE-SIZE))))

; landscape collision - no collision
(check-expect (landscape-collision? (make-tetris (make-block 10 60)
(list (make-block 20 40))))
false)

; landscape collision - a collision
(check-expect (landscape-collision? (make-tetris
(make-block 20 30)
(list (make-block 20 40)
(make-block 30 40))))
true)

; floor collision - no collision
(check-expect (floor-collision? (make-tetris (make-block 10 60)
(list empty)))
false)

; floor collision - collision
(check-expect (floor-collision? (make-tetris (make-block 10 SCENE-SIZE )
(list empty)))
true)

Exercise 175: Design the program tetris-render...

2012-07-10T18:24:00.000-07:00

Design the program tetris-render, which turns a given instance of Tetris into an Image.

You can download the code for this question from here.

This is a straight forward question. We have a data structure containing a collection of tetris blocks, which we need to turn into a world (game) scene.

We can do this by recursing through our data structure until we have a complete scene.

I chose to split the tetris-render function into two functions - a main function and a helper function. This because the main render-tetris function only takes a single argument (a Tetris) and if I wanted to recurse into this I would need to continually be created a a new Tetris from the component parts I had (the head and the tail)

; A Tetris is (make-tetris Block Landscape)

; A Landscape is one of:

; – empty

; – (cons Block Landscape)

; Block is (make-block N N)

; interpretation: given (make-tetris (make-block x y) (list b1 b2 ...))

; (x,y) is the logical position of the dropping block, while

; b1, b2, etc are the positions of the resting blocks

; a logical position (x,y) determines how many SIZEs the block is

; from the left—x—and from the top—x.

Code

(define-struct block (x y))
(define-struct tetris (block landscape))

; physical constants
(define WIDTH 10) ; the maximal number of blocks horizontally

; graphical constants
(define SIZE 10) ; blocks are square
(define BLOCK ; they are rendered as red squares with black rims
(overlay (rectangle (- SIZE 1) (- SIZE 1) "solid" "red")
(rectangle SIZE SIZE "outline" "black")))

; this is just an example/test Tetris scene.
(define TETRIS (make-tetris (make-block 10 60)
(list (make-block 20 40) )))

(define SCENE-SIZE (* WIDTH SIZE))

; This tetris-render function is a wrapper around the main function.
; This just splits the tetris into the initial block/landscape tuple and
; calls the main tetris-render-helper function.
(define (tetris-render tetris)
(tetris-render-helper (tetris-block tetris)
(tetris-landscape tetris)))

; draw a tetris scene. This is the function that does the guts of the work.
; If our landscape is empty, just draw the block onto an empty scene
; otherwise recurse, and draw draw the current block on the result of drawing
; the rest of the blocks.
(define (tetris-render-helper block landscape)
(draw-block block
(cond ((empty? landscape )
(empty-scene SCENE-SIZE SCENE-SIZE))
(else (tetris-render-helper (first landscape)
(rest landscape))))))

; draw our block on supplied background.
(define (draw-block block background)
(place-image BLOCK
(block-x block) (block-y block)
background))

(tetris-render TETRIS)

; ## TESTS ##

; simple example - a single block in an empty landscape
(check-expect (tetris-render (make-tetris (make-block 20 40) empty))
(place-image BLOCK 20 40 (empty-scene SCENE-SIZE SCENE-SIZE)))

; a slightly more complex test - drawing two blocks
(check-expect (tetris-render (make-tetris (make-block 10 60)
(list (make-block 20 40) )))
(place-image BLOCK 10 60 (place-image BLOCK 20 40
(empty-scene SCENE-SIZE SCENE-SIZE))))

Exercise 174: Equip your program from exercise 173 with food.

2012-07-03T18:22:00.000-07:00

Exercise 174: Equip your program from exercise 173 with food

At any point in time, the box should contain one piece of food. To keep things simple, a piece of food is of the same size as worm segment. When the worm’s head is located at the same position as the food, the worm eats the food, meaning the worm’s tail is extended by one segment. As the piece of food is eaten, another one shows up at a different location.
Your program should place the food randomly within the box. To do so properly, you need a design technique that you haven’t seen before—so-called generative recursion—so we provide function definitions:

; Posn -> Posn

; ???

(define (food-create p)

(food-check-create p (make-posn (random MAX) (random MAX))))

; Posn Posn -> Posn

; generative recursion

; ???

(define (food-check-create p candidate)

(if (equal? p candidate) (food-create p) candidate))

The code for the exercise can be downloaded here.

Generative recursion is defined by wikipedia as recursion that creates an entirely new object.

The function food-check-create creates a random object (via food-create) and then checks to make sure it's not in the same position as the posn passed in. This is to ensure that the food does not appear directly under the snakes head thus prematurely ending the game.

The function as supplied does not ensure that the food does not appear under the snake body - however that shouldn't matter too much as this will not end the game due to the collision detection only checking the worms head - it would just seem a bit funny to watch.

In my answer below, I have modified this function somewhat. This is due to the nature of the error collision I have used in checking for food collisions. I am checking the co-ordinates of the food and of the snake and determining a collision has occurred if the x and y co-ordinates are the same. This is an issue because if the co-ordinates are out by 1-20 pixels, the snake would appear to touch (or overlap) the food and pass right over it.

Therefore I have locked the food generation to appear on only x and y co-ordinates that the snake can appear on. I could have also fixed this in the food-collision method, but this would have mean the snake could still only partially intersect the food. It would work, but still look funny (and this is not how snake games are meant to work!)

Whilst I was writing this final stage of this question, I finally recall the the posn structure and realise I probably should have been using them all along (instead of the structure I called segments). This would be a minor thing to change, but I will leave them called segments as this makes the code easier to read and makes it consistant with the answers I have already created.

; Constants

(define WORM-SIZE 10)
(define WORM-MOVE (* WORM-SIZE 2))
(define WIDTH 800) ; width of the game
(define HEIGHT 500) ; height of the game
(define SEGMENT (circle WORM-SIZE "solid" "red"))
(define FOOD (circle WORM-SIZE "solid" "black"))

; these structs will hold the current list of worm segments, the direction
; the worm is travelling in, and our world object
(define-struct segment(x-pos y-pos))
(define-struct direction(x y))

; worm is a list of worm segments
; direction is the direction the worm is travelling
; segment is our current food segment
(define-struct world(worm direction segment))

(define WORM (list (make-segment 100 100)
(make-segment 100 80)
(make-segment 100 60)) )

; To save repeating these directions in tests and code, we'll define them here
(define DOWN (make-direction 0 1))
(define UP (make-direction 0 -1))
(define RIGHT (make-direction 1 0))
(define LEFT (make-direction -1 0))

; Functions

This first function food-create is one of the supplied functions. I have changed the dimensions for the allowed positions for the food segment. This is because we need to make sure the food is in a position that our worm can travel over completely. (Currently this is multiples of 20). If we don't do this, the food could be off by for example 5 pixels, so we could travel over it and not trigger a collision

; Posn -> Posn
; Creates a new item of food at anywhere on the screen *except* for the
; point defined by posn p. (eg the current snake position)

(define (food-create p)
(food-check-create
p
(make-segment (* (random (/ WIDTH WORM-MOVE)) WORM-MOVE)
(* (random (/ HEIGHT WORM-MOVE)) WORM-MOVE))))

; Posn Posn -> Posn
; checks that the candidate and p are at different points on the screen.
; If they are at the same point, create a new candiate by recursing into
; food-create, otherwise return the new candidate (which will then be returned
; via food-create)
(define (food-check-create p candidate)
(if (equal? p candidate) (food-create p) candidate))

; draw worm in its current location on the screen. Instead of simply drawing
; a single dot on the screen, we need to recurse down our list of worm
; segments drawing each one at a time
(define (draw-worm background worm)
(cond [(empty? worm) background]
[else (place-image
SEGMENT
(segment-x-pos (first worm)) (segment-y-pos (first worm))
(draw-worm background (rest worm))
)]))

; This is a new method for question 174.
; This draws the food on to the background of our world
; Returns a new image.
(define (draw-food background food)
(place-image FOOD (segment-x-pos food) (segment-y-pos food) background) )

; function to determine if we have collided with a food block
; returns true if the worm's segment is on top of the food
(define (worm-hit-food? segment food)
(cond ((and (= (segment-x-pos segment) (segment-x-pos food))
(= (segment-y-pos segment) (segment-y-pos food))) true)
(else false)))

; This is a new function for question 174. It grows the worm one segment.
; To do this we just append a segment in the existing foods position
; on to the worm. Another way to do this would be to append at the end of
; the list.
; This method was simpler though (but doesn't look quite as good)
(define (grow-worm worm food)
(cons (make-segment (segment-x-pos food) (segment-y-pos food)) worm ))

; This is a new function for question 174. This method will check if we are
; in the same location as a food item, and if so, eat it. (and make the worm
; grow longer)
; returns a world state with either nothing changed, or a longer worm and
; a new food;
(define (eat-food world)
(cond ((worm-hit-food? (first (world-worm world)) (world-segment world))
(make-world (grow-worm (world-worm world) (world-segment world))
(world-direction world)
(food-create (first (world-worm world)))))
(else world)))

; Checks if the snake has collided with either itself, or with the walls
; Returns true in the event of a collision
(define (collision-detected world)
(or
(collision-detected-wall (first (move-worm-helper world )))
(collision-detected-worm (first (move-worm-helper world)) (world-worm world ))))

; Returns true if the worm has collided with itself.
(define (collision-detected-worm segment worm)
(member? segment worm))

; helper function for collision detection. Operates directly
; on a worm, rather than world object.
(define (collision-detected-wall segment)
(cond [(> 0 (segment-x-pos segment)) true] ; exceeding left edge
[(> 0 (segment-y-pos segment)) true] ; exceeding top edge
[(< WIDTH (segment-x-pos segment)) true] ; exceeding right edge
[(< HEIGHT (segment-y-pos segment)) true] ; exceeding bottom edge
[else false]))

; Draw our final scene with the worm departing the board
; Displays a "Game Over" type message. We should probably be calculating the
; width and height of the image to calculate the offsets, but it's simpler just
; to arbitrarily put it somewhere in the bottom right of the screen

(define (final-scene world)
(draw-worm
(place-image
(text
(cond ((collision-detected-wall (first (move-worm-helper world )))
"worm hit border" )
(else "worm hit worm"))
20 "red")
(- WIDTH 100)
(- HEIGHT 50)
(empty-scene WIDTH HEIGHT))
(world-worm world)))

; Draws the current world.
(define (show world)
(draw-food
(draw-worm (empty-scene WIDTH HEIGHT) (world-worm world))
(world-segment world)))

; Move the worm in the current direction. Instead of changing the position of
; a single segment, now we add a segment to start of the worm (in the
; current direction) and get rid of the end of the worm
(define (move-worm worm direction)
(cons (new-segment (first worm) direction) (remove-last worm))
)

; helper method to DRY up code when calling this from a world object
(define (move-worm-helper world)
(move-worm (world-worm world) (world-direction world)))

; return a new segment moved in 'direction' from the segment passed in
(define (new-segment segment direction)
(make-segment (+ (segment-x-pos segment)
(* WORM-MOVE (direction-x direction)))
(+ (segment-y-pos segment)
(* WORM-MOVE (direction-y direction)))))

; remove the last worm segment. this is a pretty unoptimised function. just
; reverse the list, grab the rest of it, and reverse it again to get it the
; correct order.
(define (remove-last worm)
(reverse (rest (reverse worm))))

; This has changed for question 174 - we now need to check for food
; collisions on each clock tick.
; On each clock tick, move the world further in time. This is a new function
; that takes part of the responsibily of the old move-worm function. It just
; moves the worm and creates a new world based on it.
(define (progress-world world)
(eat-food
(make-world
(move-worm (world-worm world)
(world-direction world))
(world-direction world)
(world-segment world))
))

; handle keyboard events.
(define (handle-key-events ws ke)
(cond
[(string=? "left" ke) (change-direction ws LEFT)]
[(string=? "right" ke) (change-direction ws RIGHT)]
[(string=? "up" ke) (change-direction ws UP )]
[(string=? "down" ke) (change-direction ws DOWN)]
[else ws]
))

; create a new world with the direction the worm is travelling in changed.
(define (change-direction world direction)
(make-world (world-worm world) direction (world-segment world)))

; This is the big bang function that drives the game.
(define (worm-main rate)
(big-bang (make-world WORM
(make-direction 1 0)
(make-segment 300 100)
)
(to-draw show)
(stop-when collision-detected final-scene)
(on-key handle-key-events)
(on-tick progress-world rate) ))

; start the game off!
(worm-main 0.1)

# TESTS

; Test when we move the worm up, a new segment is added to the start and removed
; from the end.
(check-expect (move-worm WORM LEFT)
(list
(make-segment (- 100 WORM-MOVE) 100)
(make-segment 100 100)
(make-segment 100 80)))

; Check the remove-last function removes the last segment correctly
(check-expect (remove-last WORM)
(list (make-segment 100 100)
(make-segment 100 80)))

; Test that new segment returns a new segment in the correct position
; (as per the current direction)
(check-expect (new-segment (make-segment 100 100) UP)
(make-segment 100 (- 100 WORM-MOVE)))

; exceeding the bottom of the screen

;; Test our worm draws as we expect it.
(check-expect (draw-worm (empty-scene 200 200) WORM)
(place-image SEGMENT 100 100
(place-image SEGMENT 100 80
(place-image SEGMENT 100 60 (empty-scene 200 200)))))

; Test our worm moves in the direction we expect
(check-expect (move-worm (list (make-segment 50 50)) DOWN)
(list (make-segment 50 70)))
(check-expect (move-worm (list (make-segment 50 50)) UP)
(list (make-segment 50 30)))
(check-expect (move-worm (list (make-segment 50 50)) LEFT)
(list (make-segment 30 50)))
(check-expect (move-worm (list (make-segment 50 50)) RIGHT)
(list (make-segment 70 50)))

Exercise 173: Re-design your program so that it stops if the worm has run into the walls of the world or into itself.

2012-06-27T18:56:00.000-07:00

Re-design your program from exercise 172 so that it stops if the worm has run into the walls of the world or into itself. Display a message like the one in exercise 171 to explain whether the program stopped because the worm hit the wall or because it ran into itself.

Code for this exercise is available here.

Only fairly straight forward changes were required to accomodate this new iteration. Changes needed to be made to the collision-detection function and the final-scene function.

The collision-detection function now needs to check for both collisions with the wall and collisions with the tail of the worm. By breaking this method into two independent functions; one checking for wall collisions and one checking for tail collisions, I was able to re-use the code for the wall collisions in final-scene function for determining which message to display - either "You have hit the wall", or "You have hit yourself".

Although we have a multi-segmented worm now, the collision detection functions didn't need to be drastically modified as it only needs to check the head of the worm. We can just pop off the first segment and use this to check for collisions. For worm tail collisions we use the member? function as specified in the hint.

For the final-scene function the only change was to determine which message to display. As the collision-detection function only returns true or false we can't use this directly. By calling the indivdiual functions within this method (ie collision-detection-wall) we can determine the method. There is no need to check for collisions with the worm, as if the worm has collided with something and it was not the wall, then it must have collided with itself.

Code

; Constants

(define WORM-SIZE 10)
(define WORM-MOVE (* WORM-SIZE 2))
(define WIDTH 800) ; width of the game
(define HEIGHT 500) ; height of the game
(define SEGMENT (circle WORM-SIZE "solid" "red"))

; these structs hold the current list of worm segments, the direction
; the worm is travelling in, and our world object
(define-struct segment(x-pos y-pos))
(define-struct direction(x y))
(define-struct world(worm direction))
(define WORM (list (make-segment 100 100)
(make-segment 100 80)
(make-segment 100 60)) )

; To save repeating these directions in tests and code, we'll define them here
(define DOWN (make-direction 0 1))
(define UP (make-direction 0 -1))
(define RIGHT (make-direction 1 0))
(define LEFT (make-direction -1 0))

; Functions

; draw worm in its current location on the screen. This function recurses
; down our list of worm segments drawing each one at a time on to the background
; passed in
(define (draw-worm background worm)
(cond [(empty? worm) background]
[else (place-image
SEGMENT
(segment-x-pos (first worm)) (segment-y-pos (first worm))
(draw-worm background (rest worm))
)]))

This function has changed for this exercise so that instead of just checking for a collision with the wall, we check for a collision with the worm as well. This is accomplished by calling two separate collision functions - one for the wall, and one for the worm. The reason this has been split up is so that we can use the same function to determine which end of game message should be displayed. This function could be trivially extended to check for collisions with objects in the room.

; Check for collisions with either the walls or the rest of the worm.
; return true if collision detected, false otherwise
(define (collision-detected world)
(or
(collision-detected-wall (first (move-worm-helper world )))
(collision-detected-worm (first (move-worm-helper world))
(world-worm world ))))

; a helper function for checking for collision with the worm.
; This works by checking if area the worm would move into is already in the
; list of worm segments
; return true if collision detected, false otherwise
(define (collision-detected-worm segment worm)
(member? segment worm))

; a helper function for collision detection with the wall
; returns true if a collision is detected, false otherwise
(define (collision-detected-wall segment)
(cond [(> 0 (segment-x-pos segment)) true] ; exceeding left edge
[(> 0 (segment-y-pos segment)) true] ; exceeding top edge
[(< WIDTH (segment-x-pos segment)) true] ; exceeding right edge
[(< HEIGHT (segment-y-pos segment)) true] ; exceeding bottom edge
[else false]))

The final-scene method also changed for this exercise. To display the correct end of game message we need to determine if we've collided with the worm or the wall.
We can use the collision-detected-wall method to determine if the game finished because we hit the wall. If it didn't finish because of that, it must have finished because we hit the rest of the worm.

; Draw our final scene with the worm departing the board
; Displays a "Game Over" type message. We should probably be calculating the
; width and height of the image to calculate the offsets, but it's simpler just
; to arbitrarily put it somewhere in the bottom right of the screen
(define (final-scene world)
(draw-worm
(place-image (text
(cond ((collision-detected-wall
(first (move-worm-helper world )))
"worm hit border" )
(else "worm hit worm"))

20 "red")
(- WIDTH 100)
(- HEIGHT 50)
(empty-scene WIDTH HEIGHT))
(world-worm world)))

; Draws the current world. This consists of the snake and the food objects
(define (show world)
(draw-worm (empty-scene WIDTH HEIGHT) (world-worm world)) )

; Move the worm in the current direction. To move the worm we add a segment
; to start of the worm (in the current direction) and get rid of the end of
; the worm
(define (move-worm worm direction)
(cons (new-segment (first worm) direction) (remove-last worm)))

; helper method to DRY up code.
(define (move-worm-helper world)
(move-worm (world-worm world) (world-direction world)))

; returns a new segment moved in 'direction' from the segment
; passed in
(define (new-segment segment direction)
(make-segment (+ (segment-x-pos segment)
(* WORM-MOVE (direction-x direction)))
(+ (segment-y-pos segment)
(* WORM-MOVE (direction-y direction)))))

; remove the last worm segment. this is a pretty unoptimised function. just
; reverse the list, grab the rest of it, and reverse it again to get it the
; correct order.
(define (remove-last worm)
(reverse (rest (reverse worm))))

; On each clock tick, move the world further in time. It moves the worm
; and creates a new world based on this.
(define (progress-world world)
(make-world
(move-worm (world-worm world) (world-direction world))
(world-direction world)))

;; handle keyboard events.
(define (handle-key-events ws ke)
(cond
[(string=? "left" ke) (change-direction ws LEFT)]
[(string=? "right" ke) (change-direction ws RIGHT)]
[(string=? "up" ke) (change-direction ws UP )]
[(string=? "down" ke) (change-direction ws DOWN)]
[else ws]
))

; create a new world with the direction the worm is travelling in changed.
(define (change-direction world direction)
(make-world (world-worm world) direction))

; This is the big bang function that drives the game.
(define (worm-main rate)
(big-bang (make-world WORM
(make-direction 1 0))
(to-draw show)
(stop-when collision-detected final-scene)
(on-key handle-key-events)
(on-tick progress-world rate) ))

; start the game off!
(worm-main 0.1)

; TESTS

; Test when we move the worm up, a new segment is added to the start and removed
; from the end.
(check-expect (move-worm WORM LEFT)
(list
(make-segment (- 100 WORM-MOVE) 100)
(make-segment 100 100)
(make-segment 100 80)))

; Check the remove-last function removes the last segment correctly
(check-expect (remove-last WORM)
(list (make-segment 100 100)
(make-segment 100 80)))

; Test that new segment returns a new segment in the correct position
; (as per the current direction)
(check-expect (new-segment (make-segment 100 100) UP)
(make-segment 100 (- 100 WORM-MOVE)))

;; exceeding the bottom of the screen
;(check-expect (collision-detected (make-world
; (make-worm (- WIDTH 10) (+ HEIGHT 10)) RIGHT))
; true)
;; exceeding the right side of the scren
;(check-expect (collision-detected (make-world
; (make-worm (+ WIDTH 10) (- HEIGHT 10)) RIGHT))
; true)
;
;; exceeding the top of the screen
;(check-expect (collision-detected (make-world
; (make-worm -10 (- HEIGHT 10)) LEFT))
; true)
;; exceeding the left side of the screen
;(check-expect (collision-detected (make-world
; (make-worm (- WIDTH 10) -10) LEFT))
; true)
;
;;in the middle of the screen - should not collide
;(check-expect (collision-detected (make-world
; (make-worm (- WIDTH 10) (- HEIGHT 10)) LEFT))
; false)
;

;
;; Test our worm draws as we expect it.
(check-expect (draw-worm (empty-scene 200 200) WORM)
(place-image SEGMENT 100 100
(place-image SEGMENT 100 80
(place-image SEGMENT 100 60
(empty-scene 200 200)))))

; Test our worm moves in the direction we expect
(check-expect (move-worm (list (make-segment 50 50)) DOWN)
(list (make-segment 50 70)))
(check-expect (move-worm (list (make-segment 50 50)) UP)
(list (make-segment 50 30)))
(check-expect (move-worm (list (make-segment 50 50)) LEFT)
(list (make-segment 30 50)))
(check-expect (move-worm (list (make-segment 50 50)) RIGHT)
(list (make-segment 70 50)))

; Test our change-direction function changes the direction, but doesn't impact
; the postion
(check-expect (change-direction (make-world (make-segment 50 50) DOWN) UP)
(make-world (make-segment 50 50) UP))
(check-expect (change-direction (make-world (make-segment 50 50) DOWN) RIGHT)
(make-world (make-segment 50 50) RIGHT))