1. Define a Scheme procedure that takes a natural number as argument and
returns a list containing the specified number of distinct
three-letter strings in which the first letter is chosen randomly from the
set bdfghjklmnprstvz, the second from the set
aeiou, and the third from the set
bdfgklmnprstvxz.
(require 'random)
(define random-char
(lambda (str)
(string-ref str (random (string-length str)))))
(define sample
(lambda (n)
(let loop ((remaining n)
(so-far '()))
(if (zero? remaining)
so-far
(let ((trial (string (random-char "bdfghjklmnprstvz")
(random-char "aeiou")
(random-char "bdfgklmnprstvxz"))))
(if (member trial so-far)
(loop remaining so-far)
(loop (- remaining 1)
(cons trial so-far))))))))
2. Suppose we represent a playing card as a pair in which the left field
is one of the four symbols spade, heart, diamond, club and the right field
is an integer in the range from 1 (= ace) to 13 (= king). Define a Scheme
procedure fresh-pack of arity 0 that returns a vector of
fifty-two distinct playing cards.
(define fresh-pack
(lambda ()
(let ((suits '(spade heart diamond club))
(result (make-vector 52)))
(do ((index 0 (+ index 1)))
((= index 52) result)
(vector-set! result index
(cons (list-ref suits (quotient index 13))
(+ (remainder index 13) 1)))))))
3. Let a vector of fifty-two distinct playing cards be called a
pack. Here is a Scheme procedure that shuffles a given pack
(destructively). Note that it is invoked for its side effect only:
(define shuffle!
(lambda (vec)
(let ((len (vector-length vec)))
(do ((index (- len 1) (- index 1)))
((zero? index))
(let* ((swap-slot (random (+ index 1)))
(temp (vector-ref vec swap-slot)))
(vector-set! vec swap-slot (vector-ref vec index))
(vector-set! vec index temp))))))
Write a non-destructive version of this procedure. (That is, write a
procedure that creates a new, shuffled pack containing the same cards as
the given pack, without changing the given pack.)
(define shuffle
(lambda (vec)
(let* ((len (vector-length vec))
(result (make-vector len)))
(do ((index 0 (+ index 1)))
((= index len) result)
(let ((swap-slot (random (+ index 1))))
(vector-set! result index (vector-ref result swap-slot))
(vector-set! result swap-slot (vector-ref vec index)))))))
4. Provide destructive and non-destructive implementations of the
operation of cutting a pack of cards. (More formally: Define a Scheme
procedure cut! that takes as arguments a vector
vec and an integer n in the range from 0 to the
length of the vector and rearranges the elements of vec so
that the elements previously in positions greater than or equal to
n are at the left end of the vector and those previously in
positions less than n are at the right end. Within each
segment, the elements should keep the same relative order. Then define a
Scheme procedure cut that does not change vec,
but instead constructs and returns a new vector with the same elements as
vec, but arranged in the order described above.) First, here's the destructive version:
(define cut!
(lambda (vec n)
(let ((len (vector-length vec)))
(vector-reverse! vec 0 n)
(vector-reverse! vec n len)
(vector-reverse! vec 0 len))))
(define vector-reverse!
(lambda (vec start stop)
(do ((left-index start (+ left-index 1))
(right-index (- stop 1) (- right-index 1)))
((<= right-index left-index))
(let ((temp (vector-ref vec left-index)))
(vector-set! vec left-index (vector-ref vec right-index))
(vector-set! vec right-index temp)))))
And here is the non-destructive one:
(define cut
(lambda (vec n)
(let* ((len (vector-length vec))
(result (make-vector len)))
(do ((source-index (if (= n 52) 0 n)
(if (= source-index (- len 1))
0
(+ source-index 1)))
(result-index 0 (+ result-index 1)))
((= result-index len) result)
(vector-set! result result-index (vector-ref vec source-index))))))
5. Define a Scheme procedure that takes a string as argument and returns
a randomly constructed anagram of that string -- a new string containing
the same characters, but randomly permuted.
This is an easy modification of the shuffle procedure.
(define random-anagram
(lambda (str)
(let* ((len (string-length str))
(result (make-string len)))
(do ((index 0 (+ index 1)))
((= index len) result)
(let ((swap-slot (random (+ index 1))))
(string-set! result index (string-ref result swap-slot))
(string-set! result swap-slot (string-ref str index)))))))
6. The Twenty-One Bell three-wheeled slot machine, c. 1973, had twenty
symbols on each wheel, as follows:
space first wheel second wheel third wheel ------------------------------------------------------------------------ 1 orange cherry bell 2 melon plum orange 3 plum cherry plum 4 cherry 7 and orange bell 5 plum cherry orange 6 orange bell lemon 7 7 plum and bar bell 8 bell and bar bell melon and orange 9 orange cherry bell 10 cherry orange plum 11 bar bell lemon 12 plum melon and orange bell 13 orange plum plum 14 plum bell bell 15 melon cherry 7 and bar 16 plum bar lemon 17 orange orange bell 18 plum cherry melon and orange 19 bar bell bell 20 plum melon and orange lemonIn some instances, two symbols appeared together in the window; in that case, either symbol could contribute to a paying combination.
Here is the table of payoffs for this machine:
double jackpot: 7 7 7 pays 200 coins
jackpot: bar bar bar 100
jackpot: melon melon melon 100
jackpot: melon melon bar 100
bell bell bell 18
bell bell bar 18
plum plum plum 14
plum plum bar 14
orange orange orange 10
orange orange bar 10
cherry cherry (any) 5
cherry (any) (any) 2
On each play, the sucker inserts one coin and throws the lever to start the
wheels turning; if the machine is working correctly, each wheel is equally
likely to stop in any of its twenty positions, and the three wheels turn
independently of one another. (The source for my information is John
Scarne, Scarne's new complete guide to gambling, New York: Simon and
Schuster, 1974.) Define a Scheme procedure that simulates the operation of the Twenty One Bell.
(define bandit
(let ((first-wheel
'#((orange) (melon) (plum) (cherry) (plum)
(orange) (seven) (bell bar) (orange) (cherry)
(bar) (plum) (orange) (plum) (melon)
(plum) (orange) (plum) (bar) (plum)))
(second-wheel
'#((cherry) (plum) (cherry) (seven orange) (cherry)
(bell) (plum bar) (bell) (cherry) (orange)
(bell) (melon orange) (plum) (bell) (cherry)
(bar) (orange) (cherry) (bell) (melon orange)))
(third-wheel
'#((bell) (orange) (plum) (bell) (orange)
(lemon) (bell) (melon orange) (bell) (plum)
(lemon) (bell) (plum) (bell) (seven bar)
(lemon) (bell) (melon orange) (bell) (lemon))))
(lambda ()
(let ((spin (list (random-element first-wheel)
(random-element second-wheel)
(random-element third-wheel))))
(writeln (car spin) " " (cadr spin) " " (caddr spin))
(cond ((matches? '((seven) (seven) (seven)) spin)
(writeln "Double jackpot!!")
(writeln "You win 200 coins!"))
((or (matches? '((bar) (bar) (bar)) spin)
(matches? '((melon) (melon) (melon bar)) spin))
(writeln "Jackpot!")
(writeln "You win 100 coins!"))
((matches? '((bell) (bell) (bell bar)) spin)
(writeln "You win 18 coins!"))
((matches? '((plum) (plum) (plum bar)) spin)
(writeln "You win 14 coins!"))
((matches? '((orange) (orange) (orange bar)) spin)
(writeln "You win 10 coins!"))
((matches? '((cherry) (cherry) *) spin)
(writeln "You win 5 coins!"))
((matches? '((cherry) * *) spin)
(writeln "You win 2 coins!")))))))
(define random-element
(lambda (vec)
(vector-ref vec (random (vector-length vec)))))
(define writeln
(lambda args
(for-each display args)
(newline)
(define matches?
(lambda (pattern triple)
(and (fits? (car pattern) (car triple))
(fits? (cadr pattern) (cadr triple))
(fits? (caddr pattern) (caddr triple)))))
(define fits?
(lambda (ok given)
(or (eq? ok '*)
(let loop ((rest ok))
(and (not (null? rest))
(or (memq (car rest) given)
(loop (cdr rest))))))))
7. Compute the percentage of the total handle that the honest proprietor
of a Twenty One Bell can expect to keep. Speculate on the rationale of the
design of the playoff structure. Redefine the payoffs in your simulation
so that they are fair, that is, so that the player's mathematical
expectation is 0. Each of the eight thousand possible combinations of positions of the three wheels is equally probable. Here are the numbers of combinations that produce payoffs:
seven-seven-seven double jackpot: 1 way (1 * 1 * 1) * 200 = 200
bar-bar-bar jackpot: 6 ways (3 * 2 * 1) * 100 = 600
melon-melon-melon jackpot: 8 ways (2 * 2 * 2) * 100 = 800
melon-melon-bar jackpot: 4 ways (2 * 2 * 1) * 100 = 400
bell-bell-bell: 40 ways (1 * 5 * 8) * 18 = 720
bell-bell-bar: 5 ways (1 * 5 * 1) * 18 = 90
plum-plum-plum: 63 ways (7 * 3 * 3) * 14 = 882
plum-plum-bar: 21 ways (7 * 3 * 1) * 14 = 294
orange-orange-orange: 100 ways (5 * 5 * 4) * 10 = 1000
orange-orange-bar: 25 ways (5 * 5 * 1) * 10 = 250
cherry-cherry-anything: 240 ways (2 * 6 * 20) * 5 = 1200
cherry-anything-anything: 560 ways (2 * 14 * 20) * 2 = 1120
The total of the payoffs is 7556 coins, so the player's mathematical
expectation is (7556 - 8000)/8000, or -0.0555 coin per play. Similarly,
the house's expectation is +0.0555 coin per play, or 5.55% of the
handle. There are several interesting features of the payoff structure. Every symbol on every wheel is part of some winning combination or other (even the lemons on the third wheel can be matched with cherries on the other wheels). Payoffs are frequent; the sucker gets something back every 7.46 plays, on the average. The entries in the last column are surprisingly uniform (and become even more so if the `bar' payoffs are combined with the adjacent matching-fruit payoffs); perhaps the feeling is that the amount of player gratification is a function of the product of the size of the payoff and its probability, and keeping this product a constant over various types of payoff is a worthwhile goal. The distribution of symbols over wheels is very uneven; if the player assumes that all the wheels are just about alike, he gets an inflated impression of the probability of winning (e.g., 4 * 4 * 4 would win more often that 1 * 8 * 3, even though the total number of symbols on all three wheels would be the same).
To make the payoff structure fair, raise the payoff for the bell-bell-bell and bell-bell-bar combinations to 26 and the payoff for the plum-plum-plum and plum-plum-bar combinations to 15.
8. Define a Scheme procedure vector-every? that takes two
arguments, a predicate pred? of arity 1 and a vector
vec, and determines whether all of the elements of
vec satisfy pred?.
(define vector-every?
(lambda (pred? vec)
(let loop ((remaining (vector-length vec)))
(or (zero? remaining)
(let ((next (- remaining 1)))
(and (pred? (vector-ref vec next))
(loop next)))))))
9. A matrix can be represented in Scheme by a vector of vectors,
each of the element vectors constituting one row of the matrix. Define a
Scheme procedure identity that takes a positive integer
n as its argument and returns an
n-by-n identity matrix.
(define identity
(lambda (n)
(let ((result (make-vector n)))
(do ((row 0 (+ row 1)))
((= row n) result)
(vector-set! result row (make-vector n 0))
(vector-set! (vector-ref result row) row 1)))))
10. Define a Scheme procedure that constructs and returns the
transpose of a given matrix.
(define transpose
(lambda (matrix)
(let ((columns (vector-length matrix))
(rows (vector-length (vector-ref matrix 0))))
(let ((result (make-vector rows)))
(do ((row 0 (+ row 1)))
((= row rows) result)
(vector-set! result row (make-vector columns))
(do ((column 0 (+ column 1)))
((= column columns))
(vector-set! (vector-ref result row)
column
(vector-ref (vector-ref matrix column) row))))))))