Exercise 171: Modify your worm program so that it stops at the edge of the world

Modify your program from exercise 170 so that it stops if the worm has run into the walls
of the world. When the program stops because of this condition, it should render the final scene with the text "worm hit border" in the lower left of the world scene. Hint: You can use the stop-when clause in big-bang to render the last world in a special way. Challenge: Show the worm in this last scene as if it were on its way out of the box.

Download the code from this post here.

To detect when the worm leaves the box we need to add some form of boundary or collision detection. There is a method in racket/base called image-inside which detects if one image is inside another. This could have been used to determine if the worm was still inside the box but as I didn't see this method until after I had completed my manual boundary detection my implementation doesn't use this. The lesson here is to know your API.

The difficulty involved in the "challenge" is that to show the worm leaving the box the collision detection needs to trigger before the collision occurs. If you don't detect the worm has left the game wold until after it is outside the boundaries then you need to either move the worm backwards after a collision, or forecast when the worm is going to collide.

I choose to forecast the worm collision. This meant the break up of the move-worm function into two separate functions - one that moved the worm, and one that composed a new world object. This allows a separate instance of the worm to be moved forward outside of the context of the world scene. Within the collision-detection function this separate instance of the worm is moved forward and checked see if it would have collided.

In hindsight I suspect that moving the worm backwards after a collision would have easier. This could have been done simply via a function that reverses the direction the worm was travelling and moving it one unit.

Changes from Exercise 170

The on-tick callback in the big-bang function has been changed to call a new function progress-world. The on-tick method previously moved the worm and composed a new world object. I now wanted to be able to move the worm from outside of the big-bang function. The reason for this to help with the 'challenge'  -  we can now call move-worm separately from within our collision detection function to enable us to forecast a future crash. This will leave our worm still on screen at the end of the game.

There is a new collision-detection function that will return true whenever it detects that the worm has hit the side of the box.

There is a new final-scene function that is called when the game is ended. This will display our Game Over text and draw the worm "leaving the playing area".

The big-bang function has been changed to:

• call the new progress-world function (instead of move-worm) 

• call collision-detection to determine when the worm has crashed

• call final-scene to draw the end game scene.

Code

; Constants

(define WORM-SIZE 10)
(define WORM-MOVE WORM-SIZE)
(define WIDTH 800)  ; width of the game

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

; 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))
(define HEIGHT 500) ; height of the game


; Functions 

; draw worm in its current location on the screen
(define (draw-worm background worm)
  (place-image (circle WORM-SIZE "solid" "red") 
               (worm-x-pos worm) (worm-y-pos worm) background))
    
; check if the snake has hit the edge of the world.
; return true if collision detected, false otherwise
(define (collision-detected world)
  (collision-detected-helper (move-worm world)))

; helper function for collision detection. Operates directly
; on a worm, rather than world object.
(define (collision-detected-helper worm)
 (cond [(> 0        (worm-x-pos worm)) true]  ; exceeding left edge
        [(> 0       (worm-y-pos worm)) true]  ; exceeding top edge
        [(< WIDTH   (worm-x-pos worm)) true]  ; exceeding right edge
        [(< HEIGHT  (worm-y-pos worm)) 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 "worm hit border" 20 "red")
                (- WIDTH 100)
                (- HEIGHT 50)
                (empty-scene WIDTH HEIGHT))
   (world-worm world)))

; Draws the current world. Currently this just consists of the snake.
(define (show world)
  (draw-worm (empty-scene WIDTH HEIGHT) (world-worm world)))

; Move the worm in the current direction. 
; This function is called on each clock tick and moves the worm in the 
; last direction that was pressed. It is also called from collision-detection
; to determine where the worm will be next turn.
(define (move-worm world)
   (make-worm  (+ (worm-x-pos (world-worm world)) 
                  (* WORM-MOVE (direction-x (world-direction world))))
               (+ (worm-y-pos (world-worm world)) 
                  (* WORM-MOVE (direction-y (world-direction world))))))

