In djpr-data/djprlabourdash: DJSIR Jobs Dashboard

library(officedown)
library(flextable)
library(djprshiny)
library(djprlabourdash)
library(automate.labourforce.checks)
library(dplyr)
library(dbplyr)

knitr::opts_chunk$set(
  echo = FALSE,
  message = FALSE,
  error = FALSE,
  warning = FALSE,
  tab.topcaption = TRUE
  )

Sys.setenv("R_DJPRLABOURDASH_TABLEDEST" = "briefing")



flex_adjust <- function(flex, 
                        pivot = FALSE, 
                        extract_pc = FALSE, 
                        series = NULL, 
                        names_width = 2, 
                        tbl_width = 1){

  df <- flex$body$dataset |> 
    dplyr::select(-`LAST 3 YEARS`) 

  if (!is.null(series)) {

    df <- data.frame(SERIES_ID = series) |>
      left_join(df) # should filter and order in one

  }

  if (extract_pc) {
    df <- df |> 
      dplyr::mutate(
        dplyr::across(
          dplyr::starts_with('SINCE'),
          ~ stringr::str_match(.x, "(?<=\\().+?(?=\\))")
          )
        )
  }

  if (pivot) {

    out_data <- df |>
      tidyr::pivot_longer(-SERIES_ID) |>
      tidyr::pivot_wider(names_from = 'SERIES_ID', values_from = 'value')

    colnames(out_data) <- out_data |> dplyr::slice(1)
    out_data <- out_data[-1, ]

    names_width <- 1.5

    #TODO: option to remove units from each cell and add to first column

  } else {

    # spark already removed, maybe add filter here
    out_data <- df |>
      select(-SERIES_ID)

  } 

  flextable(out_data) |>
    flextable::font(fontname = "Arial") |>
    flextable::font(fontname = "Arial", part = "header") |>
    flextable::fontsize(size = 8, part = 'all') |>
    flextable::bold(i = 1, part = "header") |>
    flextable::bg(i = 1, bg = "#003366", part = "header") |>
    flextable::color(color = "white", part = "header") |>
    flextable::hline(border = officer::fp_border(color="gray", width = 1)) |>
    flextable::width(j = 1, width = names_width) |>
    flextable::set_table_properties(width = tbl_width)

}

df <- get_labourforce_db()

ydata <- filter_dash_data(
  series_ids = c(
    "15-24_employed_ballarat",
    "15-24_employed_bendigo",
    "15-24_employed_geelong",
    "15-24_employed_hume",
    "15-24_employed_latrobe - gippsland",
    "15-24_employed_shepparton",
    "15-24_employed_victoria - north west",
    "15-24_employed_warrnambool and south west",
    "15-24_employed_rest of vic.",
    "15-24_unemployed_ballarat",
    "15-24_unemployed_bendigo",
    "15-24_unemployed_geelong",
    "15-24_unemployed_hume",
    "15-24_unemployed_latrobe - gippsland",
    "15-24_unemployed_shepparton",
    "15-24_unemployed_victoria - north west",
    "15-24_unemployed_warrnambool and south west",
    "15-24_unemployed_rest of vic.",
    "15-24_employed_melbourne - inner",
    "15-24_employed_melbourne - inner east",
    "15-24_employed_melbourne - inner south",
    "15-24_employed_melbourne - north east",
    "15-24_employed_melbourne - north west",
    "15-24_employed_melbourne - outer east",
    "15-24_employed_melbourne - south east",
    "15-24_employed_melbourne - west",
    "15-24_employed_mornington peninsula",
    "15-24_employed_greater melbourne",
    "15-24_unemployed_melbourne - inner",
    "15-24_unemployed_melbourne - inner east",
    "15-24_unemployed_melbourne - inner south",
    "15-24_unemployed_melbourne - north east",
    "15-24_unemployed_melbourne - north west",
    "15-24_unemployed_melbourne - outer east",
    "15-24_unemployed_melbourne - south east",
    "15-24_unemployed_melbourne - west",
    "15-24_unemployed_mornington peninsula",
    "15-24_unemployed_greater melbourne"
  ),
  df = df
)

