我有一个仪表板，用户可以在其中上传 .xlsx 文件，然后选择列。此外，您可以从全局变量中选择另一列。如果第二列的值与第一列不匹配，则第二列行的单元格将突出显示。在应用程序启动时，一切正常，但是当我再次选择列并点击操作按钮时，我在控制台中看到此错误 警告:错误:无法提取不存在的列。 但同样，只要我点击操作按钮，数据表就会在 mainPanel 中呈现。
我的 iris.xlsx 的 dput 看起来像这样-
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)
感谢您的帮助。
最佳答案
有几个问题-
openxlsx::read.xlsx不读取 xlsx 文件的列名。我已切换到readxl::read_excel。当您在响应式(Reactive)表达式中
选择时，它会更改数据，因此新列不可用于下一次选择。因此，您会收到警告。在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)
关于r - 更改输入时 Shiny 抛出警告 : Error in : Can't extract columns that don't exist，我们在Stack Overflow上找到一个类似的问题： https://stackoverflow.com/questions/68429537/