Programming Praxis

We begin by creating constants for the number of colors and number of pegs, so the game may be easily changed, and computing the entire list of code words, which is also the list of potential probes:

(define num-colors 6)
(define num-pegs 4)

(define probes
  (apply cross (make-list num-pegs (range 1 (+ num-colors 1)))))

To determine the number of black hits, scan through the code and probe, noting which positions match, and count the matches:

(define (black code probe)
  (define (f x y) (if (= x y) 1 0))
  (sum (map f code probe)))

The number of white hits is the total number of hits minus the number of black hits. The total number of hits can be calculated as follows: For each symbol, let c be the number of times the symbol appears in the code word, and p be the number of times the symbol appears in the probe; then the total number of hits, both white and black, is the sum of the minimum of c and p for each symbol. For instance, if the code word is 2 5 3 2 and the probe is 3 5 2 3, there is one black hit, the 5, and two white hits, one of the 2s and one of the 3s. The total number of hits is calculated as min(0,0) + min(2,1) + min(1,2) + min(0,0) + min(1,1) + min(0,0) for the symbols 1 2 3 4 5 and 6. Here is b+w, which calculates the total number of hits:

(define (b+w code probe)
   (define (count x xs)
    (define (f y) (if (= x y) 1 0))
    (sum (map f xs)))
  (define (f x)
    (min (count x code) (count x probe)))
  (sum (map f (range 1 (+ num-colors 1)))))

The score is given as a string. For the standard game with four pegs, there are fourteen possible scores, ...., W..., B..., WW.., BW.., BB.., WWW., BWW., BBW., BBB., WWWW, BWWW, BBWW, and BBBB; note that there is no BBBW.

(define (score code probe)
  (let* ((black (black code probe))
         (white (- (b+w code probe) black)))
    (string-append
      (make-string black #\B)
      (make-string white #\W)
      (make-string (- num-pegs black white) #\.))))

Now that we can score a probe, the setter is simply a read/response loop; it either accepts a code word or chooses one at random, then cycles until the human solver inputs a probe that matches the code word:

(define (setter . args)
  (let ((code (if (pair? args) (car args) (fortune probes))))
    (display "Enter your guess as a list: ")
    (let loop ((probe (read)))
      (let ((s (score code probe)))
        (if (string=? (make-string num-pegs #\B) s)
            (begin (display "You win!") (newline))
            (begin (display s) (newline)
                   (display "Try again: ") (loop (read))))))))

If no code word is given, setter chooses one at random using the fortune function, which is named after the unix program that selects a witty saying from a list and presents it every time a user logs in. Fortune works by scanning through the input list, selecting the first item in the list with probability 1/1, then replacing it with the second item in the list with probability 1/2, then replacing that with the third item in the list with probability 1/3, and so on, eventually selecting one of the n items in the list with probability 1/n:

(define (fortune xs)
  (let loop ((n 1) (x #f) (xs xs))
    (cond ((null? xs) x)
          ((< (rand) (/ n))
            (loop (+ n 1) (car xs) (cdr xs)))
          (else (loop (+ n 1) x (cdr xs))))))

Here is a sample interaction with the setter, which uses range, fold-right, make-list, sum, uniq-c, rand and cross from the Standard Prelude:

> (setter '(3 6 3 2))
Enter your guess as a list: (1 1 2 2)
B...
Try again: (1 3 4 4)
W...
Try again: (3 5 2 6)
BWW.
Try again: (1 4 6 2)
BW..
Try again: (3 6 3 2)
You win!

The code is collected at http://programmingingpraxis.codepad.org/59rVyG1X, though you can’t run it because codepad doesn’t offer interactive sessions.

Pages: 1 2