; 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)
   (make-world
    (move-worm  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 (make-worm (/ WIDTH 2)  (/ HEIGHT 2))
                        (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)


; ### NEW TESTS ###

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


; ### OLD TESTS

; Test our worm draws as we expect it.
(check-expect (draw-worm (empty-scene 100 100) (make-worm 50 50))
              (place-image (circle WORM-SIZE "solid" "red") 50 50 (empty-scene 100 100)))

; Test our worm moves in the direction we expect
(check-expect (move-worm (make-world (make-worm 50 50) DOWN))
              (make-worm 50 60))
(check-expect (move-worm (make-world (make-worm 50 50) UP))
              (make-worm 50 40))
(check-expect (move-worm (make-world (make-worm 50 50) LEFT))
              (make-worm 40 50))
(check-expect (move-worm (make-world (make-worm 50 50) RIGHT))
              (make-worm 60 50))

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

Exercise 170: Design an interactive GUI rogram that continually moves a one-segment worm...

 Design an interactive GUI program that continually moves a one-segment worm and enables a player to control the movement of the worm with the four cardinal arrow keys. Your program should use a red disk to render the one-and-only segment of the worm. For each clock tick, the worm should move diameter.

Download the complete source for this article here.


I  enjoyed this exercise - it was interesting to see how to develop this question. The main difficulty I faced was finding concise documentation on how the big-bang function works. This is the main function that drives these "world" exercises. It's heavily documented within the racket documentation, but in a very dry manner that just lists the individual methods, but doesn't describe clearly how to put every thing together. With the HTDP2e book, it's documented well, but in a very scattered manner over several chapters. Eventually I found  this pdf (provided by the same authors) that gave much in the way of needed detail.

The concept I was missing was the 'world' data structure provided by the first argument to big-bang. This is the main  'world scene' object -  a data structure containing the dynamic (changing) aspects of the game world. This is passed automatically into each of the given callback functions you supply (along with possibly other arguments) and is expected to be returned from each of these functions - possibly with a new world state.

As this is a functional program, we are not changing this world data structure, but rather  creating an entirely new representation of the world each time.

Game constraints and constants

We make the worm size configurable here and when we move the worm it will be by the amount specified. The hints provided in the question suggest two different means to keep track of the worm - via a physical or logical location and suggests that one of these may be easier than the other in terms of changing the size of the worm or the game board. They both seem fairly similar to me in this regard, but I have chosen a physical representation as it seems much easier in terms of drawing the wold. The logical position would need to be converted back to a physical position at the time of drawing.

(define WORM-SIZE 10)
(define WORM-MOVE WORM-SIZE)


(define WIDTH 800)  ; width of the game
(define HEIGHT 500) ; height of the game


; this struct will hold the current position of the struct. I imagine later 
; on it will end up holding a list of the tail of the worm
(define-struct worm(x-pos y-pos))


; a struct to hold the direction the worm currently moving in. 
(define-struct direction(x y))


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

This is a key struct - this is our world data-structure and will be passed around to all the functions so that they can take appropriate action and modify the world as needed. Currently it just holds the worm position and direction, but later it will hold the positions of the worm food.

(define-struct world(worm direction))

Functions 

; This function draws a worm in its current location on the screen
(define (draw-worm background worm) 
  (place-image (circle WORM-SIZE "solid" "red") 
               (worm-x-pos worm) 
               (worm-y-pos worm) 
   background)) 





; This draws the current world. Currently it is just drawing the worm but this 
; will probably be extended to drawing other things such as food and obstacles.
(define (show world)
  (draw-worm (empty-scene WIDTH HEIGHT) (world-worm world)) )






The move-worm function is called on each clock tick and moves the worm in the last direction that was pressed. This function takes in a world and returns  a new world with the worm moved along the current direction. The direction doesn't need to change so isn't changed. To determine the new position of the worm, we multiply our direction for both the x and the y axis by the distance the worm should move and add this to the current position. As this x and y vector will be either -1, 0 or 1, this will either subtract, leave unchanged or add the worm travel distance to the  current position.



; This functions takes in a world and constructs a new world with the worm
; moved along the current direction.

(define (move-worm world)
  (make-world 
   (make-worm  (+ (worm-x-pos (world-worm world)) 
                              (* WORM-MOVE (direction-x (world-direction world))))
                (+ (worm-y-pos (world-worm world)) 
                              (* WORM-MOVE (direction-y (world-direction world)))))
   (world-direction world)))




The handle-key-events functions handles keyboard events. This is a very simple function that just calls the change-direction function with a new direction vector. This returns the new world state as returned by change-direction.


; Handle key board events and return a new world state.
(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]
  ))




