R/page_sex.R

Defines functions page_sex page_sexUI

page_sexUI <- function(...) {
  fluidPage(
    fluidRow(

      # No padding column with width = 4
      column(
        width = 4,
        djprshiny::djpr_h1_box("Sex") %>% fluidRow(),
        green_text_box(
          "This page provides key labour force indicators by sex. "
        ) %>% fluidRow()
      ),
      box(
        width = 8,
        uiOutput("table_gr_sex") %>%
          djpr_with_spinner()
      )
    ),
    djpr_h2_box("Labour force status by sex") %>% fluidRow(),
    djpr_box_ui(width = 12, "gr_gen_emp_bar") %>% fluidRow(),
    djpr_box_ui(
      width = 12,
      id = "gr_full_part_line",
      date_slider(
        "gr_full_part_line",
        table_no = "6202012",
        value = c(Sys.Date() - (365.25 * 5), data_dates$`6202012`$max)
      )
    ) %>% fluidRow(),
    djpr_h2_box("Unemployment by sex") %>% fluidRow(),
    djpr_box_ui(
      width = 12,
      id = "gr_gen_unemp_line",
      date_slider(
        "gr_gen_unemp_line",
        table_no = "6202012",
        value = c(Sys.Date() - (365.25 * 10), data_dates$`6202012`$max)
      )
    ) %>% fluidRow(),
    djpr_h2_box("Employment to population ratio by sex") %>% fluidRow(),
    djpr_box_ui(
      width = 12,
      "gr_gen_emppopratio_line",
      date_slider(
        "gr_gen_emppopratio_line",
        table_no = "6202012",
        value = c(Sys.Date() - (365.25 * 10), data_dates$`6202012`$max)
      )
    ) %>% fluidRow(),
    djpr_h2_box("Participation rate by sex") %>% fluidRow(),
    djpr_box_ui(
      width = 12,
      "gr_gen_partrate_line",
      date_slider("gr_gen_partrate_line", table_no = "6202012")
    ) %>% fluidRow(),
    box(
      width = 12,
      style = "padding:10px;",
      HTML(
        # "This dashboard is produced by the <b>Strategy and Priority ",
        # "Projects - Data + Analytics</b> team at the Victorian Department ",
        # "of Jobs, Precincts and Regions.",
        "The latest data in this ",
        "dashboard is for ", format(data_dates$`6202012`$max, "%B %Y"), ".",
        "We are committed to making our websites accessible to all users.",
        "We are aware that parts of these dashboards are not fully accessible.",
        "If you require this information in an alternative format or would",
        "like to provide feedback please ",
        "<a href='mailto:spp-data@djsir.vic.gov.au?subject=DJSIR Labour Force Dashboard'>email us</a>.",
        "</br>"
      ),
      div(
        style = "text-align: center;",
        tags$a(
          class = "legalLink",
          href = "#shiny-tab-legal",
          "Copyright | Disclaimer"
        )
      )
    ) %>% fluidRow()
  )
}


page_sex <- function(input, output, session) {
  output$table_gr_sex <- renderUI({
    table_gr_sex() %>%
      flextable::htmltools_value(ft.shadow = FALSE)
  }) %>%
    bindCache(data_dates$`6202012`$max)

  # Groups: line chart of emp-pop by sex
  djpr_box_server(
    id = "gr_gen_emppopratio_line",
    plot_fun = viz_gr_gen_emppopratio_line,
    dates = input$dates
  )

  # Bar chart: LF status by sex, latest month

  djpr_box_server(
    id = "gr_gen_emp_bar",
    plot_fun = viz_gr_gen_emp_bar,
    data = filter_dash_data(c(
      "A84423469L",
      "A84423245A",
      "A84423801C",
      "A84423577W",
      "A84423461V",
      "A84423237A",
      "A84423463X",
      "A84423239F",
      "A84423462W",
      "A84423238C"
    ), df = dash_data) %>%
      dplyr::group_by(.data$series) %>%
      dplyr::filter(.data$date == max(.data$date))
  )

  # Line chart: participation by sex over time
  djpr_box_server(
    id = "gr_gen_partrate_line",
    plot_fun = viz_gr_gen_partrate_line,
    dates = input$dates
  )

  # Line chart: unemployment rate by sex
  djpr_box_server(
    id = "gr_gen_unemp_line",
    plot_fun = viz_gr_gen_unemp_line,
    dates = input$dates
  )

  djpr_box_server(
    id = "gr_full_part_line",
    plot_fun = viz_gr_full_part_line,
    dates = input$dates,
    data = filter_dash_data(c(
      "A84423237A",
      "A84423461V",
      "A84423245A",
      "A84423469L"
    ),
    df = dash_data
    )
  )




}
djpr-data/djprlabourdash documentation built on April 28, 2023, 6:16 p.m.