Home > Back-end >  How to include a new geography in this table?
How to include a new geography in this table?

Time:11-13

I got this code from someone else and so only know the basic framework. However, to reproduce this you would open a new R markdown document, delete everything below the YAML, and then paste in this. The items in bold below have to be moved to the left for this to knit.

My question is this, how would I bring the United States into the table as a 11th item? Would I do this action in the jolts section or the subtable? United states is code "00". Every state has a two digit state code with the US being "00"

   ```{r setup, include=FALSE}
   knitr::opts_chunk$set(echo = TRUE)
   library(tidyverse)
   library(readxl)
   library(data.table)
   library(tigris)
   library(lubridate)
   library(kableExtra)
   library(zoo)


   knitr::opts_chunk$set(echo = FALSE)


   state_filter <- "Nevada"

 all_state <- states(resolution = "20m", cb = TRUE) %>%
 mutate(fips_num = as.integer(STATEFP)) %>%
 filter(fips_num %in% c(1:56)) %>%
 shift_geometry()

 jolts_import <- fread("https://download.bls.gov/pub/time.series/jt/jt.data.1.AllItems")
 jolts_series <- fread("https://download.bls.gov/pub/time.series/jt/jt.series")
 jolts_states <- fread("https://download.bls.gov/pub/time.series/jt/jt.state")
 jolts_elements <- fread("https://download.bls.gov/pub/time.series/jt/jt.dataelement")


  jolts <- jolts_import %>%
  filter(period != "M13") %>%
  select(-c(footnote_codes)) %>%
  left_join(jolts_series %>% select(-footnote_codes), by = "series_id") %>%
  left_join(jolts_states %>% select(-c(display_level:sort_sequence)), by = "state_code") %>%
  left_join(jolts_elements %>% select(-c(display_level:sort_sequence)), by = 
  "dataelement_code") %>%
  filter(area_code == 0, sizeclass_code == 0, industry_code == 0) %>%
  select(-c(area_code, sizeclass_code, industry_code)) %>%
  mutate(date = ymd(paste(year, str_remove(period, "M"), "01", sep="-")))%>%
  filter(!(state_code %in% c("MW", "NE", "SO", "WE"))) %>%
  mutate(ratelevel_code = case_when(
  ratelevel_code == "L" ~ "Level",
  ratelevel_code == "R" ~ "Rate",
TRUE ~ "Other"),
 periodname = format(date, "%B"),
 value = if_else(ratelevel_code == "Rate", value/100, value*1000)) %>%
 group_by(state_text, dataelement_code, ratelevel_code, seasonal) %>%
 mutate(lag_1mo = lag(value, 1),
     lag_12mo = lag(value, 12),
     change_1mo = value - lag_1mo,
     change_12mo = value - lag_12mo,
     avg_12mo = rollapplyr(data = value, width = 12, FUN = mean, partial = TRUE)) %>%
  ungroup() %>%
  group_by(dataelement_code, ratelevel_code, seasonal, date) %>%
  mutate(rank_value = floor(rank(-value)),
     rank_1mo = floor(rank(-change_1mo)),
     rank_12mo = floor(rank(-change_12mo))
  )

  subtitle <- paste0("Data for ",state_filter,", ",format(max(jolts$date), "%B %Y"))

  jolts_state <- all_state %>% 
  left_join(jolts, by = c("NAME" = "state_text"))

  **```**

  ---
  subtitle: '`r subtitle`'
  ---

  \newpage

  <div class = "row">

  ### Hire Rate

  <div class>

  **```{r}**

 data_filter <- "HI"
 data_text <- jolts_elements %>% filter(dataelement_code == data_filter) %>% 
 pull(dataelement_text) %>% str_to_title()

 sub_table <- jolts %>%
 ungroup() %>%
 filter(
 rank_value <= 5 | rank_value >= 47 | state_text == "United States",
 date == max(date),
 seasonal == "S",
 dataelement_code == data_filter,
 ratelevel_code == "Rate"
 ) %>%
 select(state_text, value, lag_1mo, lag_12mo, rank_value) %>%
 arrange(rank_value) 

 sub_table %>%
 mutate(value = scales::percent(value, accuracy = 0.1),
     lag_1mo = scales::percent(lag_1mo, accuracy = 0.1),
     lag_12mo = scales::percent(lag_12mo, accuracy = 0.1)) %>%
 kable(col.names = c("State","Current","Prior Month","Prior Year","Rank"), align = "lcccr") %>%
 kable_paper("hover", full_width = F, position = "float_left", font_size = 12) %>%
 row_spec(row = which(sub_table$state_text == state_filter), background = "#005a9c", bold = TRUE, color = "white")

CodePudding user response:

So the solution is two parts.

First, put the following code in after the four jolts elements.

 jolts_states <- jolts_states%>%mutate(state_text = if_else(state_text == "Total 
 US", "United States", state_text))

second, one needs to modify the sub table code with the following

 rank_value <= 5 | rank_value >= 47 | state_code == "00",
  • Related