Commit 42220fdd authored by Corson N. Areshenkoff's avatar Corson N. Areshenkoff

Start Table class

parent 82bdf831
Table <- R6Class("Table", public = list(
num.decks = NA,
decks = NULL,
names = NULL,
choice.history = NULL,
reward.history = NULL,
num.trials = 0,
initialize = function(decks, deck.names = NA) {
# Verify input is either a deck, or a list of decks
if ('Deck' %in% class(decks)) {
self$num.decks <- 1
# Check that only a single name was provided, or set default if NA
if (is.na(deck.names)) {
default.names <- '1'
} else if (is.character(deck.names) && length(deck.names) == 1) {
default.names <- deck.names
} else {
stop('deck.names must be a character vector of length equal to the number of decks')
}
self$names <- default.names
self$decks <- list(decks)
} else if ('list' %in% class(decks)) {
# Check that all list elements are decks
if (!all(sapply(decks, function(i) 'Deck' %in% class(i)))){
stop('If a list, all elements of decks must be of class Deck')
}
# Check that deck.names is admissible
if (is.na(deck.names)) {
default.names <- as.character(1:length(decks))
} else if (is.character(deck.names) && length(deck.names) == length(decks)) {
default.names <- deck.names
} else {
stop('deck.names must be a character vector of length equal to the number of decks')
}
if (length(unique(d)) != length(d)) {
stop('Deck names must be unique')
}
self$names <- default.names
self$num.decks <- length(decks)
self$decks <- decks
}
# Set deck history
self$choice.history <- numeric(0)
self$reward.history <- numeric(0)
invisible(self)
},
get.history = function() {
df <- data.frame(Choice = self$choice.history,
Reward = self$choice.history)
return(df)
},
reset = function() {
# Reset deck history
self$choice.history <- numeric(0)
self$reward.history <- numeric(0)
# Reset decks
for (i in 1:num.decks) {
self$decks[[i]]$reset()
}
invisible(self)
},
draw.card = function(d = NA, p = NA) {
if (is.na(d)) {
# If p = NA, choose uniformly at random
if (is.na(p)) {
p <- rep(1, self$num.decks) / self$num.decks
}
# Else, check if p is admissible
if (class(p) != 'numeric' || length(p) != self$num.decks) {
stop('p must be a numeric vector of length num.decks')
}
if (any(p < 0) || !isTRUE(all.equal(sum(p), 1)) ) {
stop('p must be a probability vector')
}
# Select a card
sel <- sample(1:self$num.cards, 1, prob = p)
} else {
if (is.character(d)) {
if(!d %in% self$deck.names) {
stop('d does not correspond to any deck name')
}
idx <- which(self$deck.names == d)
} else if (is.numeric(d)) {
if (d %% 1 != 0) {
stop('d is not an integer')
} else if (d < 0 || d > self$num.decks) {
stop('d is out of bounds')
}
sel <- d
}
}
# Select card
self$decks[[sel]]$draw()
self$choice.history <- c(self$choice.history, names(self$deck.names)[idx])
self$reward.history <- c(self$reward.history, self$decks[[idx]]$get.top.card())
invisible(self)
}
))
\ No newline at end of file
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment