【发布时间】：2021-03-12 10:03:29
【问题描述】：
已更新：应用代码下方显示了一个问题示例
我正在构建一个动态 ML 应用程序，用户可以在其中上传数据集以获取数据集中第一列的预测（响应变量应位于上传数据集的第 1 列）。用户可以为上传数据集中的变量选择一个值，并获得响应变量的预测。
我目前正在尝试创建一个存储所有选定值、时间戳和预测的数据表。
假设该表存储以前保存的值，但仅适用于该特定数据集。我的意思是，如果我保存 iris 数据集中的值，该表将使用 iris 数据集中的变量作为列。这会在上传另一个数据集并保存这些值时导致问题，因为来自 iris 数据集的列仍然存在，而不是来自新数据集的变量/列。
我的问题是：如何为上传到应用程序的每个数据集创建一个唯一的数据表？
如果这听起来很混乱，请尝试运行应用程序，计算预测并保存数据。对两个不同的数据集执行此操作，然后查看“日志”选项卡下的数据表。
如果您没有两个数据集，您可以使用这两个数据集，它们默认构建在 R 中，并且响应变量已经位于第 1 列。
write_csv(attitude, "attitude.csv")
write_csv(ToothGrowth, "ToothGrowth.csv")
您将在服务器函数的“创建日志”部分下找到有关数据表的代码。
这是应用程序的代码：
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)
在此更新
要了解问题是如何发生的，请查看以下内容：
-
我计算了一个预测，点击了保存按钮，应用程序崩溃了。发生这种情况是因为数据集中的列数现在发生了变化，所以我收到以下错误消息：
Error in rbind: numbers of columns of arguments do not match
这可以通过重命名服务器中的数据表对象来解决，因为这会创建一个没有任何指定列的新数据表。但是一旦第一次按下Save button，数据表就会锁定列，因此不能再次更改它们。
如果我将服务器函数中的数据表名称切换回原始名称，我仍然可以访问旧数据表。所以我在想，如果数据表对象的名称可以动态依赖于上传到应用程序的数据集，那么可以显示正确的数据表。
所以我认为一个更好的问题可能是：如何创建动态/反应式数据表输出对象
【问题讨论】：
-
(1) 这是对
require的错误使用，请参阅stackoverflow.com/a/51263513/3358272。 (2) 如果多人使用真实的文件名会导致这种不可预测（无用），我建议使用tempfile(fileext=".csv")来存储它们；更好的是，可以考虑将 sqlite 或 duckdb 用于微不足道的甚至是内存数据库，它们都非常适合这种类型的使用。 -
哦，在搞砸了潜在的解决方案后，我忘记删除 req() 了。我对创建数据库和临时文件很陌生，你有关于如何使用它们的链接吗？或者你能告诉我应该如何在我的代码中实现它？
-
一个好的是shiny.rstudio.com/articles/persistent-data-storage.html。它讨论了几个选项：基于文件的、DBMS 和非关系“数据库”（例如 mongodb、redis）。如果这是低用户数，我会从小处着手。
-
明确地说，我是在评论您对
require(.)的使用，而不是req(.)，这是两件截然不同的事情。 （粗略一看，您使用req(.)看起来很合适。） -
我使用了
require()函数，因为它暂时修复了一个现在已经修复的问题，所以我再次全部改回library()。感谢文章的链接！我当前的数据表日志实际上已经受到那篇文章的启发，但我似乎不记得那篇文章谈到了我在帖子中描述的具体问题。我遇到的问题是该表试图将新数据集中的数据输入存储在包含旧列的旧数据集中。我正在尝试为上传到应用程序的每个数据集创建一个唯一的数据表。这篇文章有提到过吗？