更改输入时闪亮会抛出警告:错误:无法提取不存在的列

Posted

技术标签:

【中文标题】更改输入时闪亮会抛出警告:错误:无法提取不存在的列【英文标题】:When changing input Shiny throws Warning: Error in : Can't extract columns that don't exist 【发布时间】:2021-09-26 11:17:27 【问题描述】:

我有一个仪表板,用户可以在其中上传 .xlsx 文件,然后选择列。此外,您可以从全局变量中选择另一列。如果第二列的值与第一列不匹配,则第二列行的单元格将突出显示。在应用程序启动时,一切正常,但是当我再次选择列并点击操作按钮时,我在控制台中看到此错误Warning: Error in : Can't extract columns that don't exist. 但同样,只要我点击操作按钮,数据表就会在@987654322 中呈现@就好了。

我的dputiris.xlsx 看起来像这样-

structure(list(date = structure(c(15706, 15707, 15708, 15723, 
15740, 15741, 15742, 15771, 15791, 15792, 15855), class = "Date"), 
    Sepal.Length = c(5.1, 4.9, 4.7, 5.1, 4.9, 5, 5.5, 6.7, 6, 
    6.7, 5.9), Sepal.Width = c(3.5, NA, NA, NA, NA, NA, NA, 3.1, 
    3.4, 3.1, 3), Petal.Length = c(1.4, 1.4, 1.3, 1.4, 1.5, 1.2, 
    1.3, 4.4, 4.5, 4.7, 5.1), Petal.Width = c(0.2, 0.2, 0.2, 
    0.3, 0.2, 0.2, 0.2, 1.4, 1.6, 1.5, 1.8), Species = c("setosa", 
    "setosa", "setosa", "setosa", "setosa", "setosa", "setosa", 
    "versicolor", "versicolor", "versicolor", "virginica")), row.names = c(NA, 
11L), class = "data.frame")

这是我的代表-

library(shiny)
library(openxlsx)
library(shinyjs)
library(htmltools)
library(lubridate)
library(DT)
library(dplyr)

#--------------------
#global.R

local_iris <- data.frame(Date= lubridate::mdy(c("1/1/2013","1/2/2013","3/27/2013","3/28/2013",
                                                "1/18/2013","2/4/2013","2/5/2013","2/6/2013")),
                         SPECLENTH= c(5.1,4.9,4.7,4.6,5,5.4,4.6,5.1),
                         SPECWIDTH= c(3,7,6, 8,8,9,5,1))

#-------------

ui <- fluidPage(
  
  sidebarLayout(
    sidebarPanel(
      
      fileInput("xlsxfile", "Choose an xlsx file",
                accept = c(".xlsx")),
      
      tags$hr(),
      
      
      # Input: Select number of rows to display ----
      selectInput("disp", "Display",
                  choices = c(All = "all",
                              Head = "head"),
                  selected = "all"),
      
      # Select variables to display ----
      uiOutput("checkbox"),
      uiOutput("checkbox_2"),
      tags$hr(),
      uiOutput("joinnow") # instead of conditionalPanel
    ),
    mainPanel(
      DT::DTOutput("contents")
    )
  )
)


