model_input <- function (x, ...) {
UseMethod("model_input")
}
model_input.factor <- function(x, id = NULL){
if(is.null(id)) id = deparse(substitute(x))
l = levels(x)
if(length(l) > 5) {
return(
shiny::selectInput(id, label = id,
choices = as.list(l),
selected = l[1])
)
}
else {
return(
shiny::radioButtons(id, label = id,
choices = as.list(l),
selected = l[1])
)
}
}
model_input.logical <- function(x, id = NULL){
#logical not working - test
if(is.null(id)) id = deparse(substitute(x))
l = c('FALSE', 'TRUE')
shiny::radioButtons(id, label = id,
choices = as.list(l),
selected = l[1])
}
model_input.numeric <- function(x , id = NULL){
if(is.null(id)) id = deparse(substitute(x))
shiny::sliderInput(id, label = id, min = min(x), max = max(x), value = median(x))
}
model_input.poly <- function(x , id = NULL){
#to do - need to extract name of variable
if(is.null(id)) id = deparse(substitute(x))
shiny::sliderInput(id, label = id, min = min(x), max = max(x), value = median(x))
}
#todo: model_input.default
get_new_data <- function(model_data, ids, input ){
#creates a list of each variable entered by the user
data_new = plyr::alply(1:length(ids), 1, function(i){
input[[ ids[i] ]]
})
#turns list into data.frame
data_new = as.data.frame(data_new)
#an error is occurring here for some reason
if(length(names(data_new)) != length(names(model_data))) return(NULL)
names(data_new) <- names(model_data)
for(i in 1:ncol(model_data)){
if( is.factor(model_data[[i]] )){
data_new[[i]] <- factor(data_new[[i]], levels = levels(model_data[[i]]))
}
if( is.logical(model_data[[i]] )){
data_new[[i]] <- as.logical(data_new[[i]])
}
}
data_new
}
Add the following code to your website.
For more information on customizing the embed code, read Embedding Snippets.