The change-direction function creates a new world with the direction the worm is travelling in changed to represent the key just pressed. This function doesn't do much - it just creates a new world struct and returns it. This could have been done in the handle-key-events function, but having a named function for it makes things clearer.


; Return a new world with the direction changed to match the direction passed in.
(define (change-direction world  direction)  
  (make-world (world-worm world) direction)) 




The worm-main function is the function that will start our game running. It calls the big-bang function with the initial state of the world, and details the call-back functions required to make the game work.
The initial state of our world is an empty scene with a worm stationed in the center moving to the right. We supply:

•  a function show that will draw our world as it currently stands
•  a function handle-key-events that will change the direction the worm is travelling
•  a function on-tick that will move the worm one unit in the current direction on each game tick

(define (worm-main rate)
  (big-bang (make-world (make-worm (/ WIDTH 2)  (/ HEIGHT 2))
                        (make-direction 1 0))
            (to-draw show) 
            (on-key handle-key-events)
            (on-tick move-worm rate) ))




This start the game off! 10 movements a second seems to provide a reasonable speed for the current worm/world size


(worm-main 0.1)

Tests

; Test our worm draws as we expect it.
(check-expect (draw-worm (empty-scene 100 100) (make-worm 50 50))
              (place-image (circle WORM-SIZE "solid" "red") 50 50 (empty-scene 100 100)))
   


; Test our worm moves in the direction we expect
(check-expect (move-worm (make-world (make-worm 50 50) DOWN))
              (make-world (make-worm 50 60) DOWN))
(check-expect (move-worm (make-world (make-worm 50 50) UP))
              (make-world (make-worm 50 40) UP))
(check-expect (move-worm (make-world (make-worm 50 50) LEFT))
              (make-world (make-worm 40 50) LEFT))
(check-expect (move-worm (make-world (make-worm 50 50) RIGHT))
              (make-world (make-worm 60 50) RIGHT))


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

Exercise 169: Look up the documentation for explode and implode.

Exercise 169: Look up the documentation for explode and implode. 

Then formulate the function arrange-main, which consumes a String and produces all of its possible re-arrangements as a list of Strings.

This is a straight forward question. The method  implode will transform a (listof string) -> string) and explode will do the reverse. This will save us from needing to pass in a list of 1strings into the arrange method, and will present the rearranged letters as simple list of strings instead of a list of lists of strings.

Exploding the string being passed into arrange-main is a simple matter. However imploding the resulting list of strings is not - or at least it is not within the context of arrange-main. This is because by the time we get the list, it is already a list of lists of strings.

Imploding them within the arrange method when we have access to the individual lists of strings would be a simple matter, but that was not what was asked for.  Instead, we need to create a helper method that will then iterate over our list of lists of strings and implode them one by one.

; a simple test method. Most of the testing is done already 
; within the context of the arrange method.
(check-expect (arrange-main "cat")
              (list "tac" "tca" "cta" "atc" "act" "cat"))

; This method simply explodes the string passed in so that it can be 
; processed by arrange, and the passes the result into imploder-helper
; to implode the individual lists of strings.
;
; String -> List-of-Strings
(define (arrange-main string)
 (implode-helper (arrangements (explode string)) empty))


; This method takes in a complete list of lists of stings and an
; initially empty list-of-strings and implodes each list-of-strings
; and appends it to the end of the list-of-strings. 
;
; list-of-lists-of-strings, list-of-strings -> list-of-strings
(define (implode-helper list-of-lists list-of-strings)
  (cond ((empty? list-of-lists) list-of-strings)
        (else (implode-helper (rest list-of-lists) 
                              (cons (implode (first list-of-lists)) 
                                              list-of-strings)))))

Exercise 168

The code below is from exercise 168 and is only included as it is required to run the code above. The tests and documentation for the following code is detailed within the context of that exercise.

(define (arrangements w)
  (cond
    [(empty? w) (list empty)]
    [else (insert-everywhere/in-all-words (first w)
            (arrangements (rest w)))]))




(define (insert-everywhere/in-all-words letter words)
  (cond ((empty? words) empty)
        (else (append
               (insert letter (list empty (first words)) empty)
               (insert-everywhere/in-all-words letter (rest words))))))







(define (insert letter word-lists combinations)
  (cond ((empty? (second word-lists)) (append combinations  
                                              (ins-middle letter word-lists)))
        (else (insert letter
                      (progress-list word-lists)
                      (append combinations (ins-middle letter word-lists))))))




