I have created an App that will use an randomforest model to predict the type of Species in the Iris dataset. The idea is that a user can select a value for the other varaibles using input widgets, which the model then use to give a prediction. This all works fine.
I recently decided to implement a log containing the different inputs, a timestamp and the estimation. I've placed this log in another tabPanel to give a better overview. Everything apperes to work fine, when I hit the save button, the inputs, timestamp and estimation are saved in the log, however, when I go back to the original tabPanel ("Calculator"), errors appear saying that the number of columns doesn't match (or something like that, I have translated it from danish).
Does anyone know why this problem occours and how to fix it?
Im also having trouble running the app by using the "Run App" button in R. It works fine when I select everything with ctrl+A and hit ctrl+enter to run the code.
Here is my code:
require(shiny)
require(tidyverse)
require(shinythemes)
require(data.table)
require(RCurl)
require(randomForest)
require(mlbench)
require(janitor)
require(caret)
require(recipes)
require(rsconnect)
# Read data
DATA <- datasets::iris
# Rearrange data so the response variable is located in column 1
DATA <- DATA[,c(names(DATA)[5],names(DATA)[-5])]
# Creating a model
model <- randomForest(DATA$Species ~ ., data = DATA, ntree = 500, mtry = 3, importance = TRUE)
.# UI -------------------------------------------------------------------------
ui <- fluidPage(
navbarPage(title = "Dynamic Calculator",
tabPanel("Calculator",
sidebarPanel(
h3("Values Selected"),
br(),
tableOutput('show_inputs'),
hr(),
actionButton("submitbutton", label = "calculate", class = "btn btn-primary", icon("calculator")),
actionButton("savebutton", label = "Save", icon("save")),
hr(),
tableOutput("tabledata")
), # End sidebarPanel
mainPanel(
h3("Variables"),
uiOutput("select")
) # End mainPanel
), # End tabPanel Calculator
tabPanel("Log",
br(),
DT::dataTableOutput("datatable15", width = 300),
) # End tabPanel "Log"
) # End tabsetPanel
) # End UI bracket
# Server -------------------------------------------------------------------------
server <- function(input, output, session) {
# Create input widgets from dataset
output$select <- renderUI({
df <- req(DATA)
tagList(map(
names(df[-1]),
~ ifelse(is.numeric(df[[.]]),
yes = tagList(sliderInput(
inputId = paste0(.),
label = .,
value = mean(df[[.]], na.rm = TRUE),
min = round(min(df[[.]], na.rm = TRUE),2),
max = round(max(df[[.]], na.rm = TRUE),2)
)),
no = tagList(selectInput(
inputId = paste0(.),
label = .,
choices = sort(unique(df[[.]])),
selected = sort(unique(df[[.]]))[1],
))
) # End ifelse
)) # End tagList
})
# creating dataframe of selected values to be displayed
AllInputs <- reactive({
id_exclude <- c("savebutton","submitbutton")
id_include <- setdiff(names(input), id_exclude)
if (length(id_include) > 0) {
myvalues <- NULL
for(i in id_include) {
myvalues <- as.data.frame(rbind(myvalues, cbind(i, input[[i]])))
}
names(myvalues) <- c("Variable", "Selected Value")
myvalues %>%
slice(match(names(DATA[,-1]), Variable))
}
})
# render table of selected values to be displayed
output$show_inputs <- renderTable({
AllInputs()
})
# Creating a dataframe for calculating a prediction
datasetInput <- reactive({
df1 <- data.frame(AllInputs(), stringsAsFactors = FALSE)
input <- transpose(rbind(df1, names(DATA[1])))
write.table(input,"input.csv", sep=",", quote = FALSE, row.names = FALSE, col.names = FALSE)
test <- read.csv(paste("input.csv", sep=""), header = TRUE)
# Defining factor levels for factor variables
cnames <- colnames(DATA[sapply(DATA,class)=="factor"])
if (length(cnames)>0){
lapply(cnames, function(par) {
test[par] <<- factor(test[par], levels = unique(DATA[,par]))
})
}
# Making the actual prediction and store it in a data.frame
Prediction <- predict(model,test)
Output <- data.frame("Prediction"=Prediction)
print(format(Output, nsmall=2, big.mark=","))
})
# display the prediction when the submit button is pressed
output$tabledata <- renderTable({
if (input$submitbutton>0) {
isolate(datasetInput())
}
})
# -------------------------------------------------------------------------
# Create the Log
saveData <- function(data) {
data <- as.data.frame(t(data))
if (exists("datatable15")) {
datatable15 <<- rbind(datatable15, data)
} else {
datatable15 <<- data
}
}
loadData <- function() {
if (exists("datatable15")) {
datatable15
}
}
# Whenever a field is filled, aggregate all form data
formData <- reactive({
fields <- c(colnames(DATA[,-1]), "Timestamp", "Prediction")
data <- sapply(fields, function(x) input[[x]])
data$Timestamp <- as.character(Sys.time())
data$Prediction <- as.character(datasetInput())
data
})
# When the Submit button is clicked, save the form data
observeEvent(input$savebutton, {
saveData(formData())
})
# Show the previous responses
# (update with current response when Submit is clicked)
output$datatable15 <- DT::renderDataTable({
input$savebutton
loadData()
})
} # End server bracket
# ShinyApp -------------------------------------------------------------------------
shinyApp(ui, server)
When creating your reactive AllInputs, you are making a loop on id_include.
The problem is that all input[[i]] are not length 1 : they can be NULL or length more than one.
You cannot use a cbind on two variables of different lengths, which causes the mistake.
So I added a condition before calculating myvalues, and everything works fine :
# creating dataframe of selected values to be displayed
AllInputs <- reactive({
id_exclude <- c("savebutton","submitbutton")
id_include <- setdiff(names(input), id_exclude)
if (length(id_include) > 0) {
myvalues <- NULL
for(i in id_include) {
if(!is.null(input[[i]]) & length(input[[i]] == 1)){
myvalues <- as.data.frame(rbind(myvalues, cbind(i, input[[i]])))
}
}
names(myvalues) <- c("Variable", "Selected Value")
myvalues %>%
slice(match(names(DATA[,-1]), Variable))
}
})
By the way, for loops are not good practice in R, you may want to have a look at apply family functions.