<div dir="ltr"><div>Hello all,<br><br>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.<br>
<br></div>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.<br>
<br>To test, run "(run)" and enter "! <row> <col>" to clear @ (row,col) or "? <row> <col>" to assume a mine @ (row,col).<br><div><div><br>#lang racket<br>;turns list into list of lists each of size n<br>
(define (group-n n l)<br> (let group-n ([l l] [acc '()])<br> (if (null? l)<br> (reverse acc)<br> (let-values ([(takes drops) (split-at l n)])<br> (group-n drops (cons takes acc))))))<br><br>
;small 2d vector library<br>;uses built-in vector with minor size stored at index 0<br>(define (build-vector2 maj min [f (const 0)])<br> (let ([v (build-vector (add1 (* maj min))<br> (ë (n) (let-values ([(i j) (quotient/remainder (sub1 n) min)])<br>
(f i j))))])<br> (vector-set! v 0 min)<br> v))<br>(define (vector2-maj v) (quotient (sub1 (vector-length v)) (vector2-min v)))<br>(define (vector2-min v) (vector-ref v 0))<br>(define (vector2-in-range? v i j) <br>
(and (<= 0 i (sub1 (vector2-maj v)))<br> (<= 0 j (sub1 (vector2-min v)))))<br>(define (vector2-index v i j) (+ 1 j (* i (vector2-min v))))<br>(define (vector2-ref v i j) (vector-ref v (vector2-index v i j)))<br>
(define (vector2-set! v i j x) (vector-set! v (vector2-index v i j) x))<br>(define (vector2->immutable-vector2 v) (vector->immutable-vector v))<br>(define (vector2->lists v) (group-n (vector2-min v) (cdr (vector->list v))))<br>
<br>;board uses vector2's directly, but maintaining an abstraction is nice<br>(define (board-ref b row col) (vector2-ref b row col))<br>(define (board-rows b) (vector2-maj b))<br>(define (board-cols b) (vector2-min b))<br>
(define (on-board? b row col) (vector2-in-range? b row col))<br>(define (board->lists b) (vector2->lists b))<br>;run on adjacent board positions<br>(define-syntax-rule (for-adj b (r row) (c col) body ...)<br> (for ([i '(0 0 1 1 1 -1 -1 -1)] [j '(1 -1 0 -1 1 0 -1 1)])<br>
(let ([r (+ row i)]<br> [c (+ col j)])<br> (when (on-board? b r c)<br> body ...))))<br>;mark is either hidden, assume-mine, or clear<br>;n is int equal to # adj mines or -1 for mine<br>(struct pos ([mark #:mutable] n))<br>
(define (mine? p) (= (pos-n p) -1))<br>;hidden0? is needed because only spaces with no mines in them and no mines adjacent to them are cleared<br>(define (hidden0? p)<br> (and (symbol=? (pos-mark p) 'hidden)<br> (zero? (pos-n p))))<br>
(define (show-pos p)<br> (match-let ([(pos m n) p])<br> (case m<br> [(hidden) "."]<br> [(assume-mine) "?"]<br> [(clear) (if (zero? n) " " (number->string n))]<br> [else (error "illegal mark" m)])))<br>
;put "|" around positions<br>(define (show-board b)<br> (for ([row (board->lists b)])<br> (displayln (format "|~a|" (string-join (map show-pos row) "|")))))<br><br>;winning = every position is either cleared or a hidden mine<br>
(define (win? b)<br> (for*/and ([r (range 0 (board-rows b))]<br> [c (range 0 (board-cols b))])<br> (let ([p (board-ref b r c)])<br> (or (symbol=? (pos-mark p) 'clear)<br> (mine? p)))))<br>
<br>;the board is immutable even though its individual positions can mutate their mark field<br>(define (init-board rows cols)<br> (let ([chance (+ (/ (random) 10) 0.1)]<br> ;empty board<br> [b (build-vector2 rows cols (ë (r c) (pos 'hidden 0)))])<br>
;loop whole board<br> (for* ([row (range 0 rows)]<br> [col (range 0 cols)])<br> (when (< (random) chance)<br> ;put a mine<br> (vector2-set! b row col (pos 'hidden -1))<br> ;increment adjacent mine counts unless that adjacent position is a mine<br>
(for-adj b (r row) (c col)<br> (let ([p (board-ref b r c)])<br> (unless (mine? p)<br> (vector2-set! b r c (pos 'hidden (add1 (pos-n p)))))))))<br> (vector2->immutable-vector2 b)))<br>
<br>;only clear position if its hidden and isn't adjacent to a mine<br>(define (try-clear! p)<br> (when (hidden0? p)<br> (set-pos-mark! p 'clear)))<br><br>;the following player move functions return boolean where #f = lose, #t = still going<br>
;assuming can never directly lose ((void) == #t)<br>(define (assume! b row col) (set-pos-mark! (board-ref b row col) 'assume-mine))<br><br>;clearing loses when the chosen position is a mine<br>;void = #t as far as if works, so no need to return #t<br>
(define (clear! b row col)<br> (let ([p (board-ref b row col)])<br> (and (not (mine? p))<br> ;not a mine, so recursively check adjacents, and maintain list of visited positions<br> ;to avoid infinite loops<br>
(let ([seen '()])<br> ;clear the chosen position first<br> (set-pos-mark! p 'clear)<br> (let clear-adj ([row row] [col col])<br> (for-adj b (r row) (c col)<br> ;make sure its not seen<br>
(when (and (not (member (list r c) seen))<br> (try-clear! (board-ref b r c)))<br> ;it was cleared, so loop after saving this position as being seen<br>
(set! seen (cons (list r c) seen))<br> (clear-adj r c))))))))<br><br>(define (parse-and-do-move! b s)<br> (match-let* ([(list type row col) (string-split s)]<br> [row (string->number row)]<br>
[col (string->number col)])<br> (case type<br> [("?") (assume! b row col)]<br> [("!") (clear! b row col)]<br> [else (error "invalid move command" type)])))<br>
(define (run)<br> (let ([b (init-board 4 6)])<br> (let run ()<br> (show-board b)<br> (display "enter move: ")<br> (if (parse-and-do-move! b (read-line))<br> (if (win? b) (displayln "CLEAR!") (run))<br>
(displayln "BOOM!")))))<br></div></div></div>