(define (progress-list word-lists)
  (list
   (append (first word-lists) (list (first (second word-lists))))
   (cond ((empty? (rest (second word-lists))) empty)
         (else   (rest (second word-lists))))))

(define (ins-middle letter word-lists)
  (cond ((empty? (first word-lists)) (list (cons letter (second word-lists))))
        (else (list (append (first word-lists) 
                            (list letter)  
                            (second word-lists) empty)))))

Exercise 168: Design insert-everywhere/in-all-words.

Exercise 168:  Design insert-everywhere/in-all-words.

It consumes a 1String and a list of words. The result is a list of words like its second argument, but with the first argument inserted at the beginning, between all letters, and at the end of all words of the given list.

Note: I've taken a slightly different approach to structuring this answer. As this is a reasonably complex question (at least compared to that which has been asked so far), there are a larger than normal number of functions. There are five supporting functions, which is not overly large number in itself, but as each function has a number of check-expect test functions to support, the signal-to-noise ratio became quite high. I have moved all of the check-expect functions to the end of the answer, and briefly described the point of each test there. This allows me to keep the main section of the answer uncluttered and a little easier to read

I'm not 100% happy with the approach I took to this solution. It seemed a clean solution in my head but when it came time to put it into code form it became a lot more complex. There is probably a solution out there that is a cleaner than this.

The problem we have is to take a list of letters, and return a new list of lists of letters with our new letter inserted into each place.  Helper functions aside, the main problem is to create a function that will take in a list and a letter, and return a new list with the letter inserted between each letter of the original list. I have called this function insert. In this function we need to recurse through the original word, letter by letter,  creating a new word by inserting the letter in the appropriate place and appending all these new words together.  The challenge here is as we recurse, we need to keep track of both the entire word that we are inserting the letter into, but also where in the word we should be inserting into.

Solving this procedurally with something like Ruby or Python would be very straight forward, but we need to come up with a way of doing this in a functional manner.  I could think of two ways of doing this:

1. Passing in an insertion position/count as you recurse through the word
2. Splitting the list into two - a before and after split, and changing the position of the split as you recurse.

The second option seemed a better idea, though in hindsight, I think passing a position down would have been easier.

Choosing the second option introduced new problems - maintaining this new list. I chose to wrap these before and afters lists up in a new list so that I could pass around only one list, instead of continually passing both lists. To simplify the main function I also required a function dedicated to moving the split in these two lists along. None of these issues were particularly difficult, but I think they could have been avoided altogether by choosing the first option.

Solution

The arrangements function here is taken directly from the text. It recurses through a word building up a list of subwords using the insert-everywhere/in-all-words helper function.

; 1String -> List-of-words
(define (arrangements w)
  (cond
    [(empty? w) (list empty)]
    [else (insert-everywhere/in-all-words (first w)
            (arrangements (rest w)))]))



The insert-everywhere/in-all-words function is the main function that we are asked to create - but does very little of the actual work.
It consumes a letter and a list of words and creates a new expanded list of words with the supplied letter inserted at each point within each word.
The work is mostly farmed out to the helper function insert which for a specific letter and word combination, returns a new list of words with the letter correctly inserted in each place. These lists are then appended together to form a larger list containing the combinations for each word passed in in the original list.

; Letter List of Words -> List of Words
(define (insert-everywhere/in-all-words letter words)
  (cond ((empty? words) empty)
        (else (append
               (insert letter (list empty (first words)) empty)
               (insert-everywhere/in-all-words letter (rest words))))))



The insert function does the actual inserting of the letter into the word. This function takes in three arguments - the letter to insert, a list containing the two sections of the word it should be inserting this letter between, and the expanded list of words with the letter already inserted. This last argument will have the newly created arrangement appended to it and will be the value returned.
The idea here is that we are passing two lists - list1 and list2, each containing a section of the word. The boundaries of the word sections in this list will be adjusted each time. Eg, in pseudo-code, inserting the letter X in the word "dog":


X (list nil dog) ->  (list d og)    (list Xdog)
X (list d og)    ->  (list do g)    (list Xdog dXog)
X (list do g)    ->  (list dog nil) (list Xdog dXog doXg)
X (dog nil)      ->  (list dog nil) (list Xdog dXog doXg dogX)


