[racket] Rosetta Code Minesweeper Implementation

On 06/03/2013 02:26 PM, Sean Kanaley wrote:
> It's surprising how difficult a seemingly easy task like cloning
> minesweeper can be.  Ultimately this took several hours for what I
> thought would be 30-60 minutes.

Heh. :)

> Also I couldn't find a way to make a mutable-array immutable with
> anything resembling mutable-array->array so I left the board as mutable.

You're right - this isn't obvious. It didn't occur to me that anyone 
would want such a function, because a (Mutable-Array A) can be used 
anywhere an (Array A) is required. But sometimes you need to protect 
yourself from others...

Anyway, here's a short-ish implementation in Typed Racket:

(: array->immutable-array (All (A) ((Array A) -> (Array A))))
(define (array->immutable-array arr)
   (build-array (array-shape arr)
                (λ: ([js : Indexes]) (array-ref arr js))))

There are faster implementations, but they use undocumented, unsafe 
functions (albeit safely).

Neil ⊥

> #lang racket
> (require math)
> ;board uses arrays directly, but maintaining an abstraction is nice
> (define (board-ref b row col) (array-ref b (vector row col)))
> (define (board-rows b) (vector-ref (array-shape b) 0))
> (define (board-cols b) (vector-ref (array-shape b) 1))
> (define (on-board? b row col)
>    (and (<= 0 row (sub1 (board-rows b)))
>         (<= 0 col (sub1 (board-cols b)))))
> (define (board->lists b) (array->list* b))
> ;run on adjacent board positions
> (define-syntax (for-adj stx)
>    (syntax-case stx ()
>      [(_ b (r row) (c col) diag? body ...)
>       (with-syntax ([is (if (syntax->datum #'diag?) #''(0 0 1 1 1 -1 -1
> -1) #''(0 0 1 -1))]
>                     [js (if (syntax->datum #'diag?) #''(1 -1 0 -1 1 0 -1
> 1) #''(1 -1 0 0))])
>         #'(for ([i is] [j js])
>             (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) #:transparent)
> (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 recursively
> (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)))))
>
> (define (init-board rows cols)
>    (let ([chance (+ (/ (random) 10) 0.1)]
>          ;empty board
>          [b (array->mutable-array (build-array (vector rows cols)
>                                                (λ (x) (pos 'hidden 0))))])
>      ;loop whole board
>      (for* ([row (range 0 rows)]
>             [col (range 0 cols)])
>        (when (< (random) chance)
>          ;put a mine
>          (array-set! b (vector row col) (pos 'hidden -1))
>          ;increment adjacent mine counts unless that adjacent position
> is a mine
>          (for-adj b (r row) (c col) #t
>                   (let ([p (board-ref b r c)])
>                     (unless (mine? p)
>                       (array-set! b (vector r c) (pos 'hidden (add1
> (pos-n p)))))))))
>      b))
>
> ;only clear position if it's not a mine
> ;only continue recursing when it's a hidden0?
> (define (try-clear! p)
>    (cond [(mine? p) #f]
>          [(hidden0? p) (set-pos-mark! p 'clear) #t]
>          [else (set-pos-mark! p 'clear) #f]))
>
> ;the following player move functions return boolean where #f = lose, #t
> = still going
> ;assuming can never directly lose ((void) == #t from the set!)
> ;make sure to not allow overwriting an already cleared position
> (define (toggle-assume! b row col)
>    (let ([p (board-ref b row col)])
>      (set-pos-mark! p (case (pos-mark p)
>                         [(assume-mine) 'hidden]
>                         [(hidden) 'assume-mine]
>                         [(clear) 'clear]
>                         [else (error "invalid mark" (pos-mark p))]))))
>
> ;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, only continuing if it's a 0
>             (when (try-clear! p)
>               (let clear-adj ([row row] [col col])
>                 (for-adj b (r row) (c col) #f
>                          ;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 (string-split s)
>      [(list type row col)
>       (let ([row (string->number row)]
>             [col (string->number col)])
>         (if (on-board? b row col)
>             (case type
>               [("?") (toggle-assume! b row col)]
>               [("!") (clear! b row col)]
>               [else (parse-and-do-move! b (read-line))])
>             (parse-and-do-move! b (read-line))))]
>      [else (parse-and-do-move! b (read-line))]))
> (define (run)
>    (displayln (string-append "--- Enter one of:\n"
>                              "--- \"! <row> <col>\" to clear at
> (row,col), or\n"
>                              "--- \"? <row> <col>\" to flag a possible
> mine at (row,col).\n"))
>    (let ([b (init-board 8 8)])
>      (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
>