Playing Wumpus World with supervised learning using AI machine learning in R and caret. http://primaryobjects.github.io/wumpus
room_n | room_e | room_s | room_w | breeze | stench | glitter | move | |
---|---|---|---|---|---|---|---|---|
unvisited | unvisited | wall | wall | false | false | false | north | |
visited | unvisited | wall | wall | false | false | false | east | |
unvisited | unvisited | visited | wall | false | false | false | north | |
unvisited | visited | visited | wall | false | false | false | north | |
visited | unvisited | visited | wall | false | false | false | east | |
unvisited | unvisited | visited | wall | true | false | false | south | |
unvisited | unvisited | visited | wall | false | true | false | south | |
unvisited | unvisited | visited | wall | true | true | false | south | |
unvisited | unvisited | visited | wall | false | false | true | north | |
visited | unvisited | visited | wall | false | false | true | east | |
wall | unvisited | unvisited | unvisited | false | false | false | east | |
wall | visited | visited | visited | false | false | false | east | |
wall | wall | visited | visited | false | false | false | south | |
wall | visited | visited | wall | false | false | false | east | |
wall | unvisited | visited | wall | false | false | false | east | |
wall | visited | unvisited | wall | false | false | false | south | |
unvisited | unvisited | unvisited | unvisited | false | false | false | north | |
visited | unvisited | unvisited | unvisited | false | false | false | east | |
visited | unvisited | unvisited | unvisited | true | false | false | north | |
visited | unvisited | unvisited | unvisited | false | true | false | north | |
visited | unvisited | unvisited | unvisited | true | true | false | north | |
unvisited | visited | unvisited | unvisited | true | false | false | east | |
unvisited | visited | unvisited | unvisited | false | true | false | east | |
unvisited | visited | unvisited | unvisited | true | true | false | east | |
unvisited | unvisited | visited | unvisited | true | false | false | south | |
unvisited | unvisited | visited | unvisited | false | true | false | south | |
unvisited | unvisited | visited | unvisited | true | true | false | south | |
unvisited | unvisited | unvisited | visited | true | false | false | west | |
unvisited | unvisited | unvisited | visited | false | true | false | west | |
unvisited | unvisited | unvisited | visited | true | true | false | west | |
visited | visited | unvisited | unvisited | true | false | false | south | |
visited | visited | unvisited | unvisited | false | true | false | south | |
visited | visited | unvisited | unvisited | true | true | false | south | |
unvisited | visited | visited | unvisited | true | false | false | north | |
unvisited | visited | visited | unvisited | false | true | false | north | |
unvisited | visited | visited | unvisited | true | true | false | north | |
unvisited | unvisited | visited | visited | true | false | false | north | |
unvisited | unvisited | visited | visited | false | true | false | north | |
unvisited | unvisited | visited | visited | true | true | false | north | |
visited | unvisited | unvisited | visited | true | false | false | north | |
visited | unvisited | unvisited | visited | false | true | false | north | |
visited | unvisited | unvisited | visited | true | true | false | north | |
unvisited | visited | unvisited | visited | true | false | false | east | |
unvisited | visited | unvisited | visited | false | true | false | east | |
unvisited | visited | unvisited | visited | true | true | false | east | |
visited | visited | visited | unvisited | false | false | false | west | |
visited | unvisited | visited | visited | false | false | false | east | |
visited | visited | unvisited | visited | false | false | false | south | |
visited | unvisited | unvisited | unvisited | false | false | true | east | |
visited | visited | unvisited | unvisited | false | false | true | south | |
visited | visited | visited | unvisited | false | false | true | west | |
visited | visited | unvisited | visited | false | false | true | south | |
unvisited | visited | visited | visited | false | false | true | north | |
unvisited | unvisited | visited | unvisited | false | true | true | south | |
visited | visited | wall | visited | false | false | false | north | |
unvisited | unvisited | visited | wall | false | false | true | east | |
unvisited | unvisited | visited | unvisited | true | true | false | south | |
unvisited | wall | wall | visited | false | false | false | north | |
unvisited | wall | visited | unvisited | true | false | false | south | |
visited | wall | visited | unvisited | false | false | true | west | |
unvisited | visited | unvisited | unvisited | false | false | true | north | |
wall | unvisited | visited | unvisited | false | false | true | west | |
unvisited | unvisited | unvisited | visited | false | true | false | west | |
unvisited | unvisited | unvisited | visited | false | false | false | east | |
unvisited | wall | visited | unvisited | false | false | false | west | |
wall | wall | visited | unvisited | false | false | true | west | |
wall | wall | visited | unvisited | false | false | false | west | |
visited | wall | wall | unvisited | false | false | false | south |
library(caret) | |
# function to set up random seeds | |
setSeeds <- function(method = "cv", numbers = 1, repeats = 1, tunes = NULL, seed = 1237) { | |
#B is the number of resamples and integer vector of M (numbers + tune length if any) | |
B <- if (method == "cv") numbers | |
else if(method == "repeatedcv") numbers * repeats | |
else NULL | |
if(is.null(length)) { | |
seeds <- NULL | |
} else { | |
set.seed(seed = seed) | |
seeds <- vector(mode = "list", length = B) | |
seeds <- lapply(seeds, function(x) sample.int(n = 1000000, size = numbers + ifelse(is.null(tunes), 0, tunes))) | |
seeds[[length(seeds) + 1]] <- sample.int(n = 1000000, size = 1) | |
} | |
# return seeds | |
seeds | |
} | |
seed <- 1002 | |
number <- 4 | |
method <- 'cv' | |
cvSeeds <- setSeeds(method = method, numbers = number, tunes = 3, seed = seed) | |
# Control list for model training. | |
myControl <- trainControl(method = method, number = number, seeds = cvSeeds) | |
# Split the data into a training/test set by 70% training/30% test. | |
data <- read.csv('wumpus-1.csv') | |
inTrain <- createDataPartition(y = data$move, p=0.7, list=FALSE) | |
training <- data[inTrain,] | |
test <- data[-inTrain,] | |
# SVM: Correct: 6/19 = 32% | |
fit <- train(move ~ ., data = training, method = 'svmRadial', trControl = myControl) | |
results <- predict(fit, newdata = test) | |
table(results, test$move) | |
data.frame(test, results, test$move == results) | |
print(paste0('Correct: ', length(which(test$move == results)), '/', nrow(test), ' = ', round(length(which(test$move == results)) / nrow(test) * 100), '%')) | |
# Logistic regression: Correct: 8/19 = 42% | |
fit <- train(move ~ ., data = training, method = 'multinom', trControl = myControl) | |
results <- predict(fit, newdata = test) | |
table(results, test$move) | |
data.frame(test, results, test$move == results) | |
print(paste0('Correct: ', length(which(test$move == results)), '/', nrow(test), ' = ', round(length(which(test$move == results)) / nrow(test) * 100), '%')) | |
# K-nearest-neighbors: Correct: 10/19 = 53% | |
fit <- train(move ~ ., data = training, method = 'knn', trControl = myControl) | |
results <- predict(fit, newdata = test) | |
table(results, test$move) | |
data.frame(test, results, test$move == results) | |
print(paste0('Correct: ', length(which(test$move == results)), '/', nrow(test), ' = ', round(length(which(test$move == results)) / nrow(test) * 100), '%')) | |
# Random Forest: Correct: 16/19 = 84% | |
fit <- train(move ~ ., data = training, method = 'rf', trControl = myControl) | |
results <- predict(fit, newdata = test) | |
table(results, test$move) | |
data.frame(test, results, test$move == results) | |
print(paste0('Correct: ', length(which(test$move == results)), '/', nrow(test), ' = ', round(length(which(test$move == results)) / nrow(test) * 100), '%')) | |
# Regularized Random Forest: Correct: 16/19 = 84% | |
fit <- train(move ~ ., data = training, method = 'RRF', trControl = myControl) | |
results <- predict(fit, newdata = test) | |
table(results, test$move) | |
data.frame(test, results, test$move == results) | |
print(paste0('Correct: ', length(which(test$move == results)), '/', nrow(test), ' = ', round(length(which(test$move == results)) / nrow(test) * 100), '%')) | |
# Finally, train a model on the entire data-set so we can play the game: Correct: 67/68 = 99% | |
fit <- train(move ~ ., data = data, method = 'rf') | |
results <- predict(fit, newdata = data) | |
table(results, data$move) | |
data.frame(data, results, data$move == results) | |
print(paste0('Correct: ', length(which(data$move == results)), '/', nrow(data), ' = ', round(length(which(data$move == results)) / nrow(data) * 100), '%')) | |
# Manual test. | |
custom <- data.frame(room_n='visited', room_e='visited', room_s='visited', room_w='unvisited', breeze='false', stench='false', glitter='true') | |
predict(fit, newdata=custom) | |
# ^^ west (unvisited room) | |
# Actual play of the game. | |
custom <- data.frame(room_n='unvisited', room_e='unvisited', room_s='wall', room_w='wall', breeze='false', stench='false', glitter='false') | |
predict(fit, newdata=custom) | |
custom <- data.frame(room_n='unvisited', room_e='unvisited', room_s='visited', room_w='wall', breeze='true', stench='false', glitter='false') | |
predict(fit, newdata=custom) | |
custom <- data.frame(room_n='visited', room_e='unvisited', room_s='wall', room_w='wall', breeze='false', stench='false', glitter='false') | |
predict(fit, newdata=custom) | |
custom <- data.frame(room_n='unvisited', room_e='unvisited', room_s='wall', room_w='visited', breeze='true', stench='false', glitter='false') | |
predict(fit, newdata=custom) | |
# Example run of actual game from starting position. | |
# > custom <- data.frame(room_n='unvisited', room_e='unvisited', room_s='wall', room_w='wall', breeze='false', stench='false', glitter='false') | |
# > predict(fit, newdata=custom) | |
# [1] north | |
# Levels: east north south west | |
# ^^^ This is correct behavior, moving north when no obstacles detected. | |
# > custom <- data.frame(room_n='unvisited', room_e='unvisited', room_s='visited', room_w='wall', breeze='true', stench='false', glitter='false') | |
# > predict(fit, newdata=custom) | |
# [1] south | |
# Levels: east north south west | |
# ^^^ This is correct behavior, moving back to the south room since a breeze was detected. | |
# > custom <- data.frame(room_n='visited', room_e='unvisited', room_s='wall', room_w='wall', breeze='false', stench='false', glitter='false') | |
# > predict(fit, newdata=custom) | |
# [1] east | |
# Levels: east north south west | |
# ^^^ This is correct behavior, moving east to a newly unvisited room since we've already been north. | |
# > custom <- data.frame(room_n='unvisited', room_e='unvisited', room_s='wall', room_w='visited', breeze='true', stench='false', glitter='false') | |
# > predict(fit, newdata=custom) | |
# [1] west | |
# Levels: east north south west | |
# ^^^ This is expected behavior, moving back to the west since a breeze was detected. |
Sign up for free
to join this conversation on GitHub.
Already have an account?
Sign in to comment