;insert the letter between word1 and word2 (parts of the same word)
; Letter, List-of-1Strings,  
(define (insert letter word-lists combinations)
  (cond ((empty? (second word-lists)) (append combinations  
                                              (ins-middle letter word-lists))) 
        (else (insert letter 
                      (progress-list word-lists)
                      (append combinations (ins-middle letter word-lists)))))) 





To simplify the insert function I have another helper function progress-list that does nothing other than move the split in the two words one character further along. There is no reason we couldn't have done this within the insert function, but moving it out here makes the insert function a lot shorter and easier to read.

; takes in list of two words segments (eg, a word split in two) and
; moves the split further down the list
; (list "wor" "d") -> (list "wo" "rd")
; list-of-words -> list-of-words
(define (progress-list word-lists)
  (list
   ; when we pull the first letter of the second word-list it's no longer a list
   ; to append it correctly, we need to use cons, or turn it back into a list
   (append (first word-lists) (list (first (second word-lists))))
   ; if we're at the end of the second-word list return an empty list
   ; rather than a list containing an empty list
   (cond ((empty? (rest (second word-lists))) empty)
         (else   (rest (second word-lists))))
  ))


The second helper function created to support insert is the ins-middle function. This function takes in a letter and a list of two word sections, and returns a new word with the letter inserted in the middle of the two lists.
Eg:

X (list empty "dog") -> Xdog
X (list "d" "og")    -> dXog


The letter is passed in simply as a character, not as  part of a list, so to use append we need to make it a list. we could use cons here, but that is so . .. messy

We also wrap what we are returning in a list. This isn't necessary, but this is a helper function for the main insert function which is more complex. The insert function requires the returned word to be part of a list already, (or it needs to convert the word to a list there). If we do not do this  all the words will get munged into one long word. By double wrapping the list here, we can make the main insert function shorter and a little clearer.


; letter list-of-1strings -> list-of-lists-of-1strings
(define (ins-middle letter word-lists)
  (cond ((empty? (first word-lists)) (list (cons letter (second word-lists))))
        (else (list (append (first word-lists)
                            (list letter) 
                            (second word-lists) empty)))))

Example Output

Finally, here is an example output of our arrangement function:


> (arrangements (list "w" "o" "r" "d"))
(list
 (list "w" "o" "r" "d")
 (list "o" "w" "r" "d")
 (list "o" "r" "w" "d")
 (list "o" "r" "d" "w")
 (list "w" "r" "o" "d")
 (list "r" "w" "o" "d")
 (list "r" "o" "w" "d")
 (list "r" "o" "d" "w")
 (list "w" "r" "d" "o")
 (list "r" "w" "d" "o")
 (list "r" "d" "w" "o")
 (list "r" "d" "o" "w")
 (list "w" "o" "d" "r")
 (list "o" "w" "d" "r")
 (list "o" "d" "w" "r")
 (list "o" "d" "r" "w")
 (list "w" "d" "o" "r")
 (list "d" "w" "o" "r")
 (list "d" "o" "w" "r")
 (list "d" "o" "r" "w")
 (list "w" "d" "r" "o")
 (list "d" "w" "r" "o")
 (list "d" "r" "w" "o")
 (list "d" "r" "o" "w"))

Tests for arrangements function

; a simple test of the functions behavior overall using a 3 letter list
(check-expect (arrangements (list "c" "a" "t"))
              (list
               (list "c" "a" "t")
               (list "a" "c" "t")
               (list "a" "t" "c")
               (list "c" "t" "a")
               (list "t" "c" "a")
               (list "t" "a" "c")))


; an arranged empty list should be an empty list
(check-expect (arrangements empty)
              (list empty))


; an arranged list of 1 char, should be a list of 1 list containing 1 char
(check-expect (arrangements (list "c"))
              (list (list "c")))

Tests for insert-everywhere/in-all-words function

; this is a subset of the arrangements test. A single list should
; rearrange as expected.
(check-expect (insert-everywhere/in-all-words "X" (list (list "d" "e")))
              (list (list "X" "d" "e")
                    (list "d" "X" "e")
                    (list "d" "e" "X")))


; test for an empty list - just returns an empty list
(check-expect (insert-everywhere/in-all-words "X" empty)
              empty)




; one word list
(check-expect (insert-everywhere/in-all-words "X" (list (list "e")))
                  (list (list "X" "e")
                        (list "e" "X")))

