Hi there
Have had my first go at uploading a google sheets document as a dummy data file. I hope you can access it, have set it as apublic file.
I'm not sure what the problem is with the file so finding it hard to know what to take out of the shiny file due to the reactivity. The code works when the df set to head 20,000 but as soon as the number gets bigger it doesn't. I've added the shiny options part at the top to increase memory size and increased my shiny.io size too. Any thoughts would be gratefully appreciated,
Sue
# This is a Shiny web application. You can run the application by clicking
# the 'Run App' button above.
#
# Find out more about building applications with Shiny here:
#
# http://shiny.rstudio.com/
#Using platform to feed 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)
library(googlesheets)
suppressMessages(library(dplyr))
df <- gs_title("export")
df <- gs_read(df)
jscode <- "shinyjs.closeWindow = function() { window.close(); }"
df$platform <- as.factor(df$source)
df$platform <- forcats::fct_explicit_na(df$platform, na_level = "(Missing)")
df$category <- as.factor(df$category)
df$category <- forcats::fct_explicit_na(df$category, na_level = "(Missing)")
df$invoice_date <- dmy(df$invoice_date)
df$month <- format(df$invoice_date,"%B")
df$month <- factor(df$month, month.name)
df$month <- forcats::fct_explicit_na(df$month, na_level = "(Missing)")
df$year <- format(df$invoice_date,"%Y")
df$year <- factor(df$year)
df$year <- forcats::fct_explicit_na(df$year, na_level = "(Missing)")
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 = "Example Sales Dashboard")
sidebar <- dashboardSidebar(
sidebarMenuOutput("menu"),
dateRangeInput('dateRange',
label = 'Date range input: yyyy-mm-dd',
start = Sys.Date() - 90, 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 = "Example 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
})
#some data manipulation to dervie the values of the KPI boxes
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("Example"),
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") +
labs(x = "Month", y = " Total Net Amount") +
scale_y_continuous(labels = comma) +
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("a", 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("a", 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)