Hello all,
Rosetta Code does not have a minesweeper implementation in Racket. I have
created the one shown below. Before I post it to Rosetta, I was looking
for possible feedback to shorten, make clearer, make "safer" in some way,
make more use of library functions, etc. I would hate to give Racket a bad
name in the official show-what-your-language-can-do repository.
I believe it's not an unreasonable implementation, and I understand this
request may not sound exhilarating, so I do not expect any replies! After
however long I feel I will simply post this solution! With comments and a
bit of utility function groundwork it's 131 lines, 82 with that removed.
To test, run "(run)" and enter "! <row> <col>" to clear @ (row,col) or "?
<row> <col>" to assume a mine @ (row,col).
#lang racket
;turns list into list of lists each of size n
(define (group-n n l)
(let group-n ([l l] [acc '()])
(if (null? l)
(reverse acc)
(let-values ([(takes drops) (split-at l n)])
(group-n drops (cons takes acc))))))
;small 2d vector library
;uses built-in vector with minor size stored at index 0
(define (build-vector2 maj min [f (const 0)])
(let ([v (build-vector (add1 (* maj min))
(λ (n) (let-values ([(i j) (quotient/remainder
(sub1 n) min)])
(f i j))))])
(vector-set! v 0 min)
v))
(define (vector2-maj v) (quotient (sub1 (vector-length v)) (vector2-min v)))
(define (vector2-min v) (vector-ref v 0))
(define (vector2-in-range? v i j)
(and (<= 0 i (sub1 (vector2-maj v)))
(<= 0 j (sub1 (vector2-min v)))))
(define (vector2-index v i j) (+ 1 j (* i (vector2-min v))))
(define (vector2-ref v i j) (vector-ref v (vector2-index v i j)))
(define (vector2-set! v i j x) (vector-set! v (vector2-index v i j) x))
(define (vector2->immutable-vector2 v) (vector->immutable-vector v))
(define (vector2->lists v) (group-n (vector2-min v) (cdr (vector->list v))))
;board uses vector2's directly, but maintaining an abstraction is nice
(define (board-ref b row col) (vector2-ref b row col))
(define (board-rows b) (vector2-maj b))
(define (board-cols b) (vector2-min b))
(define (on-board? b row col) (vector2-in-range? b row col))
(define (board->lists b) (vector2->lists b))
;run on adjacent board positions
(define-syntax-rule (for-adj b (r row) (c col) body ...)
(for ([i '(0 0 1 1 1 -1 -1 -1)] [j '(1 -1 0 -1 1 0 -1 1)])
(let ([r (+ row i)]
[c (+ col j)])
(when (on-board? b r c)
body ...))))
;mark is either hidden, assume-mine, or clear
;n is int equal to # adj mines or -1 for mine
(struct pos ([mark #:mutable] n))
(define (mine? p) (= (pos-n p) -1))
;hidden0? is needed because only spaces with no mines in them and no mines
adjacent to them are cleared
(define (hidden0? p)
(and (symbol=? (pos-mark p) 'hidden)
(zero? (pos-n p))))
(define (show-pos p)
(match-let ([(pos m n) p])
(case m
[(hidden) "."]
[(assume-mine) "?"]
[(clear) (if (zero? n) " " (number->string n))]
[else (error "illegal mark" m)])))
;put "|" around positions
(define (show-board b)
(for ([row (board->lists b)])
(displayln (format "|~a|" (string-join (map show-pos row) "|")))))
;winning = every position is either cleared or a hidden mine
(define (win? b)
(for*/and ([r (range 0 (board-rows b))]
[c (range 0 (board-cols b))])
(let ([p (board-ref b r c)])
(or (symbol=? (pos-mark p) 'clear)
(mine? p)))))
;the board is immutable even though its individual positions can mutate
their mark field
(define (init-board rows cols)
(let ([chance (+ (/ (random) 10) 0.1)]
;empty board
[b (build-vector2 rows cols (λ (r c) (pos 'hidden 0)))])
;loop whole board
(for* ([row (range 0 rows)]
[col (range 0 cols)])
(when (< (random) chance)
;put a mine
(vector2-set! b row col (pos 'hidden -1))
;increment adjacent mine counts unless that adjacent position is a
mine
(for-adj b (r row) (c col)
(let ([p (board-ref b r c)])
(unless (mine? p)
(vector2-set! b r c (pos 'hidden (add1 (pos-n
p)))))))))
(vector2->immutable-vector2 b)))
;only clear position if its hidden and isn't adjacent to a mine
(define (try-clear! p)
(when (hidden0? p)
(set-pos-mark! p 'clear)))
;the following player move functions return boolean where #f = lose, #t =
still going
;assuming can never directly lose ((void) == #t)
(define (assume! b row col) (set-pos-mark! (board-ref b row col)
'assume-mine))
;clearing loses when the chosen position is a mine
;void = #t as far as if works, so no need to return #t
(define (clear! b row col)
(let ([p (board-ref b row col)])
(and (not (mine? p))
;not a mine, so recursively check adjacents, and maintain list of
visited positions
;to avoid infinite loops
(let ([seen '()])
;clear the chosen position first
(set-pos-mark! p 'clear)
(let clear-adj ([row row] [col col])
(for-adj b (r row) (c col)
;make sure its not seen
(when (and (not (member (list r c) seen))
(try-clear! (board-ref b r c)))
;it was cleared, so loop after saving this position
as being seen
(set! seen (cons (list r c) seen))
(clear-adj r c))))))))
(define (parse-and-do-move! b s)
(match-let* ([(list type row col) (string-split s)]
[row (string->number row)]
[col (string->number col)])
(case type
[("?") (assume! b row col)]
[("!") (clear! b row col)]
[else (error "invalid move command" type)])))
(define (run)
(let ([b (init-board 4 6)])
(let run ()
(show-board b)
(display "enter move: ")
(if (parse-and-do-move! b (read-line))
(if (win? b) (displayln "CLEAR!") (run))
(displayln "BOOM!")))))
____________________
Racket Users list:
http://lists.racket-lang.org/users
