1 12687dd9 2023-08-04 jrmu ;; The first three lines of this file were inserted by DrScheme. They record metadata
2 12687dd9 2023-08-04 jrmu ;; about the language level of this file in a form that our tools can easily process.
3 12687dd9 2023-08-04 jrmu #reader(lib "htdp-advanced-reader.ss" "lang")((modname |32.3|) (read-case-sensitive #t) (teachpacks ((lib "draw.ss" "teachpack" "htdp") (lib "arrow.ss" "teachpack" "htdp") (lib "gui.ss" "teachpack" "htdp"))) (htdp-settings #(#t constructor repeating-decimal #t #t none #f ((lib "draw.ss" "teachpack" "htdp") (lib "arrow.ss" "teachpack" "htdp") (lib "gui.ss" "teachpack" "htdp")))))
4 12687dd9 2023-08-04 jrmu ;A solitaire board (board) is a (vectorof (vectorof booleans)), where true represents a filled square, false an empty square. In particular, for any given board, the n-th element is a vector containing n booleans. We call a triangular board with n-pegs to a side a size-n triangle. For example, the representation of a size-4 equilaterial triangular board:
6 12687dd9 2023-08-04 jrmu ;(vector (vector false)
7 12687dd9 2023-08-04 jrmu ; (vector true true)
8 12687dd9 2023-08-04 jrmu ; (vector true true true)
9 12687dd9 2023-08-04 jrmu ; (vector true true true true))
11 12687dd9 2023-08-04 jrmu ;enabled? : posn board -> boolean
12 12687dd9 2023-08-04 jrmu ;Determines whether or not the peg specified by aposn is enabled in aboard (enabled means that the peg is capable of jumping). The top position of the board has the index (make-posn 1 1). The vertical axis is denoted by y, the horizontal by x.
14 12687dd9 2023-08-04 jrmu ;next-peg-x represents the x-index where the peg will jump to if it jumps to the right
15 12687dd9 2023-08-04 jrmu ;next-peg-y represents the y-index where the peg will jump to if it jumps down
16 12687dd9 2023-08-04 jrmu ;prev-peg-x represents the x-index ... if the peg jumps to the left
17 12687dd9 2023-08-04 jrmu ;prev-peg-x represents the y-index ... if the peg jumps up
18 12687dd9 2023-08-04 jrmu ;need-length-x represents the necessary horizontal length of the board to jump to the right
19 12687dd9 2023-08-04 jrmu ;need-length-y represents the necessary vertical length of the board to jump down
20 12687dd9 2023-08-04 jrmu ;next-peg-x-removes represents the x-index of the peg that will be removed if the peg is jumped, etc.
22 12687dd9 2023-08-04 jrmu ;the parameters for the position of the new peg as well as the peg to be removed are passed to jump?.
24 12687dd9 2023-08-04 jrmu (define (enabled? aposn aboard)
25 12687dd9 2023-08-04 jrmu (local ((define peg-x (sub1 (posn-x aposn)))
26 12687dd9 2023-08-04 jrmu (define peg-y (sub1 (posn-y aposn)))
27 12687dd9 2023-08-04 jrmu (define next-peg-x-removes (+ peg-x 1))
28 12687dd9 2023-08-04 jrmu (define next-peg-y-removes (+ peg-y 1))
29 12687dd9 2023-08-04 jrmu (define prev-peg-x-removes (- peg-x 1))
30 12687dd9 2023-08-04 jrmu (define prev-peg-y-removes (- peg-y 1))
31 12687dd9 2023-08-04 jrmu (define next-peg-x (+ peg-x 2))
32 12687dd9 2023-08-04 jrmu (define next-peg-y (+ peg-y 2))
33 12687dd9 2023-08-04 jrmu (define prev-peg-x (- peg-x 2))
34 12687dd9 2023-08-04 jrmu (define prev-peg-y (- peg-y 2)))
36 12687dd9 2023-08-04 jrmu ;;first, is there even a peg?
37 12687dd9 2023-08-04 jrmu ;;if so, test jump down, jump right, jump up, jump left, jump diagonal (up), jump diagonal (down), in that order
38 12687dd9 2023-08-04 jrmu [(vector-ref (vector-ref aboard peg-y) peg-x)
39 12687dd9 2023-08-04 jrmu (or (jump? peg-x next-peg-y peg-x next-peg-y-removes aboard)
40 12687dd9 2023-08-04 jrmu (jump? next-peg-x peg-y next-peg-x-removes peg-y aboard)
41 12687dd9 2023-08-04 jrmu (jump? peg-x prev-peg-y peg-x prev-peg-y-removes aboard)
42 12687dd9 2023-08-04 jrmu (jump? prev-peg-x peg-y prev-peg-x-removes peg-y aboard)
43 12687dd9 2023-08-04 jrmu (jump? prev-peg-x prev-peg-y prev-peg-x-removes prev-peg-y-removes aboard)
44 12687dd9 2023-08-04 jrmu (jump? next-peg-x next-peg-y next-peg-x-removes next-peg-y-removes aboard))]
45 12687dd9 2023-08-04 jrmu [else false])))
47 12687dd9 2023-08-04 jrmu ;jump? : N N N N board-> boolean
48 12687dd9 2023-08-04 jrmu ;Given new-peg-x, new-peg-y, remove-peg-x, remove-peg-y, and aboard, determine if it is possible to make a jump. All coordinates are in terms of vector indices. E.g, 0,0 represents the first element in the first vector.
50 12687dd9 2023-08-04 jrmu (define (jump? new-peg-x new-peg-y remove-peg-x remove-peg-y aboard)
51 12687dd9 2023-08-04 jrmu (local ((define need-length-x (add1 new-peg-x))
52 12687dd9 2023-08-04 jrmu (define need-length-y (add1 new-peg-y)))
53 12687dd9 2023-08-04 jrmu (and (not (negative? new-peg-x))
54 12687dd9 2023-08-04 jrmu (not (negative? new-peg-y))
55 12687dd9 2023-08-04 jrmu (>= (vector-length aboard) need-length-y)
56 12687dd9 2023-08-04 jrmu (>= (vector-length (vector-ref aboard new-peg-y)) need-length-x)
57 12687dd9 2023-08-04 jrmu (not (vector-ref (vector-ref aboard new-peg-y) new-peg-x))
58 12687dd9 2023-08-04 jrmu (vector-ref (vector-ref aboard remove-peg-y) remove-peg-x))))
60 12687dd9 2023-08-04 jrmu ;next-board : board posn -> (listof boards) or false
61 12687dd9 2023-08-04 jrmu ;Given aboard and aposn, return all possible board configurations if the peg specified by aposn is jumped. (since there may be more than one possible jump, we must list the results as a listof boards)
63 12687dd9 2023-08-04 jrmu (define (next-board aboard aposn)
65 12687dd9 2023-08-04 jrmu [(enabled? aposn aboard)
66 12687dd9 2023-08-04 jrmu (append (jump aboard aposn) ;down
67 12687dd9 2023-08-04 jrmu (jump aboard aposn) ;right
68 12687dd9 2023-08-04 jrmu (jump aboard aposn) ;up
69 12687dd9 2023-08-04 jrmu (jump-left aboard aposn) ;left
70 12687dd9 2023-08-04 jrmu (jump-diagonal-up aboard aposn) ;diagonal-up
71 12687dd9 2023-08-04 jrmu (jump-diagonal-down aboard aposn))] ;diagonal-down
72 12687dd9 2023-08-04 jrmu [else false]))
74 12687dd9 2023-08-04 jrmu jump : board posn posn -> board
75 12687dd9 2023-08-04 jrmu Using aboard, return a new board with old-peg replaced with false and new-peg replaced with true. The intermediate peg is removed.
77 12687dd9 2023-08-04 jrmu (define (jump aboard new-peg old-peg)
