UPDATED: An example of the problem is shown below the code for the app
I'm building an dynamic ML app where the user can upload a dataset to get a prediction of the first column in the dataset (the response variable should be located in column 1 of the uploaded dataset). The user can select a value for the variables in the uploaded dataset and get a prediction of the response variable.
I'm currently trying to create a datatable that stores all the selected values, timestamp and the prediction.
The table is suppose to store the previous saved values, but only for that perticular dataset. By this I mean that if I save values from the iris dataset, the table uses the variables from the iris dataset as columns. This causes problems when uploading another dataset and saving those values, since the columns from the iris dataset would still be there and not the variables/columns from the new dataset.
My question is: How do I create a unique datatable for each dataset uploaded to the app?
If this sound confusion, try to run the app, calculate a prediction and save the data. Do this for two different datasets and look at the datatable under the "log" tab.
If you don't have two datasets, you can use these two datasets, they are build into R as default and already have the response variable positioned in column 1.
write_csv(attitude, "attitude.csv")
write_csv(ToothGrowth, "ToothGrowth.csv")
You will find the code regarding the datatable under the 'Create the log' section in the server function.
This is the code for the app:
library(shiny)
library(tidyverse)
library(shinythemes)
library(data.table)
library(RCurl)
library(randomForest)
library(mlbench)
library(janitor)
library(caret)
library(recipes)
library(rsconnect)
# UI -------------------------------------------------------------------------
ui <- fluidPage(
navbarPage(title = "Dynamic ML Application",
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("datatable18", width = 300),
), # End tabPanel "Log"
tabPanel("Upload file",
br(),
sidebarPanel(
fileInput(inputId = "file1", label="Upload file"),
checkboxInput(inputId ="header", label="header", value = TRUE),
checkboxInput(inputId ="stringAsFactors", label="stringAsFactors", value = TRUE),
radioButtons(inputId = "sep", label = "Seperator", choices = c(Comma=",",Semicolon=";",Tab="\t",Space=" "), selected = ","),
radioButtons(inputId = "disp", "Display", choices = c(Head = "head", All = "all"), selected = "head"),
), # End sidebarPanel
mainPanel(
tableOutput("contents")
)# End mainPanel
) # EndtabPanel "upload file"
) # End tabsetPanel
) # End UI bracket
# Server -------------------------------------------------------------------------
server <- function(input, output, session) {
# Upload file content table
get_file_or_default <- reactive({
if (is.null(input$file1)) {
paste("No file is uploaded yet")
} else {
df <- read.csv(input$file1$datapath,
header = input$header,
sep = input$sep,
quote = input$quote)
if(input$disp == "head") {
return(head(df))
}
else {
return(df)
}
}
})
output$contents <- renderTable(get_file_or_default())
# Create input widgets from dataset
output$select <- renderUI({
req(input$file1)
if (is.null(input$file1)) {
"No dataset is uploaded yet"
} else {
df <- read.csv(input$file1$datapath,
header = input$header,
sep = input$sep,
quote = input$quote)
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({
req(input$file1)
if (is.null(input$file1)) {
} else {
DATA <- read.csv(input$file1$datapath,
header = input$header,
sep = input$sep,
quote = input$quote)
}
id_exclude <- c("savebutton","submitbutton","file1","header","stringAsFactors","input_file","sep","contents","head","disp")
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))
}
})
# render table of selected values to be displayed
output$show_inputs <- renderTable({
if (is.null(input$file1)) {
paste("No dataset is uploaded yet.")
} else {
AllInputs()
}
})
# Creating a dataframe for calculating a prediction
datasetInput <- reactive({
req(input$file1)
DATA <- read.csv(input$file1$datapath,
header = input$header,
sep = input$sep,
quote = input$quote)
DATA <- as.data.frame(unclass(DATA), stringsAsFactors = TRUE)
response <- names(DATA[1])
model <- randomForest(eval(parse(text = paste(names(DATA)[1], "~ ."))),
data = DATA, ntree = 500, mtry = 3, importance = TRUE)
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("datatable18")) {
datatable18 <<- rbind(datatable18, data)
} else {
datatable18 <<- data
}
}
loadData <- function() {
if (exists("datatable18")) {
datatable18
}
}
# Whenever a field is filled, aggregate all form data
formData <- reactive({
DATA <- read.csv(input$file1$datapath,
header = input$header,
sep = input$sep,
quote = input$quote)
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$datatable18 <- DT::renderDataTable({
input$savebutton
loadData()
})
} # End server bracket
# ShinyApp -------------------------------------------------------------------------
shinyApp(ui, server)
UPDATED HERE
To get an idea about how the problem occurs take a look at this:
I upload the iris dataset to the application.
I then make some predictions and save them.
The predictions, as well as the selected inputs and a timestamp of when the save-button was pressed can now be seen under the "Log" tab.
I upload a new dataset (attitude), which of course have different variables included (attitude dataset has 7 variables total, iris dataset has 5).
I calculate a prediction, hit the save button and the app crashes. This happens because the number of columns in the dataset now has changed, so I get this errormessage:
Error in rbind: numbers of columns of arguments do not match
This can be fixed by renaming the datatable object in the server, since this creates a new datatable without any specified columns yet. But as soon as the Save button is pressed for the first time, the datatable locks-in the columns so they can't be changed again.
I can still access the old datatables if I switch the name of the datatable in the server function back the original name. So I'm thinking that if the name of the datatable object can be dynamic dependend on the dataset uploaded to the app, then the correct datatable can be shown.
So I think a better question could be: How do I create a dynamic/reactive datatable output object