server <- function(input, output) 
  
  # File handler ----
  mydata <- reactive(
    req(input$xlsxfile)
    inFile <- input$xlsxfile
    
    
    
    req(input$xlsxfile,
        file.exists(input$xlsxfile$datapath))
    
    openxlsx::read.xlsx(xlsxFile = inFile$datapath,
                        sheet = 1 ,
                        detectDates = TRUE,
                        sep.names = "_")
    
  )
  
  # Dynamically generate UI input when data is uploaded, only sow numeric columns ----
  output$checkbox <- renderUI(
    
    selectInput(inputId = "select_var", 
                label = "Select variables", 
                choices = c("", names(mydata() %>%
                                        dplyr::select_if(is.numeric))),
                selected = NULL, 
                multiple = FALSE)
  )
  
  # Select columns to print ----
  df_sel <- reactive(
    req(input$select_var)
    df_sel <- mydata() %>% 
      dplyr::select(input$select_var, date)
  )
  
  
  # Same as above but for global.R variable  ----
  output$checkbox_2 <- renderUI(
    
    if (is.null(mydata())) return(NULL)
    
    selectInput(inputId = "select_var_2", 
                label = "Select variables", 
                choices = c("", names(local_iris %>%
                                        dplyr::select_if(is.numeric))),
                selected = NULL, 
                multiple = FALSE)
  )
  
  
  df_sel_global <- reactive(
    
    req(input$select_var_2)
    
    df_sel_global <- local_iris %>% 
      dplyr::select(input$select_var_2, Date)
  )
  
  output$joinnow <- renderUI(
    if (is.null(input$xlsxfile)) return()
    actionButton("action", "Press after selecting variables")
  )
  
  # Join the dataframes together based on a key  ----
  joined_dfs <-  eventReactive(input$action, 
    
    df_joi <- dplyr::inner_join(df_sel(), df_sel_global(), by= c("date" = "Date")) %>%
      dplyr::select(date,input$select_var,input$select_var_2)
    
  )
  
  # Render data frame ----
  
  matched_val <- reactive( 
    req(input$action, input$select_var, input$select_var_2)
      ifelse(joined_dfs()%>%
               dplyr::pull(input$select_var) != joined_dfs()%>%
               dplyr::pull(input$select_var_2),
             yes= joined_dfs()%>%
               dplyr::pull(input$select_var_2),
             no= -979025189201)
  )
  
  
  output$contents <- DT::renderDT(server = FALSE, 
    
    req(input$action)
    
    DT::datatable(
      if(input$disp == "head") 
        head(joined_dfs())
      
      else 
        joined_dfs()
      , filter = 'top', 
      extensions = c('Buttons'),
      options = list(scrollY = 600,
                     scrollX = TRUE,
                     pageLength = 20,
                     dom =  '<"float-left"l><"float-right"f>rt<"row"<"col-sm-4"B><"col-sm-4"i><"col-sm-4"p>>',
                     lengthMenu=  list(c(20, 40, 60, -1), 
                                       c('20', '40', '60','All')),
                     scrollCollapse= TRUE,
                     lengthChange = TRUE, 
                     widthChange= TRUE,
                     rownames = TRUE)
    ) %>%
      formatStyle(
        columns = 3,
        backgroundColor = styleEqual(levels = matched_val(), values = rep("yellow", length(matched_val())))
      )
    
    
  )
  
  


# Run  ----
shinyApp(ui, server)

感谢您的帮助。

【问题讨论】:

【参考方案1】:

有几个问题-

    openxlsx::read.xlsx 不读取 xlsx 文件的列名。我已经切换到readxl::read_excel

    当您在反应式表达式中select 时,它会更改数据,因此新列不可用于下一次选择。因此,您会收到警告。在DT::renderDT 中显示表格时在最后执行选择。


local_iris <- data.frame(Date= lubridate::mdy(c("1/1/2013","1/2/2013","3/27/2013","3/28/2013",
                                                "1/18/2013","2/4/2013","2/5/2013","2/6/2013")),
                         SPECLENTH= c(5.1,4.9,4.7,4.6,5,5.4,4.6,5.1),
                         SPECWIDTH= c(3,7,6, 8,8,9,5,1))

#-------------

ui <- fluidPage(
  
  sidebarLayout(
    sidebarPanel(
      
      fileInput("xlsxfile", "Choose an xlsx file",
                accept = c(".xlsx")),
      
      tags$hr(),
      
      
      # Input: Select number of rows to display ----
      selectInput("disp", "Display",
                  choices = c(All = "all",
                              Head = "head"),
                  selected = "all"),
      
      # Select variables to display ----
      uiOutput("checkbox"),
      uiOutput("checkbox_2"),
      tags$hr(),
      uiOutput("joinnow") # instead of conditionalPanel
    ),
    mainPanel(
      DT::DTOutput("contents")
    )
  )
)


