从月份推断季度列,从季度推断月列

时间:2020-03-31 21:32:37

标签: r dplyr tidyverse lapply purrr

我有一个列名称相同的数据帧列表,但是某些df具有季度信息,而另一些具有月份信息。有些同时具有或缺少两者。所有数据框都有年份信息。我正在尝试建立条件并导出缺少的信息,以最终获得新列QtrYrDate

library(dplyr)
df <- dplyr::tibble(
  m = c(1, 2, NA, NA, NA, NA, 7, NA, 9, NA, NA, 12, NA),
  q = c(NA, NA, 1, 2, 2, 2, NA, 3, 3, 4, 4, 4, NA),
  y = c(2016, 2016, 2016, 2017, 2017, 2017, 2018 , 2018 , 2018 , 2020, 2020, 2020, 2020)
)
print(df)
#> # A tibble: 13 x 3
#>        m     q     y
#>    <dbl> <dbl> <dbl>
#>  1     1    NA  2016
#>  2     2    NA  2016
#>  3    NA     1  2016
#>  4    NA     2  2017
#>  5    NA     2  2017
#>  6    NA     2  2017
#>  7     7    NA  2018
#>  8    NA     3  2018
#>  9     9     3  2018
#> 10    NA     4  2020
#> 11    NA     4  2020
#> 12    12     4  2020
#> 13    NA    NA  2020

lsdf <- list(df1 = df, df2 = df)

所需的输出。

out_df <- dplyr::tibble(
  m = c(1, 2, NA, NA, NA, NA, 7, NA, 9, NA, NA, 12, NA),
  q = c(NA, NA, 1, 2, 2, 2, NA, 3, 3, 4, 4, 4, NA),
  y = c(2016, 2016, 2016, 2017, 2019, 2020, 2017, 2019, 2020, 2016, 2017, 2019, 2020),
  qy = c("Q1/2016", "Q1/2016", "Q1/2016", "Q2/2017", "Q2/2017", "Q2/2017", "Q3/2018", "Q3/2018", "Q3/2018", "Q4/2020", "Q4/2020", "Q4/2020", NA),
  dy = c("3/1/2016", "3/1/2016", "3/1/2016", "6/1/2017", "6/1/2017", "6/1/2017", "9/1/2018", "9/1/2018", "9/1/2018", "12/1/2020", "12/1/2020", "12/1/2020", NA)
)

print(out_df)
#> # A tibble: 13 x 5
#>        m     q     y qy      dy       
#>    <dbl> <dbl> <dbl> <chr>   <chr>    
#>  1     1    NA  2016 Q1/2016 3/1/2016 
#>  2     2    NA  2016 Q1/2016 3/1/2016 
#>  3    NA     1  2016 Q1/2016 3/1/2016 
#>  4    NA     2  2017 Q2/2017 6/1/2017 
#>  5    NA     2  2019 Q2/2017 6/1/2017 
#>  6    NA     2  2020 Q2/2017 6/1/2017 
#>  7     7    NA  2017 Q3/2018 9/1/2018 
#>  8    NA     3  2019 Q3/2018 9/1/2018 
#>  9     9     3  2020 Q3/2018 9/1/2018 
#> 10    NA     4  2016 Q4/2020 12/1/2020
#> 11    NA     4  2017 Q4/2020 12/1/2020
#> 12    12     4  2019 Q4/2020 12/1/2020
#> 13    NA    NA  2020 <NA>    <NA>

我尝试使用case_when,以为它相当简单,但看起来要么我没有按预期通过它,要么完全是错误的方向。

lsdf$df1 %>% dplyr::mutate(
  Qrt = dplyr::case_when(
   is.na(m) & is.na(q) ~ NA,
   is.na(m) & !is.na(q) ~ q,
   m != NULL & q == NA ~ paste0("Q",ceiling(as.numeric(m)/3)),
   m != NULL & q != NULL ~ paste0("Q", q)
))
#> Error: `m != NULL & q == NA ~ paste0("Q", ceiling(as.numeric(m)/3))`, `m != NULL & q != NULL ~ paste0("Q", q)` must be length 13 or one, not 0

reprex package(v0.3.0)于2020-03-31创建

以为我可以获取Qtryear列,然后运行此zoo函数以获取日期。

 x <- c("Q1/13", "Q2/14")
as.Date(zoo::as.yearqtr(x, format = "Q%q/%y"))

感谢您解决此问题的任何帮助。

2 个答案:

答案 0 :(得分:1)

case_whenif_else进行类型检查,因此所有条件输出都必须是同一类型。同样,不清楚为什么NULL应该在向量即上检查。列为NULL的列会被自动删除,并且可以存在于list env

c(NA, NULL, 1:3)
[1] NA  1  2  3

list(NULL, NULL, 1:3) 
#[[1]]
#NULL

#[[2]]
#NULL

#[[3]]
#[1] 1 2 3

在第二种情况下,NULL将保持不变


在这里,如果我们要进行检查,请同时使用is.nullis.na,并确保输出为单一类型,q列为numeric(转换为character),而默认情况下将NA转换为逻辑(因此请使用NA_character_,因为最后一个条件输出会使用character创建一个paste字符串)

library(dplyr)
lsdf$df1 %>% dplyr::mutate(
   Qrt = dplyr::case_when(
    is.na(m) & is.na(q) ~ NA_character_,
    is.na(m) & !is.na(q) ~ as.character(q),
     !is.null(m) & !is.na(q) ~ paste0("Q",ceiling(as.numeric(m)/3)),
      !is.null(m) & !is.null(q) ~ paste0("Q", q)
 ))

由于它是list,因此请使用map来循环list

library(purrr)
map(lsdf, ~ .x %>% dplyr::mutate(
   Qrt = dplyr::case_when(
    is.na(m) & is.na(q) ~ NA_character_,
    is.na(m) & !is.na(q) ~ as.character(q),
     !is.null(m) & !is.na(q) ~ paste0("Q",ceiling(as.numeric(m)/3)),
      !is.null(m) & !is.null(q) ~ paste0("Q", q)
 )))

更新

如果我们需要更新后的“ qy”列

library(tidyr)
library(stringr)
library(zoo)
library(lubridate)
map(lsdf, ~ 
          .x %>%
              mutate(q1 = q) %>%
              fill(q, .direction = "downup") %>%
               mutate(qy = case_when(is.na(m) & is.na(q1) ~ NA_character_, 
                       TRUE ~ str_c("Q", q, "/", y))) %>%
               select(-q1)%>% 
               mutate(dy = floor_date(as.Date(as.yearqtr(qy, "Q%q/%Y"), frac = 1), "month"))))

答案 1 :(得分:1)

这是你的追求吗?

lsdf$df1 %>% 
  mutate(Qrt = case_when(
    !is.na(q) ~ q,
    !is.na(m) & is.na(q) ~ ceiling(as.numeric(m)/3),
    is.na(m) & is.na(q) ~ NA_real_
  )) %>%
  mutate(x = ifelse(is.na(Qrt), NA, paste0(Qrt, "/", y))) %>%
  mutate(x = as.Date(zoo::as.yearqtr(x, format = "%q/%y")))

我稍微整理一下您的case_。问题是您正在尝试组合字符和数字输出。我将Qrt变量更改为数字。希望这会有所帮助。