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.
