Consider a random testing approach. Throw the random tester at the main
function, Think of 'streams' of input that the main function can absorb, and
generate random streams .
On Jun 3, 2013, at 5:14 PM, Sean Kanaley wrote:
> 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 <skana...@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!")))))
>
> ____________________
> Racket Users list:
> http://lists.racket-lang.org/users
____________________
Racket Users list:
http://lists.racket-lang.org/users
