R Shiny：在 tabPanel 之间切换会导致错误
R Shiny: Switching between tabPanels causes errors
我创建了一个应用程序，它将使用随机森林模型来预测 Iris 数据集中的物种类型。这个想法是用户可以 select 使用 input widgets 其他变量的值，然后模型使用它来给出预测。这一切都很好。
我最近决定实现一个包含不同输入、时间戳和估计的日志。我已将此日志放在另一个 tabPanel 中以提供更好的概览。一切正常，当我点击保存按钮时，输入、时间戳和估计被保存在日志中，但是，当我回到原来的 tabPanel（“计算器”）时，出现错误说列数不匹配（或类似的东西，我从丹麦语翻译而来）。
有谁知道为什么会出现这个问题以及如何解决？
我在使用 R 中的“运行 应用程序”按钮 运行 时也遇到了问题。当我 select 使用 ctrl+A 并按下 ctrl 时，它工作正常+输入 运行 代码。
这是我的代码：
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)
在创建反应式 AllInputs 时，您正在 id_include 上进行循环。
问题是所有 input[[i]] 的长度都不是 1：它们可以是 NULL 或长度大于 1。
不能对两个不同长度的变量使用 cbind，这会导致错误。
所以我在计算 myvalues 之前添加了一个条件，一切正常:
# 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))
}
})
顺便说一句，for 循环在 R 中不是很好的做法，您可能想看看 apply 系列函数。
我创建了一个应用程序，它将使用随机森林模型来预测 Iris 数据集中的物种类型。这个想法是用户可以 select 使用 input widgets 其他变量的值，然后模型使用它来给出预测。这一切都很好。
我最近决定实现一个包含不同输入、时间戳和估计的日志。我已将此日志放在另一个 tabPanel 中以提供更好的概览。一切正常，当我点击保存按钮时，输入、时间戳和估计被保存在日志中，但是，当我回到原来的 tabPanel（“计算器”）时，出现错误说列数不匹配（或类似的东西，我从丹麦语翻译而来）。
有谁知道为什么会出现这个问题以及如何解决？
我在使用 R 中的“运行 应用程序”按钮 运行 时也遇到了问题。当我 select 使用 ctrl+A 并按下 ctrl 时，它工作正常+输入 运行 代码。
这是我的代码：
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)
在创建反应式 AllInputs 时，您正在 id_include 上进行循环。
问题是所有 input[[i]] 的长度都不是 1：它们可以是 NULL 或长度大于 1。
不能对两个不同长度的变量使用 cbind，这会导致错误。
所以我在计算 myvalues 之前添加了一个条件，一切正常:
# 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))
}
})
顺便说一句，for 循环在 R 中不是很好的做法，您可能想看看 apply 系列函数。