[racket] Rosetta Code Minesweeper Implementation

Nice game!

You may want to look into the `math/array' library. It should provide
all the grid operations you need.

Vincent


At Mon, 3 Jun 2013 11:03:16 -0400,
Sean Kanaley wrote:
> 
> 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!")))))