I have a shiny app with multiple tabs where I need to upload a data from a .xlsx file. After the file is uploaded, “n” number of tabs are displayed depending on the number of worksheets (n) in excel. In each tab, you can plot the x value and multiple y values depending on the worksheet you select
Here is the sample app and the sample excel data (save_state_data.xlsx) to upload
https://filebin.net/9a9miurr5iwytjc4/save_state_data.xlsx
I opened the app in a browser, plotted the graphs and saved as complete html webpage, it still does not render the state properly. What is the best way to do it? Maybe bookmarks – but I am not sure how to use them for multi tabs and an excel file upload
Create a function for a stacked plot
plotly_stacked <- function(df, x_colName, cols){
DF <- df[, cols] %>%
tidyr::gather(variable, value, -x_colName ) %>%
transform(id = as.integer(factor(variable)))
DF$variable<- factor( DF$variable, levels = unique( DF$variable))
p <- plot_ly(data = DF, x = ~get(names(DF[1])) , y = ~value, color = ~variable, colors = "Dark2",
yaxis = ~paste0( "y",sort(id, decreasing = F))) %>%
add_lines() %>%
layout(
xaxis = list(
title = ""),
legend = list(
orientation = "h",
xanchor = "center",
x = 0.5)) %>%
plotly::subplot(nrows = length(unique(DF$variable)), shareX = TRUE)
return(p)
}
app.R
# Set maximum request size
options(shiny.maxRequestSize = 30 * 1024^2)
# Load required libraries
library(DT)
library(plotly)
library(shiny)
library(data.table)
library(readr)
library(openxlsx)
library(readxl)
library(tidyverse)
library(corrplot)
library(corrr)
library(psych)
# UI ------------------------------------------------------------
ui <- fluidPage(
titlePanel(title = "Data"),
fileInput("file", "Choose .xlsx file", accept = c(".xlsx")),
mainPanel(
tabsetPanel(id = "tabsetPanelID")
)
)
# Server ------------------------------------------------------------
server <- function(input, output, session) {
# UI Elements ------------------------------------------------------------
ui_elementsUI <- function(x, y, data) {
tagList(
h4("Select X and Y datasets"),
fluidRow(
column(12, selectizeInput(inputId = x, label = "X data", choices = names(data)))
),
fluidRow(
column(12, selectizeInput(inputId = y, label = "Y data", choices = names(data), multiple = TRUE, selected = names(data)[3]))
)
)
}
# Sheet Elements ------------------------------------------------------------
sheet_elementsUI <- function(sheet) {
tagList(
fluidRow(
column(12, selectInput(inputId = sheet, label = "Sheet", choices = excel_sheets(input$file$datapath)))
)
)
}
# Render Sheet Elements after File Upload ------------------------------------
n <- reactive({
req(input$file)
length(excel_sheets(input$file$datapath))
})
observe({
lapply(1:n(), function(val) {
output[[paste0("sheet_elements", val)]] <- renderUI({
sheet_elementsUI(paste0("sheet", val))
})
output[[paste0("ui_elements", val)]] <- renderUI({
ui_elementsUI(paste0("x", val), paste0("y", val), data_list()[[val]]())
})
output[[paste0("plot", val)]] <- renderPlotly({
plot_render()(paste0("x", val), paste0("y", val), data_list()[[val]]())
})
})
})
# Plot Rendering ------------------------------------------------------------
plot_render <- reactive({
validate(
need(input$file != "", "Plots will display after choosing the .xlsx file.")
)
function(x, y, data) {
labels <- c("xy", paste0("xy", 2:length(input[[y]])))
labels_json <- jsonlite::toJSON(labels)
js_code <- sprintf(
'function(el, x){el.on("plotly_hover", function(d) {
Plotly.Fx.hover(el.id, {xval: d.xvals[0]}, %s);
})}',
labels_json
)
plotly_stacked(df = data, x_colName = input[[x]], cols = c(input[[x]], input[[y]])) %>%
layout(hovermode = "x") %>%
htmlwidgets::onRender(js_code)
}
})
# Data Processing Function ---------------------------------------------------
foo <- function(sheet) {
df <- read_xlsx(input$file$datapath, sheet = input[[sheet]], na = "empty")
n <- which(!is.na(as.numeric(df[[1]])))[1]
df[is.na(df)] <- " "
colnames(df) <- apply(df[1:(n - 1), ], 2, paste, collapse = ",")
df <- df[-c(1:(n - 1)), ]
names(df)[1] <- "Time"
df[, 2:ncol(df)] <- apply(df[, 2:ncol(df)], 2, as.numeric)
if (class(df[[1]])[1] != "POSIXct") {
df$Time <- as.POSIXct(as.numeric(df$Time) * 86400, origin = "1899-12-30", tz = "UTC")
}
return(df)
}
# Generate Reactive Datasets -------------------------------------------------
generate_data <- function(sheet_name) {
reactive({
req(input$file)
foo(sheet_name)
})
}
data_list <- reactive({
lapply(paste0("sheet", 1:n()), generate_data)
})
# Generate Tabs --------------------------------------------------------------
generateTabUI <- function(tab_id) {
tab_name <- paste("Tab", tab_id)
plot_output <- plotlyOutput(paste("plot", tab_id, sep = ""))
ui_elements <- uiOutput(paste("ui_elements", tab_id, sep = ""))
sheet_elements <- uiOutput(paste("sheet_elements", tab_id, sep = ""))
tabPanel(tab_name, value = tab_id, sheet_elements, ui_elements, plot_output)
}
observe({
for (i in 1:n()) {
insertTab(
inputId = "tabsetPanelID",
tab = generateTabUI(i)
)
}
})
}
# Run the Shiny App -----------------------------------------------------------
shinyApp(ui = ui, server = server)
