0

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)
theRealPK
  • 31
  • 3

2 Answers2

0

Your shinydashboard app has quite a few moving parts, so it is a bit hard to diagnose this. I haven't had the time to go through all the details, but here are some preliminary thoughts:

  1. I think you are trying to do too many things inside your selector. E.g. inside selector1 you are trying to select date range, adjustment_type, data_item and region all at the same time.
  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)
  })

You may be better off breaking this up into multiple parts - a different selector for each of adjustment_type, data_item and region.

  1. Is the date range selector absolutely necessary? Plotly already allows you to zoom in on specific date ranges, you may not need a separate date range selector. I know you are also using this for the download button, but maybe consider leaving out the date range selector until you figure out the other issues.

  2. Usually, when I connect a filter function to a selectInput choice, I put the selectInput in the dplyr::filter line directly.

# you have
  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)
  })

# consider something like:
  output$LFplot2 <- renderPlotly({
    print(nrow(selector2()))
    req(nrow(selector2()) > 0)
    LFplt_2 <- selector2() %>%
      dplyr::filter(region == input$regionID) %>%  # region selection in filter here
      ggplot() +
      geom_line(mapping = aes(x= time, y= values, colour= sex))
    ggplotly(LFplt_2)
  })

See if this helps. Will spend more time on this a bit later.

Piranha
  • 116
  • 6
  • Thanks @Piranha. I tried placing the region selection into the filter as suggested. This made a difference in that when two regions were selected by user all monthly values were plotted, however with any more than two regions selected it would resort back to only plotting values for every 2nd or 3rd month (it depended on how many regions were selected). console did print out this warning as well: "Warning in region == input$regionID : longer object length is not a multiple of shorter object length" Placing the other two inputs directly into the filter also had no effect unfortunately. – theRealPK May 21 '20 at 23:22
  • Fixed! I don't understand how it works, but by replacing " ==" operator with " %in% " it picks up the date ranges for each of the region inputs and plots correctly. – theRealPK May 22 '20 at 00:54
  • Great to know that you figured it out! I had a suspicion that the "==" operator was the key to the solution, but I didn't get a chance to look through the complete app. – Piranha May 22 '20 at 18:51
0

Changing the == operator in the output$LFplot1 to %in% fixes the issue:

reactive function changed to:

  selector1 <- reactive({
    print(input$dateRange)
    lf %>% 
      dplyr::filter(time >= input$dateRange[1], time <= input$dateRange[2],
                    adjustment_type == input$adjustment, 
                    data_item == input$dataItem)
  })

output plot changed to:

  output$LFplot1 <- renderPlotly({
    print("number of rows is: ")
    print(nrow(selector1()))
    req(nrow(selector1()) > 0)
    LFplt_1 <- selector1() %>%
      dplyr::filter(sex == "Persons", region %in% input$regionID) %>%
      ggplot() +
      geom_line(mapping = aes(x= time, y= values,colour= region))
    ggplotly(LFplt_1)
  })
theRealPK
  • 31
  • 3