如何在此表中包含新的地理？

Posted 2023-02-16

【中文标题】如何在此表中包含新的地理？

【英文标题】：How to include a new geography in this table?

【发布时间】：2021-12-22 13:02:03

【问题描述】：

我从别人那里得到这个代码，所以只知道基本框架。但是，要重现此内容，您将打开一个新的 R markdown 文档，删除 YAML 下的所有内容，然后粘贴。下面粗体的项目必须向左移动才能编织。

我的问题是，我如何将美国列为第 11 项？我会在颠簸部分或子表中执行此操作吗？美国是代码“00”。每个州都有一个两位数的州代码，美国是“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")

【参考方案1】：

所以解决方案分为两部分。

首先，在四个 jolts 元素之后加入以下代码。

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

其次，需要修改子表代码如下

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