ydata <- ydata %>%
  dplyr::select(
    .data$date, .data$series, .data$table_no,
    .data$frequency, .data$value
  ) %>%
  dplyr::mutate(
    split_series = stringr::str_split_fixed(.data$series,
      pattern = " ; ",
      n = 3
    ),
    age = .data$split_series[, 1],
    indicator = .data$split_series[, 2],
    sa4 = .data$split_series[, 3]
  ) %>%
  dplyr::select(-.data$split_series, -.data$series)

ydata <- ydata %>%
  tidyr::pivot_wider(
    names_from = .data$indicator,
    values_from = .data$value
  ) %>%
  dplyr::group_by(.data$sa4, .data$date, .data$age, .data$table_no, .data$frequency) %>%
  dplyr::mutate(value = 100 * (.data$Unemployed /
    (.data$Unemployed + .data$Employed))) %>%
  dplyr::select(-.data$Employed, -.data$Unemployed) %>%
  dplyr::group_by(.data$sa4, .data$age) %>%
  dplyr::mutate(
    indicator = "Unemployment rate",
    value = slider::slide_mean(.data$value,
      before = 11L,
      complete = TRUE
    )
  ) %>%
  dplyr::filter(!is.na(.data$value)) %>%
  dplyr::mutate(
    unit = "Percent",
    series_id = paste(.data$age, .data$indicator, .data$sa4, sep = "_"),
    series = paste(.data$age, .data$indicator, .data$sa4, sep = " ; ")
  ) %>%
  dplyr::ungroup()

  ydata <- ydata %>%
    dplyr::mutate(
      sa4 = dplyr::if_else(.data$sa4 == "Rest of Vic.",
        "Regional Victoria",
        .data$sa4
      ),
      indicator = dplyr::if_else(
        .data$sa4 %in% c(
          "Greater Melbourne",
          "Regional Victoria"
        ),
        paste0(.data$sa4, " youth unemployment rate"),
        .data$sa4
      )
    )

Whole of Victoria

library(dplyr)
library(purrr)

lu <- tribble(
  ~ type,        ~series_id  ,                       ~label,
'curr_series',   "A84423354L",                       'Unemployment rate',   
'three_series',  "A84595471L",                       'Regional unemployment rate' ,
'three_series',  "A84599665J",                       'Ballarat',
'three_series',  "A84600031L",                       'Bendigo',
'three_series',  "A84599671C",                       'Geelong',
'three_series',  "A84599677T",                       'Hume',
'three_series',  "A84599683L",                       'Latrobe - Gippsland',
'three_series',  "A84599929A",                       'Victoria - North West',
'three_series',  "A84600121T",                       'Shepparton',
'three_series',  "A84600037A",                       'Warrnambool and South West',
'twelve_series', "A84424691V",                      'Youth unemployment rate',       
'twelve_series', "15-24_males_unemployment rate",   'Male youth',          
'twelve_series', "15-24_females_unemployment rate", 'Female youth',        
'youth_series',  "15-24_Unemployment rate_Rest of Vic.",             'Regional Youth',
'youth_series',  "15-24_Unemployment rate_Ballarat",                 'Ballarat',
'youth_series',  "15-24_Unemployment rate_Bendigo",                  'Bendigo',
'youth_series',  "15-24_Unemployment rate_Geelong",                  'Geelong',
'youth_series',  "15-24_Unemployment rate_Hume",                     'Hume',
'youth_series',  "15-24_Unemployment rate_Latrobe - Gippsland",      'Latrobe - Gippsland',
'youth_series',  "15-24_Unemployment rate_Shepparton",               'Shepparton',
'youth_series',  "15-24_Unemployment rate_Victoria - North West",    'Victoria - North West',
'youth_series',  "15-24_Unemployment rate_Warrnambool and South West"  , 'Warrnambool and South West')

