I have a dashboard where user can upload an .xlsx file and then select columns. Moreover, you can select another column from global variable. If the 2nd column's values don't match to first column, then the cells of 2nd column's row get highlighted. On the start of the application, things work well, but when I select columns again and hit the action button, I see this error in the console Warning: Error in : Can't extract columns that don't exist. But again, as soon as I hit the action button datatable renders in the mainPanel just fine.
My dput of iris.xlsx looks like this-
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")
Here is my reprex-
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)
Thank you for your help.
There are couple of issues -
openxlsx::read.xlsx doesn't read the column names of the xlsx file. I have switched to readxl::read_excel.
When you select in the reactive expression it changes the data so the new columns are not available for next selection. Hence, you get the warning. Perform selection at the end while displaying the table in 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)