server <- function(input, output) 
  
  # File handler ----
  mydata <- reactive(
    req(input$xlsxfile)
    inFile <- input$xlsxfile
    
    req(input$xlsxfile,
        file.exists(input$xlsxfile$datapath))
    readxl::read_excel(inFile$datapath)
    
  )
  
  # Dynamically generate UI input when data is uploaded, only sow numeric columns ----
  output$checkbox <- renderUI(
    
    selectInput(inputId = "select_var", 
                label = "Select variables", 
                choices = c("", names(mydata() %>%
                                        dplyr::select_if(is.numeric))),
                selected = NULL, 
                multiple = FALSE)
  )
  
  # Select columns to print ----
  df_sel <- reactive(
    req(input$select_var)
    
    df_sel <- mydata() 
    df_sel
  )
  
  
  # Same as above but for global.R variable  ----
  output$checkbox_2 <- renderUI(
    
    if (is.null(mydata())) return(NULL)
    
    selectInput(inputId = "select_var_2", 
                label = "Select variables", 
                choices = c("", names(local_iris %>%
                                        dplyr::select_if(is.numeric))),
                selected = NULL, 
                multiple = FALSE)
  )
  
  
  df_sel_global <- reactive(
    req(input$select_var_2)
    local_iris 
  )
  
  output$joinnow <- renderUI(
    if (is.null(input$xlsxfile)) return()
    actionButton("action", "Press after selecting variables")
  )
  
  # Join the dataframes together based on a key  ----
  joined_dfs <-  eventReactive(input$action, 
    df_joi <- dplyr::inner_join(df_sel(), df_sel_global(), by= c("date" = "Date")) 
    df_joi
    
  )
  
  # Render data frame ----
  
  matched_val <- reactive( 
    req(input$action, input$select_var, input$select_var_2)
    ifelse(joined_dfs()%>%
             dplyr::pull(input$select_var) != joined_dfs()%>%
             dplyr::pull(input$select_var_2),
           yes= joined_dfs()%>%
             dplyr::pull(input$select_var_2),
           no= -979025189201)
  )
  
  
  output$contents <- DT::renderDT(server = FALSE, 
    
    req(input$action)
    
    DT::datatable(
      if(input$disp == "head") 
        head(joined_dfs()%>%
          dplyr::select(date,input$select_var,input$select_var_2))
      
      else 
        joined_dfs() %>%
          dplyr::select(date,input$select_var,input$select_var_2)
      , filter = 'top', 
      extensions = c('Buttons'),
      options = list(scrollY = 600,
                     scrollX = TRUE,
                     pageLength = 20,
                     dom =  '<"float-left"l><"float-right"f>rt<"row"<"col-sm-4"B><"col-sm-4"i><"col-sm-4"p>>',
                     lengthMenu=  list(c(20, 40, 60, -1), 
                                       c('20', '40', '60','All')),
                     scrollCollapse= TRUE,
                     lengthChange = TRUE, 
                     widthChange= TRUE,
                     rownames = TRUE)
    ) %>%
      formatStyle(
        columns = 3,
        backgroundColor = styleEqual(levels = matched_val(), values = rep("yellow", length(matched_val())))
      )
    
    
  )
  
  


# Run  ----
shinyApp(ui, server)

【讨论】:

嗨罗纳克!谢谢您的帮助。此方法使action 按钮在初次使用后变得毫无意义。在文件上传后每次选择后,表格会立即加载/更新,而无需点击按钮。在这种情况下,我应该删除按钮——现在没有意义。少一件事点击效果更好。 您认为在初始上传后我们仍然可以使用“按下按钮显示表格”功能吗?我把它放在那里的原因是原始数据集中的一些不一致的列。所以按钮背后的想法是,在用户选择列之后,他们可能会在点击按钮之前检查他们的选择——导致连接在重要的列上正常工作。 在您的情况下,彼此之间有太多的反应性依赖关系,但通常我会在observeEvent(input$action ...) 中加载output$contents,因此单击操作按钮时输出会发生变化。 哦,我明白你的意思了。该死的,希望我能设计得更好。无论如何,感谢您的帮助伙伴。保重 :) 再次感谢您!

以上是关于更改输入时闪亮会抛出警告:错误:无法提取不存在的列的主要内容,如果未能解决你的问题,请参考以下文章

如果文件不存在,fs.statSync 会抛出错误

为啥即使元素存在,硒也会抛出未找到元素的错误? [复制]

为啥 MERGE 语句会抛出唯一键约束错误

Vue 警告我无法在未定义、null 或原始值上设置反应属性:null

无法在php中更改日期格式[重复]

为啥 MediaPlayer 在创建它的实例时会抛出 NOT present 错误?