required_cols <- c(
 "date",
 "value",   
 "series_id",
 "series",                
 "table_no",              
 "frequency",             
 "unit"
)


current <- df |> 
  filter(series_id == filter(lu, type == 'curr_series') |> pull(series_id)) |>
  select(one_of(required_cols))

three <- df |>
  filter(series_id %in% (filter(lu, type == 'three_series') |> pull(series_id))) |>
  group_by(series_id) |>
  arrange(date) |>
  mutate(value = slider::slide_mean(.data$value,
      before = 2L,
      complete = TRUE
    ),
    window = '3 Month Average') |>
  select(one_of(required_cols))

twelve <- df |>
  filter(series_id %in% (filter(lu, type == 'twelve_series') |> pull(series_id))) |>
  group_by(series_id) |>
  arrange(date) |>
  mutate(value = slider::slide_mean(.data$value,
      before = 11L,
      complete = TRUE
    ),
    window = '12 Month Average') |>
  select(one_of(required_cols))

youth <- ydata |> # already 12 month mean
  filter(series_id %in% (filter(lu, type == 'youth_series') |> pull(series_id)))|>
  select(one_of(required_cols)) |>
  mutate(window = '12 Month Average')


  # Date breaks with nearest matching & frequency agnostic
  deltas <- c(
    `Last Year` = \(x) x[which.min(abs(x - (max(x) - months(12))))],
    `Nov 2014`  = \(x) x[which.min(abs(as.Date("2014-11-01") - x))]
  )

    # Generate single-row data frame where each column is a delta
  generate_deltas <- function(x, date){
    map_dfc(
      deltas,
      \(d){
        x[date == d(date)] |> round(1) |> paste0('%')
      }
    )
  }

all_data <- bind_rows(current,
                      three,
                      twelve,
                      youth) |>
  group_by(series_id) |>
  arrange(desc(date)) %>%
  summarise(cdate = date[1],
            current_date = format(date[1], "%b %Y"),
            current_value = value[1] |> round(1) |> paste0('%'),
            deltas = generate_deltas(value, date)) |>
  tidyr::unnest(deltas)

recent <- max(unique(all_data$cdate))
current_label <- glue::glue('Current\n({recent |> format("%B %Y")})')

out <- lu |> 
  left_join(all_data) |>
  mutate(type = case_when(
    type == 'curr_series'  ~ 'Victoria (Seasonally Adjusted)',
    type == 'three_series' ~ 'Regional (3 month average)',
    TRUE ~ 'Youth (12 month average)'
  )) |>
  mutate(label = case_when(
    cdate != recent ~ paste0(label, '*'),
    TRUE ~ label
  )) |>
  select(` ` = type,
         `Unemployment Rate` = label,
         current_value,
         `Last Year`,
         `Nov 2014`) |>
  rename({{current_label}} := current_value)



as_grouped_data(out, groups = " ") |>
  flextable() |>
    width(j = 1, width = 2, unit = "in") |>
    width(j = 2, width = 3, unit = "in") |>
    flextable::bold(j = c(1,3), part = "all") |>
    flextable::font(fontname = "Arial") |>
    flextable::font(fontname = "Arial", part = "header") |>
    flextable::fontsize(size = 8, part = 'all') |>
    flextable::bold(i = 1, part = "header") |>
    flextable::bg(i = 1, bg = "#003366", part = "header") |>
    flextable::color(color = "white", part = "header") |>
    flextable::hline(border = officer::fp_border(color="gray", width = 1)) |>
    flextable::width(j = 1, width = 2) |>
    flextable::set_table_properties(width = 1) |>
  add_footer_lines(values = glue::glue('* figures are for {min(unique(all_data$cdate)) |> format("%B %Y")}'))