I'm having a problem getting the app to load when their is over 20,000 rows in the dataframe. At the moment it works as I want it too, but when we used a larger dataset it stopped loading.
I've used fread to load the dataset, I've set the shinyapps.io to be XXLarge and I've added in shiny(options to maximise the request size).
I appreciate the whole code is here but I'm at my wits end to try to understand what is stopping it loading and wondered whether there is something I've put in the code that could be causing this.
any help gratefully appreciated.
#Using platform to subset into category and product
options(shiny.maxRequestSize = 100*1024^2)
library(shiny)
library(shinydashboard)
library(tidyverse)
library(readxl)
library(stringr)
library(DT)
library(scales)
library(lubridate)
library(plotly)
library(shinyjs)
library(data.table)
library(fasttime)
df <- fread("export_to_r.csv")
jscode <- "shinyjs.closeWindow = function() { window.close(); }"
df$platform <- as.factor(df$source)
df$category <- as.factor(df$category)
df$invoice_date <- fastPOSIXct(df$invoice_date)
df$month <- format(df$invoice_date,"%B")
df$month <- factor(df$month, month.name)
df$year <- format(df$invoice_date,"%Y")
df$year <- factor(df$year)
df <- df %>%
select(-source)
df <- df %>%
filter(category != "Ebay Delivery Charges")
df <- head(df, 20000) # this code will work with 20,000 records but any bigger it won't load.
##====== Need the above to import in =============
header <- dashboardHeader(title = "Sales Dashboard")
sidebar <- dashboardSidebar(
sidebarMenuOutput("menu"),
dateRangeInput('dateRange',
label = 'Date range input: yyyy-mm-dd',
start = Sys.Date() - 60, end = Sys.Date() + 2,
format = "yyyy-mm-dd"),
sidebarMenu(
menuItem("Charts", tabName = "general", icon=icon("bar-chart")),
menuItem("Data ", tabName = "data", icon = icon("database")),
useShinyjs(),
extendShinyjs(text = jscode, functions = c("closeWindow")),
actionButton('sametab',
"Dashboard", #text can be changed
icon = icon("reply"),
onclick ="location.href='/dash/';") #url can be changed
)
)
body <- dashboardBody(
tabItems(
tabItem(tabName = "general",
fluidPage(
fluidRow(
valueBoxOutput("value3"),
valueBoxOutput("value1"),
valueBoxOutput("value2")
),
fluidRow(
box(width = 12,
title = "Select platform to visualise",
selectizeInput(inputId = "platform",
label = "Selected Platform:",
choices = "",
options = list(placeholder = "Type Platform Name"),
multiple = TRUE)),
fluidRow(
box(
width = 6,
title = "Sales by Platform",
status = "primary",
solidHeader = TRUE,
collapsible = TRUE,
div(style="width: 95%; height: 95; margin: 2 auto;",
plotlyOutput(outputId = "platformPlot"), style="display:inline;width:100%;height:80%;")),
box(width = 6,
title = "Sales by platform for the time period",
status = "primary",
solidHeader = TRUE,
collapsible = TRUE,
plotOutput(outputId = "sales_platform")),
br()),
fluidRow(
box(width = 12,
title = 'Sales by platform Bar chart',
status = "primary",
solidHeader = TRUE,
collapsible = TRUE,
plotOutput(outputId = "platform"))
),
#plot input
fluidRow(
column(12,
selectizeInput(inputId = "product",
label = "Selected Product:",
choices = "",
multiple = TRUE)),
column(8,
box(width = 12,
title = "Sales by Product",
status = "primary",
solidHeader = TRUE,
collapsible = TRUE,
plotOutput(outputId = "product"))
),
column(4,
box(width = 12,
title = "Top selling SKUs by value",
status = "primary",
solidHeader = TRUE,
collapsible = TRUE,
tableOutput(outputId = "tableproduct"))
)),
fluidRow(
column(12,
selectizeInput(inputId = "category",
label = "Selected Category:",
choices = "",
multiple = TRUE)
),
column(4,
box(width = 12,
title = "Top selling Categorys by value",
status = "primary",
solidHeader = TRUE,
collapsible = TRUE,
tableOutput(outputId = "tablecategory"))),
column(8,
box(width = 12,
title = "Sales history by top categories",
status = "primary",
solidHeader = TRUE,
collapsible = TRUE,
plotOutput(outputId = "sales_category"))
))
)
)), # tabItem general
tabItem(tabName = "data",
fluidRow(
#tabBox(title = "Data Table", width = 12,
fluidRow(
box(title = "Data Table",
width = 12,
status = "primary",
solidHeader = TRUE,
collapsible = TRUE,
div(DT::dataTableOutput(outputId = "datatable"), style = "font-size: 95%; width: 100%")
)#box
)#fluidRow
# )#tabBox
))
) # tabItems
) #dashboard body
ui <- fluidPage(
dashboardPage(header, sidebar, body)
)
# Define server logic
server <- function(input, output, session) {
#reactive expression subset df according to date range
filtered_df <- reactive({
df <- subset(
df,
invoice_date >= input$dateRange[1] &
invoice_date <= input$dateRange[2])
})
filtered_platform_df <- reactive({
req(input$platform)
filter(filtered_df(), platform %in% input$platform)
})
filtered_category_df <- reactive({
req(input$category)
filter(filtered_platform_df(), category %in% input$category) #changed to filter by platform
})
filtered_product_df <- reactive({
req(input$product)
filter(filtered_platform_df(), product %in% input$product) #changed to filter by platform
})
revenue <- sum(df$net)
filtered_revenue <- reactive({
sum(filtered_df()$net, na.rm = TRUE)
})
filtered_units <- reactive({
sum(filtered_df()$quantity, na.rm = TRUE)
})
sales_platform_pie <- reactive ({
group_by(filtered_platform_df(), platform) %>% #changed to filter by platform
summarise(totalnet = sum(net))
})
output$value1 <- renderValueBox({
valueBox(
formatC(sum(filtered_revenue()), format="d", big.mark = ','),
paste('Total Sales Value: ', sum(filtered_revenue())),
icon = icon("stats", lib = 'glyphicon'),
color = 'maroon')
})
output$value2 <- renderValueBox({
valueBox(
formatC(sum(filtered_units()), format="d", big.mark = ','),
paste('Total Units Sold: ', sum(filtered_units())),
icon = icon("stats", lib = 'glyphicon'),
color = 'maroon')
})
output$value3 <- renderValueBox({
valueBox(
paste("name"),
subtitle = "Sales Dashboard",
icon = icon("stats", lib = 'glyphicon'),
color = 'maroon')
})
output$platform <- renderPlot({
ggplot(filtered_platform_df(), aes(month, net)) +
facet_wrap( ~year) +
geom_col(aes(fill = factor(platform))) +
scale_fill_discrete(name="Platform") +
theme(axis.text.x=element_text(angle=60, hjust=1))
})
output$platformPlot <- renderPlotly({
validate(
need( nrow(sales_platform_pie()) > 0, "Data insufficient for plot")
)
req(input$product)
plot_ly(sales_platform_pie(), labels = ~platform, values = ~totalnet, type = 'pie',textposition = 'inside',textinfo = 'percent') %>%
config(displayModeBar = FALSE) %>%
layout(title = 'Platform',
xaxis = list(showgrid = FALSE, zeroline = FALSE, showticklabels = FALSE),
yaxis = list(showgrid = FALSE, zeroline = FALSE, showticklabels = FALSE))
})
output$sales_platform_pie <- renderPlot({
filtered_platform_df() %>%
ggplot(aes(x=net, fill = platform)) +
geom_bar(width = 1) +
coord_polar("y")
})
output$tableproduct <- renderTable({
filtered_df() %>%
group_by(product) %>%
summarise(totalnet = sum(net)) %>%
arrange(desc(totalnet)) %>%
head(10)
})
output$tablecategory <- renderTable({
filtered_df() %>%
group_by(category) %>%
summarise(totalnet = sum(net)) %>%
arrange(desc(totalnet)) %>%
head(10)
})
output$product <- renderPlot({
filtered_product_df() %>%
ggplot(aes(product, net, fill = platform)) +
geom_col() +
labs(x = "Product Description", y = " Total Net Amount") +
theme(axis.text.x = element_text(angle = 90, hjust = 1))
})
output$sales_platform <- renderPlot({
filtered_platform_df() %>%
group_by(invoice_date, platform) %>%
summarise(totalnet = sum(net)) %>%
ggplot(aes(invoice_date, totalnet, color = platform)) +
geom_line() +
labs(x = "Invoice Date", y = " Total Net Amount") +
theme(axis.text.x = element_text(angle = 90, hjust = 1))
})
output$sales_category <- renderPlot({
filtered_category_df() %>%
group_by(invoice_date, category) %>%
summarise(totalnet = sum(net)) %>%
ggplot(aes(invoice_date, totalnet, color = category)) +
geom_line() +
labs(x = "Invoice Date", y = " Total Net Amount") +
theme(axis.text.x = element_text(angle = 90, hjust = 1))
})
output$datatable <- DT::renderDataTable(
DT::datatable(
{filtered_df() %>%
mutate(sku = as.factor(sku), product = as.factor(product))},
extensions = 'Buttons',
rownames = TRUE,
filter = 'top',
options = list(
fixedColumns = TRUE,
autoWidth = TRUE,
ordering = TRUE,
dom = 'Blfrtip',
buttons = c('copy', 'csv', 'excel', 'pdf'),
lengthMenu = list( c(10, 20, -1) # declare values
, c(10, 20, "All") # declare titles
) # end of lengthMenu customization
, pageLength = 20),
class = "display"
))
observe({
updateSelectizeInput(
session,
inputId = "platform",
choices = as.vector(df$platform),
selected = df$platform
)
})
observe({
product <- if (is.null(input$platform)) character(0) else {
filter(filtered_df(), platform %in% input$platform) %>%
`$`('product') %>%
unique() %>%
sort()
}
stillSelected <- isolate(input$product[input$product %in% product])
updateSelectInput(session, "product", choices = product,
selected = c("Shiplap 40 x 3.0m", "Shiplap 50 x 2.4m", stillSelected))
})
observe({
category <- if (is.null(input$platform)) character(0) else {
filtered_df() %>%
filter(platform %in% input$platform,
is.null(input$platform) | platform %in% input$platform) %>%
`$`('category') %>%
unique() %>%
sort()
}
stillSelected <- isolate(input$category[input$category %in% category])
updateSelectInput(session, "category", choices = category,
selected = c("Sawn Timber", stillSelected))
})
observe({
updateDateRangeInput(
session,
inputId = "dateRange",
start = input$dateRange[1],
end = input$dateRange[2]
)
})
observeEvent(input$close, {
js$closeWindow()
stopApp()
})
}
# Run the application
shinyApp(ui = ui, server = server)