Tests for insert function

; this is a subset of the arrangements test. A single list should
; rearrange as expected.
(check-expect (insert "x" (list empty (list "c" "a" "t")) empty)
              (list (list "x" "c" "a" "t")
                    (list "c" "x" "a" "t")
                    (list "c" "a" "x" "t")
                    (list "c" "a" "t" "x")))

Tests for progress-list function

; "" "cat" -> "c" "at"
(check-expect (progress-list (list empty (list "c" "a" "t") ))
              (list (list "c") (list "a" "t")))


; "ca" "t" -> "cat" ""
(check-expect (progress-list (list (list "c" "a") (list "t" )))
              (list (list "c" "a" "t") empty))


No point testing this function with a empty second list as you can't progress this list any further - you would expect this to fail.

Tests for ins-middle function

; "x" "ca" "t"  -> "caxt"
(check-expect (ins-middle "x" (list (list "c" "a") (list "t")))
              (list (list "c" "a" "x" "t")))


; "x "" "cat" -> "xcat"
(check-expect (ins-middle "x" (list empty (list "c" "a" "t")))
              (list (list "x" "c" "a" "t" )))




; "x" "cat" "" -> "cat"
(check-expect (ins-middle "x"  (list (list "c" "a" "t") empty))
              (list (list  "c" "a" "t" "x")))

Exercise 167: Write down the data definition for List-of-words.

Systematically make up examples of Words and List-of-words. Finally, formulate the functional example from above with check-expect.  Instead of working with the full example, you may wish to start with a word of just two letters, say "d" and "e".

 A Word is either
 – empty or
 – (cons 1String Word)

I think this is the correct data definition for a List-of-words. It is either an empty list, or a Word cons'd together with another List-of-words (which may itself be an empty word)

; A List-of-words is either
; - empty or
; (cons Word List-of-words)



For our examples we will create two Words - "word" and "roger".  There is a 1String function we could use to do this but for practice I'm using cons directly.

(define word (cons "w" (cons "o" (cons "r" (cons "d" empty)))))  
(define roger (cons "r" (cons "o" (cons "g" (cons "e" (cons "r" empty))))))


Now an example List-of-words containing these two words:
(define list-of-words (cons word (cons roger empty))) 


For testing this example we will create a 1String for the string "de"
(define de (cons "d" (cons "e" empty)))


Now a check-expect to test all arrangements of the word "de".
This will be failing at this time as we haven't implemented the arrangements function yet.
(check-expect (arrangements de)
              (cons (cons (cons "d" (cons "e" empty))
                    (cons "e" (cons "d" empty)))
                     empty))

Exercise 166: Modify connect-dots so that it consumes an additional Posn structure ...

Exercise 166: Modify connect-dots

Modify connect-dots so that it consumes an additional Posn structure to which the last Posn is connected.
Then modify render-poly to use this new version of connect-dots. Note: this new version is called an accumulator version.

This is perhaps not the ideal way to solve this question but I believe it is doing what has been asked.
It seems a little odd as it is defined as an "accumulator" version which normally means the answer
'accumulates' (or changes) as you recurse up or down the stack. In this case our accumulator remains unchanged and is used simply as a means to draw the link back to the original posn.

When we reach the end of the list of posns instead of returning an empty scene element to draw the rest of the polygon onto, I am returning an image with this last link already drawn in. The rest of the function is exactly the same, with the exception that we are passing our final-posn all the way down the stack.

; NELoP -> Image
; connect the Posns in p
(define (connect-dots p final-posn)
  (cond
    [(empty? (rest p)) (render-line MT final-posn (first p) )]
    [else
      (render-line
  (connect-dots (rest p) final-posn) (first p) (second p) )]))

We need to change the way we call connect-dots to take into account our new function signature. instead of wrapping an additional render-line around the call to connect-dots, we pass back in the first posn in the list so that connect-dots knows where to attach the last posn back to.

; Polygon -> Image
; add the Polygon p into an image in MT
(define (render-polygon p)
  (connect-dots p (first p)))


; check our rendering of a list of triangle is sane
(check-expect
  (render-polygon
    (list (make-posn 20 0) (make-posn 10 10) (make-posn 30 10)))
  (add-line
    (add-line
      (add-line MT 20 0 10 10 "red")
      10 10 30 10 "red")
    30 10 20 0 "red"))




