R Shiny：在tabPanels之间切换会导致错误

Question

我创建了一个应用程序，它将使用随机森林模型来预测鸢尾花数据集中的物种类型。这个想法是，用户可以使用input widgets 为其他变量选择一个值，然后模型使用该值进行预测。这一切都很好。

我最近决定实现一个包含不同输入、时间戳和估计的日志。我已将此日志放在另一个 tabPanel 中以提供更好的概览。一切正常，当我点击保存按钮时，输入、时间戳和估计值都保存在日志中，但是，当我回到原来的tabPanel（“计算器”）时，出现错误，提示列不匹配（或类似的东西，我已经从丹麦语翻译过来了）。

有谁知道为什么会出现这个问题以及如何解决它？

我在使用 R 中的“运行应用程序”按钮运行应用程序时也遇到了问题。当我使用 ctrl+A 选择所有内容并按 ctrl+enter 运行代码时，它工作正常。

这是我的代码：

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)

Answer 1

在创建反应式AllInputs 时，您正在对 id_include 进行循环。 问题是所有 input[[i]] 的长度都不是 1 ：它们可以是 NULL 或长度超过一。 您不能对两个不同长度的变量使用 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 系列函数。