I've got my shiny app 99% complete but can't for the life of me figure out why when I add multiple series from the "Region" input selector to the chart in the first chart, the x values are change/skipped.
When I have just one series (default = Australia) all the months are plotted. When I add an additional region (eg. Victoria), every second month is plotted for each series (alternating), and when I add a third region, every third month is plotted (again alternating). Ultimately this results in not seeing the max/min and the monthly values for each line.
The set of regions able to be added to the plot all share the same date values in the original dataset (i.e. monthly values from Feb 1978 to Apr 2020).
Retrieve Data
## app.R ##
library(dplyr)
library(raustats)
library(ggplot2)
library(lubridate)
library(shiny)
library(shinydashboard)
library(plotly)
#retrieve labour force dataset from ABS via abs.stat API
labour_force <- abs_stats(dataset = "LF", filter = list(ITEM=c(10,14,15,16), AGE=1599, TSEST=c(20, 30)))
lf <- select(labour_force, -c(frequency, obs_status, unknown, agency_id,agency_name, dataset_name))
#change datatype of 'time' to date format
lf$time <- paste("01", lf$time, sep = "-")
lf$time <- strptime(lf$time, format = "%d-%b-%Y")
lf$time <- as.Date(lf$time, format = "%d-%b-%Y")
str(lf)
UI
#UI
ui <- dashboardPage(
dashboardHeader(title = "this is a title"),
## Sidebar content
dashboardSidebar(
sidebarMenu(
menuItem("Dashboard", tabName = "dashboard", icon = icon("dashboard")),
menuItem("menu item", tabName = "menuItem1", icon = icon("th")),
menuItem("ABS website", icon = icon("th"), href = "https://abs.gov.au"),
menuSubItem("submenu")
)
),
dashboardBody(
tabItems(
# First tab content
tabItem(tabName = "dashboard",
# Boxes need to be put in a row or a column
fluidRow(
box(
title = "Labour Force Data Description",
status = "warning",
solidHeader = TRUE,
width = 9,
height = 250
)
),
fluidRow(
box(
title = "Labour Force Data",
status = "success",
solidHeader = TRUE,
dateRangeInput(
inputId = "dateRange",
label = "Select the date range:",
start = min(lf$time),
end = max(lf$time),
min = min(lf$time),
max = max(lf$time),
format = "d M yyyy",
startview = "year",
separator = "to",
autoclose = TRUE,
),
actionButton("resetDate", label = "Reset date range"),
selectizeInput(
inputId = "dataItem",
label = "Select data series:",
choices = unique(lf$data_item),
selected = "Unemployment rate (%)",
multiple = FALSE
),
selectizeInput(
inputId = "regionID",
label = "Select a region:",
choices = unique(lf$region),
selected = "Australia",
multiple = TRUE
),
selectizeInput(
inputId = "adjustment",
label = "Select estimate type:",
choices = unique(lf$adjustment_type),
selected = "Seasonally Adjusted",
multiple = FALSE
),
downloadButton(outputId = "downloadLF1", label = "Download"),
width = 2
),
box(
title = 'Plot 1',
status = "success",
solidHeader = TRUE,
plotlyOutput("LFplot1", height = 500),
width = 10,
)
),
fluidRow(
box(
title = "Labour Force Data",
status = "warning",
solidHeader = TRUE,
dateRangeInput(
inputId = "dateRangeGender",
label = "Select the date range:",
start = min(lf$time),
end = max(lf$time),
min = min(lf$time),
max = max(lf$time),
format = "d M yyyy",
startview = "year",
separator = "to",
autoclose = TRUE,
),
actionButton("resetDateGender", label = "Reset date range"),
selectizeInput(
inputId = "dataItemGender",
label = "Select data series:",
choices = unique(lf$data_item),
selected = "Unemployment rate (%)",
multiple = FALSE
),
selectizeInput(
inputId = "adjustmentGender",
label = "Select estimate type:",
choices = unique(lf$adjustment_type),
selected = "Seasonally Adjusted",
multiple = FALSE
),
downloadButton(outputId = "downloadLF2", label = "Download"),
width = 2
),
box(
title = 'plot 2',
status = "warning",
solidHeader = TRUE,
plotlyOutput("LFplot2", height = 500),
width = 10
)
),
),
# Second tab content
tabItem(tabName = "menuItem1",
h2("welcome to menu item 1")
),
# third tab content
tabItem(tabName = "SUBSUB",
h2("Widgets tab content 111222")
)
)
)
)
SERVER
server <- function(input, output, session) {
selector1 <- reactive({
print(input$dateRange)
lf %>%
dplyr::filter(time >= input$dateRange[1], time <= input$dateRange[2],
adjustment_type == input$adjustment, data_item == input$dataItem, region == input$regionID)
})
selector2 <- reactive({
print(input$dateRangeGender)
lf %>%
dplyr::filter(time >= input$dateRangeGender[1], time <= input$dateRangeGender[2],
adjustment_type == input$adjustmentGender, data_item == input$dataItemGender)
})
observeEvent(input$resetDate, {
updateDateRangeInput(session, "dateRange",
start = min(lf$time),
end = max(lf$time),
min = min(lf$time),
max = max(lf$time)
)
})
observeEvent(input$resetDateGender, {
updateDateRangeInput(session, "dateRangeGender",
start = min(lf$time),
end = max(lf$time),
min = min(lf$time),
max = max(lf$time)
)
})
output$downloadLF1 <- downloadHandler(
filename = function() {
paste(input$dataItem, ".csv", sep = "")
},
content = function(file) {
write.csv(selector1(), file, row.names = FALSE)
}
)
output$downloadLF2 <- downloadHandler(
filename = function() {
paste(input$dataItemGender, ".csv", sep = "")
},
content = function(file) {
write.csv(selector2(), file, row.names = FALSE)
}
)
output$LFplot1 <- renderPlotly({
print(nrow(selector1()))
req(nrow(selector1()) > 0)
LFplt_1 <- selector1() %>%
dplyr::filter(sex == "Persons") %>%
ggplot() +
geom_line(mapping = aes(x= time, y= values,colour= region))
ggplotly(LFplt_1)
})
output$LFplot2 <- renderPlotly({
print(nrow(selector2()))
req(nrow(selector2()) > 0)
LFplt_2 <- selector2() %>%
dplyr::filter(region == "Australia") %>%
ggplot() +
geom_line(mapping = aes(x= time, y= values, colour= sex))
ggplotly(LFplt_2)
})
}
shinyApp(ui, server)
