Before you begin, here are a few things to keep in mind:
First and foremost, DON'T PANIC!. The exam may look long, but you have six hours, and you'll find that some problems that take a long time to describe will not take a long time to solve, especially if you heed the advice we give below.
We recommend that you read through the entire exam before beginning, so that you can figure out how best to spend your time.
Each section of each problem will be annotated with the number of marks that the section is worth, in boldface type.
There are some useful Scheme functions listed at the end of the exam. Also, you can consult the Scheme reference documentation here if you need to look up the definition of a built-in Scheme function.
If you run out of time, remember that you can always "draw a line" in your answers and indicate that that was when you ran out of time, and then you can continue. We may award partial credit for answers done after the exam is over. However, don't overdo it: if you find you need to spend more than one extra hour, you're probably wasting your time and should just hand in what you have.
In this section we will implement a simple scheduling calender. It will keep track of appointments and the current time, allow the user to retrieve the next appointment, remove specific appointments and add new ones.
[0.5] First you must implement a function called
make-appointment, which creates a new appointment object.
(Note: This isn't a message-passing object! There are no
message-passing objects in part A of this exam. We'll cover them in part C.)
It takes a date/time object created by the function make-date
(see below), a name (a symbol), and a description (a string), and puts them
together into a list with the tag
'appointment at the front of the list.
You should also create the accessors get-date,
get-name and get-description that return the
appropriate part from an appointment object. Prototypes (skeletons) for these
functions are given below, as well as example usage. Also write the
function make-date, which takes one argument (a string
representing the date and time) and returns a list containing the
symbol 'date and the date/time string that was passed to it).
You do not need to do any error checking on the inputs.
Function prototypes:
(define (make-appointment date name description) ...) (define (get-date appointment) ...) (define (get-name appointment) ...) (define (get-description appointment) ...) (define (make-date date-string) ...)
Examples:
(define a (make-appointment (make-date "Sep 22 2008 14:50") 'birthday "Party at my place")) a ;; ==> (appointment (date "Sep 22 2008 14:50") birthday "Party at my place") (define b (make-appointment (make-date "Apr 15 2008 12:00") 'taxday "Make sure taxes are sent in")) b ;; ==> (appointment (date "Apr 15 2008 12:00") taxday "Make sure taxes are sent in") (get-name a) ;; ==> birthday (get-date a) ;; ==> (date "Sep 22 2008 14:50") (get-description a) ;; ==> "Party at my place"
[0.5] Next we need to write the constructor
make-schedule which returns a schedule object (again, not a
message-passing object). It should take only a current date (made using the
make-date function you just wrote) and return a list containing
the tag 'schedule, the current date, and a list of appointments
(which should start out empty). The list of appointments will eventually
contain appointments ordered by their date and time.
You should also write the accessor functions get-current-date,
and get-appointment-list, which return the appropriate parts of
a schedule object.
Function prototypes:
(define (make-schedule current-date) ...) (define (get-current-date schedule) ...) (define (get-appointment-list schedule) ...)
Example:
(define my-schedule (make-schedule (make-date "Dec 8 2007 01:30"))) my-schedule ;; ==> (schedule (date "Dec 8 2007 01:30") ()) (get-current-date my-schedule) ;; ==> (date "Dec 8 2007 01:30") (get-appointment-list my-schedule) ;; ==> ()
[1.5] Now that we can create an empty schedule, we need to be
able to add appointments to it. You should now write
add-appointment-to-schedule!, which takes an appointment and a
schedule, and inserts the appointment into the schedule's list of
appointments. Furthermore, the insertion should be sorted based on the
appointment's date and time, with the earlier appointments coming first. You
can assume there exists a function date-comes-before? that takes
two date objects (as defined above) and returns #t if the first date/time
comes before the second, and #f otherwise.
NOTE: Make sure that you use the abstraction layer you defined above wherever appropriate instead of directly manipulating the list structures of the objects which contain the data. Of course, if you need to do something that requires that you manipulate the list structure directly, you can, but don't do it when an accessor already exists that does the same thing.
Function prototype:
(define (add-appointment-to-schedule! appointment schedule) ...)
Example: (recall a and b were defined above)
(define c (make-appointment (make-date "Dec 15 2007 15:00") 'flight "Plane flight home")) (add-appointment-to-schedule! c my-schedule) my-schedule ;; ==> (schedule ;; (date "Dec 8 2007 01:30") ;; ((appointment (date "Dec 15 2007 15:00") flight "Plane flight home"))) (add-appointment-to-schedule! a my-schedule) my-schedule ;; ==> (schedule ;; (date "Dec 8 2007 01:30") ;; ((appointment (date "Dec 15 2007 15:00") flight "Plane flight home") ;; (appointment (date "Sep 22 2008 14:50") birthday "Party at my place"))) (add-appointment-to-schedule! b my-schedule) my-schedule ;; ==> (schedule ;; (date "Dec 8 2007 01:30") ;; ((appointment (date "Dec 15 2007 15:00") flight "Plane flight home") ;; (appointment (date "Apr 15 2008 12:00") taxday "Make sure taxes are sent in") ;; (appointment (date "Sep 22 2008 14:50") birthday "Party at my place")))
[0.5] Now you need to write change-current-date!,
which takes a schedule and a new date, and updates that schedule's current
date to the new date.
Function prototype:
(define (change-current-date! schedule new-date) ...)
Example:
(change-current-date! my-schedule (make-date "Dec 15 2007 16:00")) my-schedule ;; ==> (schedule ;; (date "Dec 15 2007 16:00") ;; ((appointment (date "Dec 15 2007 15:00") flight "Plane flight home") ;; (appointment (date "Apr 15 2008 12:00") taxday "Make sure taxes are sent in") ;; (appointment (date "Sep 22 2008 14:50") birthday "Party at my place")))
[1.0] Next you need to write a function which can remove
appointments from a schedule based on the appointment's name. After all,
appointments get rescheduled. delete-appointment-from-schedule!
should take an appointment's name (a symbol), and the schedule it should be
removed from. The function should delete the appointment with the given name
from the schedule and return the appointment that got removed, or signal an
error (using the error procedure) if there were no appointments
with that name. You may assume that there will be at most one appointment
with a particular name.
NOTE: Again, use your abstraction layer where appropriate.
Function prototype:
(define (delete-appointment-from-schedule! appt-name schedule) ...)
Example:
(delete-appointment-from-schedule! 'toast my-schedule) ;; ==> ERROR! appointment not found in schedule (delete-appointment-from-schedule! 'taxday my-schedule) ;; ==> (appointment (date "Apr 15 2008 12:00") taxday "Make sure taxes are sent in")) my-schedule ;; ==> (schedule ;; (date "Dec 15 2007 16:00") ;; ((appointment (date "Dec 15 2007 15:00") flight "Plane flight home") ;; (appointment (date "Sep 22 2008 14:50") birthday "Party at my place")))
[1.0] Now we need a way of getting the next appointment after
the current date. Write a function get-next-appointment which
takes a schedule and returns the first appointment in that schedule which is
after the schedule's current date, or #f otherwise. [Note that
the schedule can contain appointments before the current date, because we
haven't said that it couldn't.] You should still assume that you have the
function date-comes-before?, which takes two date objects and
returns #t if the first date comes before the second, and #f
otherwise. If there are multiple appointments at the same date, you should
return the first one.
NOTE: Again, use your abstraction layer where appropriate.
Function prototype:
(define (get-next-appointment schedule) ...)
Example:
(get-next-appointment my-schedule) ;; ==> (appointment (date "Sep 22 2008 14:50") birthday "Party at my place") (change-current-date! my-schedule (make-date "Dec 15 2007 12:00")) (get-next-appointment my-schedule) ;; ==> (appointment (date "Dec 15 2007 15:00") flight "Plane flight home")
[1.0] Finally, you need to
write remove-old-appointments!, a function that takes a schedule
and removes all the appointments in it that are before the current date
stored in the schedule.
NOTE: Again, use your abstraction layer where appropriate.
Function prototype:
(define (remove-old-appointments! schedule) ...)
Example:
(remove-old-appointments! my-schedule) my-schedule ;; ==> (schedule ;; (date "Dec 15 2007 12:00") ;; ((appointment (date "Dec 15 2007 15:00") flight "Plane flight home") ;; (appointment (date "Sep 22 2008 14:50") birthday "Party at my place"))) ;; Nothing got removed as the current date is before all the appointments. (change-current-date! my-schedule (make-date "Dec 15 2007 16:00")) (remove-old-appointments! my-schedule) my-schedule ;; ==> (schedule ;; (date "Dec 15 2007 16:00") ;; ((appointment (date "Sep 22 2008 14:50") birthday "Party at my place")))
End of part A.
Draw environment diagrams that result from evaluating each of these blocks
of code. Draw the diagram representing the environment at the end of
the computation, except that you should leave all intermediate frames in your
drawing (even if you know they would be discarded as temporaries at the end
of the computation). You do not need to draw any frames for primitive
function application, where "primitive" means any function already built into
Scheme. If a function body is too long, you do not need to try to fit all of
it into your diagram; one or two lines and an ellipsis ("...")
will more than suffice. Also, please make your diagrams neat and
readable; unreadable or barely-readable diagrams will lose marks.
Make sure you write out all lists in box-and-pointer form, and not the way
Scheme would print them i.e.. don't write a list as (1 2 3
4); write out the box-and-pointer version of this. There aren't any
long lists in these problems anyway.
A useful tip: when you create a new frame (other than the global
environment), write the piece of code that caused the frame to be created
immediately above the frame (using ellipses ("...") if the code
is too large, of course). Usually this will be a function call or a
let expression. Doing this will help you organize your work.
This is not a requirement, but we recommend it.
[2.0]
(define (f x y) (* y (g x y)))
(define (g x y)
(if (< x y)
(* (- y x) 2)
(g (/ x 2) (+ y 5))))
(f 16 10)
[2.0]
(define (make-container maxweight)
(let ((items (list))
(weight 0.0))
(lambda (op . args)
;; add-item takes two arguments, an item and its weight
(cond ((eq? op 'add-item)
(let ((item (car args))
(item-weight (cadr args)))
(cond ((< (+ weight item-weight) maxweight)
(set! items (cons (car args) items))
(set! weight (+ weight (cadr args))))
(else (error "Too much weight!")))))
((eq? op 'get-items) items)
((eq? op 'get-weight) weight)
(else (error "Invalid op: " op))))))
(define bag (make-container 5.0))
(bag 'add-item 'book 2.1)
(bag 'add-item 'muffin 0.1)
(bag 'get-weight)
[2.0]
(define (f g x)
(let ((x (cdr x))
(f (lambda (y)
(g y)
(set! x y))))
(f x))
x)
(f (lambda (x) (set-cdr! x (cddr x)))
(list 1 2 3 4))
End of part B.
If you're like most of us nerds, you've probably spent way too many hours playing FreeCell on your computer, even when your Mom or your friends told you that you should stop wasting your time. Little did they know that one day your hard-earned FreeCell knowledge would prove critical to your doing well on the CS 1 final! In this section you'll implement a message-passing version of the FreeCell game in Scheme.
If you like, you are allowed to turn your stopwatch off and go to this site to familiarize yourself with the game of FreeCell. If you don't know what playing cards are, you might want to also look here. The game uses a standard deck of 52 playing cards, ranked from ace to king (13 ranks) in four suits (spades, hearts, diamonds, clubs).
NOTE: Because the full code for this program is somewhat long,
we've made your job much easier by providing a lot of the code either
pre-written for you, or else we've just left it out and you're allowed to
assume that it's been written and works correctly. In this section we're not
so interested in your prowess at list processing (we tested that in part A)
as in your ability to build programs using abstractions. The code you need
to write will be marked with ellipses ("...") where the code is
supposed to go, as well as the word TODO in comments. You
should replace the "..."s with your own code (also please remove
the word TODO from the comments once you've filled in your
code).
Since there is a lot of template code in this problem, we would prefer it if you don't waste time copying and pasting the code from a web browser window into your text editor. Therefore, we've prepared a template file which you can download here (or you can cut-and-paste it if you really want to). It contains the skeleton solutions for all three parts of this problem. You can just add your code to the code we provide.
We will break this problem down into three different message-passing objects. The first one will represent a playing card. The second one will represent a deck of cards. The final one will represent the FreeCell game itself.
The first message-passing object you will create will be an
object which represents a single playing card in a FreeCell game. Recall
that there are 52 playing cards, and each playing card has two attributes:
its "rank" and its "suit". Ranks go from 1 to 13, though certain ranks have
special names (1 is called an "ace", 11 is called a "jack", 12 is called a
"queen" and 13 is called a "king"). We will just use the numbers 1 through
13 as our ranks except when displaying the card. The suits are called
"spades", "hearts", "diamonds" and "clubs". We will represent them as the
Scheme symbols
's, 'h, 'd and 'c
respectively.
The message-passing version of a playing card must respond to these messages:
'display : takes no arguments, and prints a
representation of the card to the terminal.
'rank : takes no arguments, and returns the rank of
the card as a number between 1 and 13.
'suit : takes no arguments, and returns the suit
of the card as a Scheme symbol (either 's, 'h,
'd or 'c)
'color : takes no arguments, and returns the color
of the card (either 'red or 'black). Note that the
color is a function of the suit; the spades and clubs suits are colored black
while the hearts and diamonds suits are colored red.
'goes-below? : takes one argument (another card
object) and returns #t if the current card can go below the
other card on a FreeCell board, or otherwise returns #f. For
the card to go below the other card it must be exactly one rank lower and
have the opposite color.
'next-in-suit? : takes one argument (another card
object) and returns #t if the current card has the same suit as
the other card but has a rank exactly one higher (which means it's the next
card in that suit), or otherwise returns #f.
The 'goes-below? and 'next-in-suit? messages
will be very useful in part 3 of this section (the FreeCell game), so you'll
want to use them in the code in that section.
The constructor function of the playing card object is
called make-freecell-card and takes two arguments: an integer
between 1 and 13 representing a rank and a symbol
(either 's, 'h, 'd
and 'c) representing the suit. It returns the message-passing
object.
Example usage:
(define 5s (make-freecell-card 5 's)) ;; 5 of spades (define 6h (make-freecell-card 6 'h)) ;; 6 of hearts (define 6s (make-freecell-card 6 's)) ;; 6 of spades (define 4h (make-freecell-card 4 'h)) ;; 4 of hearts (5s 'display) ;; prints "5s" (6h 'display) ;; prints "6h" (6s 'display) ;; prints "6s" (4h 'display) ;; prints "4h" (5s 'goes-below? 6h) ;; ==> #t, since 5 = 6 - 1 and s and h have different colors (5s 'goes-below? 6s) ;; ==> #f (same suit, both are spades) (5s 'goes-below? 4h) ;; ==> #f (5 doesn't go below 4) (6s 'next-in-suit? 5s) ;; ==> #t (6s is the next spade after 5s)
Skeleton solution:
This object is quite simple in that none of code for any of the messages
requires any mutation. In addition, we've filled in the code for
the 'display message and some of the trivial helper functions so
you can concentrate on the important stuff.
(define (make-freecell-card rank suit)
(define (valid-rank? r) (and (> r 0) (< r 14)))
(define (valid-suit? r)
(or (eq? suit 's)
(eq? suit 'h)
(eq? suit 'd)
(eq? suit 'c)))
(define (valid-card?)
(and (valid-rank? rank) (valid-suit? suit)))
(define (rank-to-print rank)
(cond ((= rank 1) " A")
((= rank 10) "10")
((= rank 11) " J")
((= rank 12) " Q")
((= rank 13) " K")
((or (< rank 1) (> rank 13)) (error "invalid rank!"))
(else (string-append " " (number->string rank)))))
(define (display-card)
(display (rank-to-print rank))
(display suit))
;; you can add other helper functions here if you like
(if (not (valid-card?))
(error "invalid card!")
(lambda (op . args)
(cond ((eq? op 'display) (display-card))
((eq? op 'rank) ...) ;; TODO
((eq? op 'suit) ...) ;; TODO
((eq? op 'color) ...) ;; TODO
((eq? op 'goes-below?) ...) ;; TODO
((eq? op 'next-in-suit?) ...) ;; TODO
(else (error "unknown operation: " op))))))
Our next object is a message-passing object which represents a
randomly-shuffled deck of 52 cards. The cards themselves are the cards
created by the make-freecell-card procedure in the previous
problem. The constructor function is called make-deck. It
takes no arguments and returns the deck of cards message-passing object. The
object itself responds to these three messages:
'ncards : takes no arguments and returns the
number of cards remaining in the deck.
'reshuffle! : takes no arguments, creates a new
internal list of 52 distinct cards and randomly shuffles them. Resets the
internal variables containing the list of cards and the total number of cards
remaining. Returns the Scheme symbol 'done.
'get-cards! : takes one argument, which is a
non-negative integer. Returns a list of that many cards taken from the front
of the deck (those cards are removed from the deck). Also adjusts the
internal variable representing the total number of cards remaining. Signals
an error using the error procedure if there aren't enough cards
left in the deck.
Example usage:
(define d (make-deck)) (d 'ncards) ;; ==> 52 (define list-of-two-cards (d 'get-cards 2)) (d 'ncards) ;; ==> 50 ;; Assume that the first card is the ten of diamonds, and the second card ;; is the ace of spades. (define first-card (car list-of-two-cards)) (define second-card (cadr list-of-two-cards)) (first-card 'display) ;; ==> "10d" (second-card 'display) ;; ==> "As"
Skeleton solution:
Most of this object's implementation is provided for you (which is why this question is only worth one mark). Use the helper functions and writing the code for the two messages will be very easy.
(define (make-deck)
;; Some helper functions provided for you:
;; Return a full deck of 52 cards: 1 to 13 (A to K) in four suits.
(define (full-deck)
;; the clever way; brute force would also work
(apply append
(map (lambda (rank)
(map (lambda (suit)
(make-freecell-card rank suit))
'(s h d c)))
(list 1 2 3 4 5 6 7 8 9 10 11 12 13))))
;; Shuffle a list of objects randomly.
(define (shuffle lst)
(if (null? lst)
lst
; take a random element from a list...
(let ((first (list-ref lst (random (length lst)))))
; and cons it to the shuffled rest of the list.
(cons first (shuffle (remq first lst))))))
;; Return the first n elements of a list, or as many as you can if there
;; are fewer than n elements. n should be >= 0.
(define (take n lst)
(if (or (null? lst) (= n 0))
(list)
(cons (car lst) (take (- n 1) (cdr lst)))))
;; Return a list without the first n elements, or the empty list if there
;; are fewer than n elements. n should be >= 0.
(define (drop n lst)
(if (or (null? lst) (= n 0))
lst
(drop (- n 1) (cdr lst))))
(let ((cards (shuffle (full-deck)))
(ncards-left 52))
(lambda (op . args)
(cond ((eq? op 'ncards) ...) ;; TODO
((eq? op 'reshuffle!) ...) ;; TODO
((eq? op 'get-cards!) ...) ;; TODO
(else (error "unknown operation: " op))))))
Finally, we come to the FreeCell game itself. This is a fairly
complicated object, but most of the code has been written for you, or else
you can assume that it has been written (like the display code). The
downside of this is that you are going to have to read a lot of code (and a
lot of description of the game), but you won't have to write that much code.
Again, the code you need to write is indicated by the "..."s in
the code and the word TODO in the comments. The total amount of
code you need to write is about 50 lines in our solution.
While writing the code, it's very important to use the helper
functions provided in your solution. The helper functions provide an
abstraction layer which will make it easy to write the rest of the
code. In the code you have to write, you don't need to
use set!, set-car!, set-cdr!, or
even cons, car or cdr at all! If
you think you do, you aren't using the helper functions correctly.
Description of the game:
A full description of the game can be found here (you can turn your stopwatch off and go read it if you like). We'll summarize the rules below.
FreeCell is a solitaire card game played with a normal deck of 52 cards. The cards are shuffled and dealt face up to eight vertical columns; the leftmost four columns have 7 cards to start with and the others have six. These card columns are called the "board". In addition to the board, there are four "free cell" spaces which start off empty, and four "foundation" columns, one for each of the four suits. The goal of the game is to move all 52 cards to the foundation columns.
Each move of the game consists of moving a single card in any of these five ways:
Most FreeCell programs also allow you to move several cards in a column at once under some circumstances, but such moves can always be done as a series of one-card moves. Our program will only handle one-card moves.
Not all cards can be moved in all situations. Here are the rules governing which moves are allowed.
You can always move a card from the end of a board column to a free cell. However, there are only four free cells, so if they are all occupied you can't move any more cards to free cells unless you vacate one of the free cells first.
You can always move a card from the end of a board column to an empty board column (one with no cards).
You can move a card from the end of a board column to the end of a non-empty board column if the card being moved has a rank one lower than the rank of the last card in the column being moved to, and if the card being moved has a different color (red/black) than the last card in the column being moved to. So you can move the 5 of hearts to the end of a column whose last card is the 6 of spades or the 6 of clubs, but not to the end of any other non-empty column.
You can move a card from the end of a board column to the end of a foundation column if either (a) the card is an ace (i.e. its rank is 1) and the foundation column is empty, or (b) if there is a foundation column whose last card has the same suit as the card being moved but is one rank less. So you could move the 5 of hearts to the foundation if the hearts column of the foundation has the 4 of hearts as its last card.
You can always move a card from a free cell to an empty board column. If the board column isn't empty, then again the last card in the column has to be one rank higher and a different color than the card being moved for the move to be allowed. So if the 5 of hearts is on a free cell, you can move it to an empty board column or to a column ending in the 6 of spades or the 6 of clubs.
You can move a card from a free cell to a foundation column if either (a) the free cell card is an ace and the foundation column is empty, or (b) the last card in the foundation column has the same suit as the free cell card and is one rank lower. So if the free cell card is the 5 of hearts and the hearts column on the foundation has the 4 of hearts as its last card, you can move the 5 of hearts to the end of that column.
These are the only moves you can make. Play continues until all the cards have been moved to the foundation (which is a win) or until no more moves are possible but there are still cards on the board and/or on free cells (which is a loss).
Description of the internal data structures:
We represent a FreeCell game as a message-passing object. Inside the message-passing object there are three data structures which represent the state of the game:
The FreeCell board is represented by a list of card columns. Each card column is a list of cards. Each card is a message-passing object (defined in the part 1 of this section). As the game progresses, cards will be removed from some card columns and added to other card columns. The "end" of a board column (i.e. the last card) is considered to be the first item in the list, not the last (the code is more efficient that way). Initially, four of the columns have 7 cards and the rest have 6 cards, giving 52 cards in all. Card columns are identified by their position (index) in the list of card columns; the first column is at position 0, the second is at position 1, and so on up to the last column, which is at position 7.
The free cells are represented by a list of cards which starts off empty. This list's length should never get larger than 4, since there are only four freecells. Free cells are identified by their position in the freecell list, so the first card (if any) is at position 0, etc. Note that when cards are removed from the free cell list, the index positions of other cards on the free cell list can change.
The foundations are represented by four lists of cards which all start off empty. Each list contains the cards for exactly one suit, in ascending order. New cards are added to the ends of the lists (not the front; this is different from the board columns). When displayed, only the last card of each suit of the foundation is shown.
Description of messages:
This object responds to seven messages. The description of these messages
looks complicated but it's actually not; however, make sure you read this
description carefully. All of these messages should return the Scheme
symbol 'done when they're finished, which means they really
don't return anything; they work purely by mutating the data structures in
the object.
'display : takes no arguments and displays the
game. All the cards of the board columns are displayed, as well as all the
cards in the freecells. Only the last card in the foundation columns are
displayed. See below for the exact appearance of the display, but note that
you don't need to write the code for this message.
'new-game : takes no arguments, reshuffles the
cards and re-initializes all the data structures to their starting
values. You don't need to write the code for this message either.
'move-col->col : takes two arguments (integers)
representing the indices of two card columns on the board. Each index can
range from 0 to 7. Move a card from the end of the card column corresponding
to the first index to the end of the card column corresponding to the second
index. So 'move-col->col 0 2 would remove the last card from
board column 0 and put it at the end of board column 2. This is only allowed
if the first card (the card at the end of column 0 in our example) can go
below the second card (the card at the end of column 2 in our example), or if
the second column is empty (make sure you check for this!). A card can go
below another card if its rank is one less than the other card and if it's of
the opposite color. So, for instance, the 6 of hearts could go below the 7
of spades but not the 8 of spades or the 7 of diamonds. The code should
signal an error if the move is invalid.
'move-col->free : takes one argument (an integer)
representing the index of a card column on the board. Remove the last card
of that column and put it at the front of the freecell list. Signal an error
if the list is full i.e. if the length of the list is 4.
'move-col->foundation : takes one argument (an
integer) representing the index of a card column on the board. Remove the
last card of that board column and put it at the end of the foundation column
for that card's suit. Signal an error if the move is invalid i.e. if
the last card on the foundation column for that suit doesn't have a rank
exactly one less than the card being moved. So if you tried to move the 4 of
spades from a board column to the foundation column containing spades, and
the last spade on that foundation column is the 2 of spades, it's an error
because 4 isn't 2 + 1. However, if the last spade on the foundation column
is the 3 of spades the move is accepted, and the spade column in the
foundation will then have the 4 of spades at the end.
'move-free->col : takes two arguments (integers);
the first represents a position (index) in the freecell list, while the
second represents the index of a card column on the board. Remove the card
at the specified index of the freecell list and put it at the end of the
card column. Again, this is only valid if the freecell card can go at the
end of the card column, or if the card column is empty. Signal an error if
the move is invalid.
'move-free->foundation : takes one argument (an
integer) which represents a position (index) in the freecell list. Remove
the card at the specified index of the freecell list and put it at the end of
the foundation column for that card's suit. Signal an error if the move is
invalid (for the same reasons we discussed in the case of
the 'move-col->foundation message).
Example usage:
(define f (make-freecell-game)) (f 'display) ;; Note that the columns are displayed as rows; it was easier to write the ;; code that way. The top of a column is displayed as the leftmost position ;; of a row, and the bottom of a column is displayed as the rightmost ;; position of a row. Only the cards at the bottoms of columns (rightmost ;; positions of rows) can be moved. We also display the positions (indices) ;; of the columns at the left hand end of the columns; this makes it easier ;; to figure out what moves you can make (we do the same for freecells). ;; COLUMNS: ;; ;; 0> 6d 3d 7h 6c 6h As 9s ;; 1> Qd 4h Js Qc 9d Ac 3s ;; 2> 10d 2h Jc 4c 7s Ad Ks ;; 3> 2d Jd 5s Ah 5h 5c 7c ;; 4> Qh 4d 9h 8c 9c 2c ;; 5> 5d 3c 10s 10h 4s 10c ;; 6> 3h 6s Kd 7d 8s Jh ;; 7> 8h Kc Qs 8d Kh 2s ;; ;; FREE CELLS: ;; ;; ;; FOUNDATIONS: ;; ;; > empty ;; > empty ;; > empty ;; > empty (f 'move-col->col 5 6) (f 'display) ;; COLUMNS: ;; ;; 0> 6d 3d 7h 6c 6h As 9s ;; 1> Qd 4h Js Qc 9d Ac 3s ;; 2> 10d 2h Jc 4c 7s Ad Ks ;; 3> 2d Jd 5s Ah 5h 5c 7c ;; 4> Qh 4d 9h 8c 9c 2c ;; 5> 5d 3c 10s 10h 4s ;; 6> 3h 6s Kd 7d 8s Jh 10c ;; 7> 8h Kc Qs 8d Kh 2s ;; ;; FREE CELLS: ;; ;; ;; FOUNDATIONS: ;; ;; > empty ;; > empty ;; > empty ;; > empty (f 'move-col->free 2) (f 'display) ;; COLUMNS: ;; ;; 0> 6d 3d 7h 6c 6h As 9s ;; 1> Qd 4h Js Qc 9d Ac 3s ;; 2> 10d 2h Jc 4c 7s Ad ;; 3> 2d Jd 5s Ah 5h 5c 7c ;; 4> Qh 4d 9h 8c 9c 2c ;; 5> 5d 3c 10s 10h 4s ;; 6> 3h 6s Kd 7d 8s Jh 10c ;; 7> 8h Kc Qs 8d Kh 2s ;; ;; FREE CELLS: ;; ;; 0> Ks ;; ;; FOUNDATIONS: ;; ;; > empty ;; > empty ;; > empty ;; > empty (f 'move-col->foundation 2) (f 'display) ;; COLUMNS: ;; ;; 0> 6d 3d 7h 6c 6h As 9s ;; 1> Qd 4h Js Qc 9d Ac 3s ;; 2> 10d 2h Jc 4c 7s ;; 3> 2d Jd 5s Ah 5h 5c 7c ;; 4> Qh 4d 9h 8c 9c 2c ;; 5> 5d 3c 10s 10h 4s ;; 6> 3h 6s Kd 7d 8s Jh 10c ;; 7> 8h Kc Qs 8d Kh 2s ;; ;; FREE CELLS: ;; ;; 0> Ks ;; ;; FOUNDATIONS: ;; ;; > empty ;; > empty ;; > Ad ;; > empty (f 'move-col->free 1) (f 'move-col->foundation 1) (f 'display) ;; COLUMNS: ;; ;; 0> 6d 3d 7h 6c 6h As 9s ;; 1> Qd 4h Js Qc 9d ;; 2> 10d 2h Jc 4c 7s ;; 3> 2d Jd 5s Ah 5h 5c 7c ;; 4> Qh 4d 9h 8c 9c 2c ;; 5> 5d 3c 10s 10h 4s ;; 6> 3h 6s Kd 7d 8s Jh 10c ;; 7> 8h Kc Qs 8d Kh 2s ;; ;; FREE CELLS: ;; ;; 0> 3s ;; 1> Ks ;; ;; FOUNDATIONS: ;; ;; > empty ;; > empty ;; > Ad ;; > Ac (f 'move-col->free 1) (f 'move-col->foundation 4) (f 'display) ;; COLUMNS: ;; ;; 0> 6d 3d 7h 6c 6h As 9s ;; 1> Qd 4h Js Qc ;; 2> 10d 2h Jc 4c 7s ;; 3> 2d Jd 5s Ah 5h 5c 7c ;; 4> Qh 4d 9h 8c 9c ;; 5> 5d 3c 10s 10h 4s ;; 6> 3h 6s Kd 7d 8s Jh 10c ;; 7> 8h Kc Qs 8d Kh 2s ;; ;; FREE CELLS: ;; ;; 0> 9d ;; 1> 3s ;; 2> Ks ;; ;; FOUNDATIONS: ;; ;; > empty ;; > empty ;; > Ad ;; > 2c (f 'move-free->col 0 6) (f 'display) ;; COLUMNS: ;; ;; 0> 6d 3d 7h 6c 6h As 9s ;; 1> Qd 4h Js Qc ;; 2> 10d 2h Jc 4c 7s ;; 3> 2d Jd 5s Ah 5h 5c 7c ;; 4> Qh 4d 9h 8c 9c ;; 5> 5d 3c 10s 10h 4s ;; 6> 3h 6s Kd 7d 8s Jh 10c 9d ;; 7> 8h Kc Qs 8d Kh 2s ;; ;; FREE CELLS: ;; ;; 0> 3s ;; 1> Ks ;; ;; FOUNDATIONS: ;; ;; > empty ;; > empty ;; > Ad ;; > 2c (f 'move-col->free 0) (f 'move-col->foundation 0) (f 'display) ;; COLUMNS: ;; ;; 0> 6d 3d 7h 6c 6h ;; 1> Qd 4h Js Qc ;; 2> 10d 2h Jc 4c 7s ;; 3> 2d Jd 5s Ah 5h 5c 7c ;; 4> Qh 4d 9h 8c 9c ;; 5> 5d 3c 10s 10h 4s ;; 6> 3h 6s Kd 7d 8s Jh 10c 9d ;; 7> 8h Kc Qs 8d Kh 2s ;; ;; FREE CELLS: ;; ;; 0> 9s ;; 1> 3s ;; 2> Ks ;; ;; FOUNDATIONS: ;; ;; > As ;; > empty ;; > Ad ;; > 2c (f 'move-col->foundation 7) (f 'move-free->foundation 1) (f 'display) ;; COLUMNS: ;; ;; 0> 6d 3d 7h 6c 6h ;; 1> Qd 4h Js Qc ;; 2> 10d 2h Jc 4c 7s ;; 3> 2d Jd 5s Ah 5h 5c 7c ;; 4> Qh 4d 9h 8c 9c ;; 5> 5d 3c 10s 10h 4s ;; 6> 3h 6s Kd 7d 8s Jh 10c 9d ;; 7> 8h Kc Qs 8d Kh ;; ;; FREE CELLS: ;; ;; 0> 9s ;; 1> Ks ;; ;; FOUNDATIONS: ;; ;; > 3s ;; > empty ;; > Ad ;; > 2c ;; And so on...
Skeleton solution:
Note that most of the code is already pre-written for you. Just copy it into your exam solution and add the parts you need to add (marked TODO).
(define (make-freecell-game)
;; ------------------------------------------------------------
;; Helper functions which don't depend on the state variables.
;; ------------------------------------------------------------
;; Return a list of lists of cards, representing the columns on the
;; FreeCell board. The first four columns start off with 7 cards,
;; while the last four start off with 6 cards.
(define (deal-columns)
(let ((deck (make-deck)))
(list (deck 'get-cards! 7) ;; ok to do this since order of evaluation
(deck 'get-cards! 7) ;; is unimportant to final result
(deck 'get-cards! 7)
(deck 'get-cards! 7)
(deck 'get-cards! 6)
(deck 'get-cards! 6)
(deck 'get-cards! 6)
(deck 'get-cards! 6))))
;; Take a list, a non-negative integer index n, and a value and return
;; a new list with that value at the nth position in the list.
(define (list-replace lst n val)
(cond ((< n 0) (error "invalid index into list: " n))
((= n 0) (cons val (cdr lst)))
(else
(cons (car lst) (list-replace (cdr lst) (- n 1) val)))))
;; Take a list and a non-negative integer index n, and return a new list
;; which is the same as the old list except that the nth item in the old
;; list has been removed.
(define (list-remove lst n)
(cond ((< n 0) (error "invalid index into list: " n))
((= n 0) (cdr lst))
(else
(cons (car lst) (list-remove (cdr lst) (- n 1))))))
;; Return the last item in a list.
(define (list-last lst)
(cond ((null? lst) (error "no last element"))
((null? (cdr lst)) (car lst))
(else (list-last (cdr lst)))))
;; Is the column number valid? Only column numbers from 0 to 7 are valid.
(define (valid-column-number? n)
(or (>= n 0) (< n 8)))
;; Return an integer value corresponding to a given suit symbol.
(define (suit-number suit)
(cond ((eq? suit 's) 0)
((eq? suit 'h) 1)
((eq? suit 'd) 2)
((eq? suit 'c) 3)
(else "unknown suit: " suit)))
;; ------------------------------------------------------------
;; State variables.
;; ------------------------------------------------------------
(let ((columns (deal-columns))
(freecells (list))
(foundations (list (list) (list) (list) (list))))
;; ------------------------------------------------------------
;; Helper functions which depend on the state variables.
;; ------------------------------------------------------------
;; Re-initialize the state variables for a new game.
(define (new-game!)
(set! columns (deal-columns)) ;; list of lists of cards
(set! freecells (list)) ;; empty list of cards
(set! foundations (list (list) (list) (list) (list)))
;; four empty lists of cards, one per suit
'done)
;; Display the game on the terminal.
(define (display-game)
;; assume this has been written and works correctly
)
;; Get the column (list of cards) corresponding to a particular column
;; number.
(define (get-column column-number)
(if (valid-column-number? column-number)
(list-ref columns column-number)
(error "invalid column number: " column-number)))
;; Change the column at a particular column number to a new list of
;; cards.
(define (set-column! column-number col)
(if (valid-column-number? column-number)
(set! columns (list-replace columns column-number col))
(error "invalid column number: " column-number)))
;; Return the last card in a column, or 'none if the column is empty.
;; We represent the last card of a column (i.e. the end of the column)
;; as the first item in the list.
(define (last-in-column column-number)
(let ((old-col (get-column column-number)))
(if (null? old-col)
'none
(car (get-column column-number)))))
;; Add a card to the end of a column. No error checking.
(define (add-to-column! column-number card)
(set-column! column-number (cons card (get-column column-number))))
;; Remove the last card in a column.
(define (remove-last-in-column! column-number)
(let ((old-col (get-column column-number)))
(if (null? old-col)
(error "no cards in column: " column-number)
(set-column! column-number (cdr old-col)))))
;; Add a card to the list of cards on free cells.
;; No error checking.
(define (add-to-freecells! card)
(set! freecells (cons card freecells)))
;; Get the card at the nth position in the freecell list.
(define (get-freecell n)
(if (or (< n 0) (>= n (length freecells)))
(error "invalid index or no card at index: " n)
(list-ref freecells n)))
;; Remove the card at the nth position in the freecell list.
(define (remove-freecell! n)
(if (or (< n 0) (>= n (length freecells)))
(error "invalid index or no card at index: " n)
(set! freecells (list-remove freecells n))))
;; Get the list of cards in the foundation corresponding to a particular suit.
(define (get-foundation-suit suit)
(list-ref foundations (suit-number suit)))
;; Get the last card in a particular suit on the foundation.
(define (last-in-foundation suit)
(let ((sf (get-foundation-suit suit)))
(if (null? sf)
'none
(list-last sf))))
;; Add a card to the foundation suit for a particular suit.
(define (add-to-foundation-suit! suit card)
(let ((sf (get-foundation-suit suit))
(sn (suit-number suit)))
(if (null? sf)
(set! foundations (list-replace foundations sn (list card)))
(set! foundations (list-replace foundations sn (append sf (list card)))))))
;; ------------------------------------------------------------
;; Message-passing object.
;; ------------------------------------------------------------
;; HINT: We've given suggestions about roughly how many lines of code
;; you should be writing for each message. None of our code is tricky,
;; but it all uses the helper functions extensively, which is the
;; key to making it concise. If you feel like you need to write
;; a lot more code, you're probably not using the helper functions
;; enough. Also, note that some error checking is done by the helper
;; functions, so if you use them correctly you will have less error
;; checking to do here.
(lambda (op . args)
(cond ((eq? op 'display) ;; display the game
(display-game))
((eq? op 'new-game) (new-game!)) ;; initialize a new game
;; Move a card from one column on the board to another column.
;; The columns are identified by numeric indices.
;; Signal an error if the move is invalid.
((eq? op 'move-col->col)
(let ((col-number1 (car args))
(col-number2 (cadr args)))
;; TODO; can be done in less than 10 lines of code
...))
;; Move a card from a column on the board (indicated by the numeric
;; index of the column) to the freecell list.
;; Signal an error if there are no more freecells (i.e. the list
;; is full).
((eq? op 'move-col->free)
(let ((col-number (car args)))
;; TODO; can be done in less than 10 lines of code
...))
;; Move a card from a column on the board (indicated by the numeric
;; index of the column) to the foundation.
;; Signal an error if the move is invalid.
((eq? op 'move-col->foundation)
(let ((col-number (car args)))
;; TODO; can be done in less than 20 lines of code
...))
;; Move a card from a freecell to a column. The freecell and the
;; column are indicated by numeric indices.
;; Signal an error if the move is invalid.
((eq? op 'move-free->col)
(let ((free-number (car args))
(col-number (cadr args)))
;; TODO; can be done in less than 10 lines of code
...))
;; Move a card from a freecell to a column. The freecell is
;; indicated by a numeric index.
;; Signal an error if the move is invalid.
((eq? op 'move-free->foundation)
(let ((free-number (car args)))
;; TODO; can be done in less than 20 lines of code
...))
(else (error "unknown operation: " op))))))
End of part C.
remq: (remq item lst) returns a list which
is a copy of the list lst except that the first element
in lst which is eq? to item is removed
from the list that is returned.
length: (length lst) returns the length of
the list lst.
apply: (apply f args) applies a function
f to a list of arguments args. So
(apply + '(1 2 3 4 5)) is the same as (+ 1 2 3 4
5).
map: (map f lst) applies a function
f to each element of a list lst and accumulates the
results in a new list. So (map (lambda (x) (* x x)) '(1 2 3 4
5)) gives (1 4 9 16 25).
list-ref: (list-ref lst n) returns the
nth element of the list lst, or signals an error if
there is no such element. Note that the indexing starts with n =
0, so the car of the list is the 0th element.
(End of final.) Have a relaxing winter break!