Please pre-process inputs so that invalid inputs -- '! 4 4' or worse '1' --
don't crash the program. It should be easy to do. Also print instructions as
run boots up. -- Matthias
On Jun 3, 2013, at 11:03 AM, 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!")))))
> ____________________
> Racket Users list:
> http://lists.racket-lang.org/users
____________________
Racket Users list:
http://lists.racket-lang.org/users
