Commit 82bdf831 authored by Corson N. Areshenkoff's avatar Corson N. Areshenkoff

Add Deck class

parent 6ff7b698
library(R6)
x <- function() {rnorm(1,0,1)}
x <- c(1,1,0,1,0,0,.2,.5)
d <- Deck$new(x, selection.rule = 'replacement')
d$draw()
Deck <- R6Class("Deck", public = list(
slot.type = NA,
selection.rule = NA,
num.cards = NA,
expected.value = NA,
variance = NA,
slot = NA,
selected.cards = NA,
top.card = NA,
# Initialization
initialize = function(x, selection.rule = NA) {
if (is.function(x)) {
# Verify that x returns numeric values
test.draw <- x()
if (!is.numeric(test.draw) || length(test.draw) != 1) {
stop('If a function, x must return a single numeric value')
}
# Set deck properties
r.sample <- sapply(1:1000, function(i) x())
self$expected.value <- mean(r.sample)
self$variance <- var(r.sample)
self$slot.type <- 'rng'
self$slot <- x
self$num.cards <- Inf
self$selection.rule <- NULL
self$selected.cards <- NULL
invisible(self)
} else if (is.numeric(x)) {
# Verify that x contains real numbers, with no missing values.
if (!is.numeric(x)) {
stop('If not a function, x must be a numeric vector')
} else if (any(is.na(x) | is.nan(x) | is.null(x))) {
stop('If not a function, x must not contain any missing values')
}
# Set deck properties
self$num.cards <- length(x)
self$expected.value <- mean(x)
self$variance <- var(x)
self$slot.type <- 'cards'
self$slot <- x
# Verify selection rule
if (!is.character(selection.rule)) {
stop('Must specify selection.rule if x is numeric')
}
if (!selection.rule %in%
c('sequential', 'replacement', 'noreplacement')) {
stop('Unrecognized selection rule')
}
self$selection.rule <- selection.rule
self$selected.cards <- logical(self$num.cards)
invisible(self)
}},
# Reset the deck. Has no effect unless deck type is 'cards' and
# selection.rule is either 'sequential' or 'noreplacement'
reset = function() {
if (self$slot.type == 'cards' &&
self$selection.rule %in% c('sequential', 'noreplacement')) {
self$selected.cards <- logical(self$num.cards)
}
invisible(self)
},
# Draw a card
draw = function() {
# If rng-type, just output a random draw from $slot()
if (self$slot.type == 'rng') {
self$top.card <- self$slot()
invisible(self)
}
# Otherwise, draw a card depending on selection.rule
if (self$slot.type == 'cards') {
# If selection.rule == 'replacement', just draw a card
if (self$selection.rule == 'replacement') {
self$top.card <- self$slot[sample(1:self$num.cards, 1)]
invisible(self)
}
# Otherwise, check if any cards remain, and reset if not
if (all(self$selected.cards)) {
self$reset()
}
# Then pick a card...
if (self$selection.rule == 'sequential') {
idx <- which(!self$selected.cards)[1]
self$selected.cards[idx] <- TRUE
self$top.card <- self$slot[idx]
invisible(self)
} else if (self$selection.rule == 'noreplacement') {
idx <- which(!self$selected.cards)
sel <- sample(idx, 1)
self$selected.cards[sel] <- TRUE
self$top.card <- self$slot[sel]
invisible(self)
}
}
},
# Query top card
get.top.card = function() {
return(self$top.card)
}
))
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