minesweeper implemented in R

minesweeper.R

# /usr/bin/r
#
# Created: 2016.04.26
# Copyright: Steven E. Pav, 2016
# Author: Steven E. Pav <shabbychef@gmail.com>
# Comments: Steven E. Pav

# generate a new state of the board
generate_one <- function(nrow,ncol=nrow,nbombs = 10) {
	stopifnot(nbombs <= nrow*ncol)
	board <- matrix('_',nrow,ncol)
	locs <- sample(nrow*ncol,size=nbombs,replace=FALSE)
	loc <- matrix(FALSE,nrow,ncol)
	loc[locs] <- TRUE
	flags <- matrix(FALSE,nrow,ncol)
	retv <- list(board=board,loc=loc,flags=flags)
	class(retv) <- 'minesweeper'
	retv
}

print.minesweeper <- function(x) {
	toshow <- x$board
	toshow[x$flags] <- 'F'
	print(toshow)
}


board <- generate_one(10)

bool_neighbors <- function(board,mrow,mcol,dst=1) {
	return (pmax(abs(row(board$board) - mrow),abs(col(board$board) - mcol)) == dst)
}
# count # of bombs in the neighborhood...
count_neighbors <- function(board,mrow,mcol) {
	brow <- nrow(board$board)
	bcol <- ncol(board$board)
	rowidx <- max(1,mrow-1):min(brow,mrow+1)
	colidx <- max(1,mcol-1):min(bcol,mcol+1)
	outsum <- sum(as.integer(board$loc[rowidx,colidx]))
	insum <- as.integer(board$loc[mrow,mcol])
	return (outsum - insum)
}

# suppose you 'ping' a spot on the board
# and find that it does *not* have a bomb.
# you need to update the picture of the board.
# do this by a breadth-wide search. here
# newdf will be a data frame that has the 
# 'new' rows and columns to check. it will call
# itself recursively (ugh) to fan out
# and update the board.
b_updates <- function(board,mrow,mcol) {
	dst <- 0
	# invariant is that 
	# checkset is boolean matrix where characters are '_'
	# and where they are brought in by an exploration in a neighboring
	# reveal.
	distset <- bool_neighbors(board,mrow,mcol,dst=dst)
	checkset <- distset
	while (any(checkset)) {
		rnum <- row(board$board)[checkset]
		cnum <- col(board$board)[checkset]
		for (iii in seq_along(rnum)) {
			rnii <- rnum[iii]
			cnii <- cnum[iii]
			if (board$board[rnii,cnii] == '_') { 
				nneigh <- count_neighbors(board,rnii,cnii)
				board$board[rnii,cnii] <- as.character(nneigh)
				if (nneigh == 0) {
					# add to the set to check next.
					is_neigh <- bool_neighbors(board,rnii,cnii,dst=1)
					checkset <- (checkset | is_neigh)
				}
			}
		}
		dst <- dst + 1
		distset <- bool_neighbors(board,mrow,mcol,dst=dst)
		checkset <- checkset & distset
	}
	return (board)
}

# checks if in the winning configuation: all the
# bomb locations have flags and no flags on
# non-bomb locations.
check_win <- function(board) {
	return (all(board$flags == board$loc))
}

# assume the move is already parsed
# moves are of the form
# 'F row col'
# 'U row col'
# 'P row col'
move <- 'F 5 3'
update_f <- function(board,move) {
	mtype <- substr(move,1,1)
	mrow <- as.numeric(gsub('^[A-Za-z]+\\s+(\\d+)\\s+(\\d+)\\s*$','\\1',move))
	mcol <- as.numeric(gsub('^[A-Za-z]+\\s+(\\d+)\\s+(\\d+)\\s*$','\\2',move))

	## input checking#FOLDUP
	if (! mtype %in% c('F','U','P')) {
		warning('unknown move. should be of form "[FUP] rownum colnum". no change')
		return (board)
	}
	# check for out of bounds.
	if ((min(mrow,mcol) < 1) || (mrow > nrow(board$board)) || (mcol > ncol(board$board))) {
		warning('move out of bounds. no change')
		return (board)
	}#UNFOLD

	if (mtype == 'F') {
		# check if there's a flag there already.
		if (board$flags[mrow,mcol]) {
			warning('already flagged that spot. no change')
			return (board)
		}
		if (board$board[mrow,mcol] == '0') {
			warning('should not flag a zero spot. no change')
			return (board)
		}
		board$flags[mrow,mcol] <- TRUE;
		# check if there are too many flags, raise a warning.
		if (sum(board$flags) > sum(board$loc)) {
			warning('too many flags. there should be at most ',sum(board$loc))
		}
		# fall through and check for winning condition...
	} else if (mtype == 'U') {
		# check if there's a flag there already.
		if (!board$flags[mrow,mcol]) {
			warning('no flag on that spot. no change')
			return (board)
		}
		if (board$board[mrow,mcol] == '0') {
			warning('should not unflag a zero spot. no change')
			return (board)
		}
		board$flags[mrow,mcol] <- FALSE;
		# fall through and check for winning condition...
	} else if (mtype == 'P') {
		if (board$loc[mrow,mcol]) {
			stop("YOU DIE!")
		} else {
			board <- b_updates(board,mrow=mrow,mcol=mcol)
		}
		# fall through and check for winning condition...
	}
	if (check_win(board)) {
		warning('YOU WIN!')
	}
	return (board)
}


set.seed(1234)
board <- generate_one(10,nbombs=5)
board

board <- update_f(board,'P 5 7')
board
board <- update_f(board,'F 4 9')
board
board <- update_f(board,'P 2 9')
board <- update_f(board,'P 4 10')
board <- update_f(board,'F 3 3')
board <- update_f(board,'F 7 3')
board <- update_f(board,'P 3 1')
board
board <- update_f(board,'P 2 3')
board <- update_f(board,'P 1 3')
board <- update_f(board,'P 7 2')
board <- update_f(board,'P 8 2')
board <- update_f(board,'P 7 1')
board
board <- update_f(board,'P 10 1')
board <- update_f(board,'P 8 3')
board <- update_f(board,'F 9 3')
board <- update_f(board,'P 10 3')
board <- update_f(board,'F 9 2')

#for vim modeline: (do not edit)
# vim:fdm=marker:fmr=FOLDUP,UNFOLD:cms=#%s:syn=r:ft=r

I can't believe I had to do this for an interview. sigh.