Sudoku solver in R

gistfile1.r

# save your sudoku as a tab delimited text file. Stringr is for the function str_count

library(stringr)
puz <- as.matrix(read.csv("sudpuz.txt", sep="\t", header = F))
y <- c(puz)

# make keys

sq_start <- c(1, 4, 7, 28, 31, 34, 55, 58, 61)
key <- matrix(1:81, 9, 9)
squares <- function(q) {
	c(q:(q+2), (q+9):(q+11), (q+18):(q+20))
	}
key <- rbind(t(key), key, t(sapply(sq_start, squares)))

rel <- data.frame(box = 1:81)
rel$cols <- ceiling(rel$box/9)
rel$rows <- rep(10:18, 9)
rel$sq <- c(rep(c(19,19,19,20,20,20,21,21,21),3), rep(c(22,22,22,23,23,23,24,24,24),3), rep(c(25,25,25,26,26,26,27,27,27),3))

# find all related numbers. x is the box

allnumsF <- function(x) {
	cols <- paste(y[key[rel[x,2],]], collapse = "NA")
	rows <- paste(y[key[rel[x,3],]], collapse = "NA")
	sqs <-  paste(y[key[rel[x,4],]], collapse = "NA")
	nums <- paste(cols, rows, sqs, collapse = "NA")
	nums <- gsub("NA", "", nums)
	return(nums)
}

# find candidates (x is the list of related numbers within a box)

poss <- function (x) {
	findn <- function(q) {
		return(ifelse(grepl(q, x), "", q))
	}
	nums <- sapply(1:9, findn)
	return(paste(nums, collapse = ""))
}

# replace boxes in y where there is only one option (cand is the vector of candidates)

onlyplace <- function(cand, y) {
    for (u in 1:27) {
	    for (t in 1:9) {
	    	x <- grep(t, cand[c(key[u, ])])
	    	if (length(x) == 1) {
	    		y[key[u, x]] <- t
	    	}
    	}		
    }
    return(y)
}

# determine solved status, where y is the puzzle vector. 1 = solved, 2 = error, 3 = incomplete

status <- function (y) {
	solvemat <- matrix(1:243, 27, 9)
	for (u in 1:27) {
		for (v in 1:9) {
			solvemat[u, v] <- str_count(paste(y[key[u,]], collapse = "NA"), as.character(v))
		}
	}
	if (sum(ifelse(solvemat == 1, 1, 0)) == 243) {
		return(1)
	} else {
		if (sum(ifelse(solvemat > 1, 1, 0)) > 1) {
			return(2)
		} else {
			return(3)
		}
	}
}

# master function, where x is the puzzle vector

solver <- function (x) {
	allnums <- sapply(1:81, allnumsF)
	cand <- sapply(allnums, poss)
	cand <- ifelse(is.na(y),gsub(0, "", cand),y)
	y <- onlyplace(cand, y)
	return(list(y, allnums, cand))
}

result <- solver(y)
y <- result[[1]]
allnums <- result[[2]]
cand <- result[[3]]

# iterate and solve

iter <- 0
status_y <- status(y)
while (status_y == 3 && iter < 20) {
	status_y <- status(y)
	y <- solver(y)[[1]]
	iter <- iter + 1
}

matrix(y, 9, 9)
status(y)