; check our rendering of a square is sane
(check-expect
  (render-polygon
    (list (make-posn 10 10) (make-posn 20 10)
          (make-posn 20 20) (make-posn 10 20)))
  (add-line
    (add-line
      (add-line
        (add-line MT 10 10 20 10 "red")
        20 10 20 20 "red")
      20 20 10 20 "red")
    10 20 10 10 "red"))


The following supporting code is copied directly from the book.



(require 2htdp/image)


; A Polygon is one of:
; – (list Posn Posn Posn)
; – (cons Posn Polygon)


(define MT (empty-scene 50 50))




; A NELoP is one of:
; – (cons Posn empty)
; – (cons Posn NELoP)






; Image Posn Posn -> Image
; draw a red line from Posn p to Posn q into im
(define (render-line im p q )
  (add-line
    im (posn-x p) (posn-y p) (posn-x q) (posn-y q) "red"))


; NELoP -> Posn
; extract the last Posn from p
(define (last p)
  (cond
    [(empty? (rest (rest (rest p)))) (third p)]
    [else (last (rest p))]))

Exercise 165: Two more ideas for defining render-poly

Exercise 165: Here are two more ideas for defining render-poly

1. render-poly could cons the last item of p onto p and then call connect-dots.
2. render-poly could add the first item of p to the end of p via a version of add-at-end that works on Polygons.

Use both ideas to define render-poly; make sure both definitions pass the test cases.

1)   This solution here seems a very natural way to do this. In my view it makes it more clear that you are completing the loop in order to make the polygon complete.

; Polygon -> Image
; add the Polygon p into an image in MT
(define (render-polygon1 p)
   (connect-dots (cons (last p) p)))


2)   This also seems fairly natural. The only downside to this method is the (trivial) requirement for the definition of the add-to-end method.  Contrary to what the question may indicate, the version of add-to-end given works perfectly for posns already.

; Polygon -> Image
; add the Polygon p into an image in MT
(define (render-polygon2 p)
  (connect-dots (add-at-end p (first p) )))


The add-to-end function below is taken directly from earlier in the chapter. The only change I have made is to the variable names to better indicate what they are doing in this context. This has no bearing on how the function works and I was almost hesitant to even change them. Years of having to enforce descriptive variable names on colleagues at work forced my hand though. I may need to break this habit if I'm going to write scheme like a native schemer!

; LoP Posn -> Posn
; Concatenates a Posn on to the end of a List Of Posns
(define (add-at-end list posn)
  (cond
    [(empty? list) (cons posn empty)]
    [else (cons (first list) (add-at-end (rest list) posn))]))

; test we can draw a triangle
(check-expect
  (render-polygon2
    (list (make-posn 20 0) (make-posn 10 10) (make-posn 30 10)))
  (add-line
    (add-line
      (add-line MT 20 0 10 10 "red")
      10 10 30 10 "red")
    30 10 20 0 "red"))


; test we can draw a square
(check-expect
  (render-polygon2
    (list (make-posn 10 10) (make-posn 20 10)
          (make-posn 20 20) (make-posn 10 20)))
  (add-line
    (add-line
      (add-line
        (add-line MT 10 10 20 10 "red")
        20 10 20 20 "red")
      20 20 10 20 "red")
    10 20 10 10 "red"))


Everything below here is taken direct from the example answer.


(require 2htdp/image)
; A Polygon is one of:
; – (list Posn Posn Posn)
; – (cons Posn Polygon)


(define MT (empty-scene 50 50))


; Polygon -> Image
; add the Polygon p into an image in MT
(define (render-polygon p)
  (render-line (connect-dots p) (first p) (last p)))


; A NELoP is one of:
; – (cons Posn empty)
; – (cons Posn NELoP)


; NELoP -> Image
; connect the Posns in p
(define (connect-dots p)
  (cond
    [(empty? (rest p)) MT]
    [else
      (render-line
        (connect-dots (rest p)) (first p) (second p))]))


; Image Posn Posn -> Image
; draw a red line from Posn p to Posn q into im
(define (render-line im p q)
  (add-line
    im (posn-x p) (posn-y p) (posn-x q) (posn-y q) "red"))


; NELoP -> Posn
; extract the last Posn from p
(define (last p)
  (cond
    [(empty? (rest (rest (rest p)))) (third p)]
    [else (last (rest p))]))