[racket] Rosetta Code Minesweeper Implementation

Just kidding there are more parse bugs, but I'm doing my best to fix them.
The consolation is that the other implementations are either far longer,
incorrect, or both.  Still... I shall post it shortly and hope for the best.


On Mon, Jun 3, 2013 at 4:26 PM, Sean Kanaley <skanaley at gmail.com> wrote:

> Thank you both for the replies.  I have incorporated all of your
> suggestions.  The thin board wrapper over vector2 proved useful to quickly
> switch everything over to arrays.  The program should no longer crash due
> to user input aside from any kind of internal buffer issues that may or may
> not be possible, which now exceeds the spec of allowing malformed input
> (though bounds checking was still lacking).
>
> I also found a few important bugs in the process, so forgive me but I
> shall repost the code in its entirety.  The critical changes are the macro
> to process adjacent positions, since clearing recursively seems to require
> not using diagonals but summing the number of adjacent mines obviously
> does; try-clear! wasn't returning the proper values to stop recursion;
> assume! should be toggleable (not actually in the spec though); and some
> other minor things.
>
> 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.
>
> 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.
>
> #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!")))))
>
-------------- next part --------------
An HTML attachment was scrubbed...
URL: <http://lists.racket-lang.org/users/archive/attachments/20130603/c549eabf/attachment.html>