在两组向量上进行 for 循环的 purrr 解决方案

Question

我正在寻找一个 purrr 解决方案来完成我使用 for 循环所做的事情。我怀疑它将是 map2 或 pmap 的一个版本。我查看了文档，提供的简单案例很有意义，但我无法弄清楚如何将其用于我的案例。

在下面的数据框中，“总和”列包含给定 SKU 的月度预测。 “结束”列包含给定月份的月底日期。我应用的规则是，如果年份（列末尾的最后两位数字）大于 22，我将给定月份/SKU 的 Sum 列中的相应值替换为 0。我目前使用的代码（其中作品）在下面。

sample.data.frame <- data.frame(SKU = c('ABC', 'DEF', 'GHI'), 
'Sum Month 01' = c(3, 9, 8), 'Sum Month 02' = c(5, 10, 4), 
'Sum Month 03' = c(9, 6, 5), 'Sum Month 04' = c(5, 9, 10), 
'End of Month 01' = rep('10/28/22', 3), 
'End of Month 02' = rep('12/02/22', 3), 
'End of Month 03' = rep('12/30/22', 3), 
'End of Month 04' = rep('01/27/23', 3), check.names = F)

for (i in seq_along(sample.data.frame[grepl("Sum Month", colnames(sample.data.frame))])){
    if (substr(sample.data.frame[grepl("End of", colnames(sample.data.frame))][[i]][[1]], 7, 8) > 22){
      sample.data.frame[grepl("Sum Month", colnames(sample.data.frame))][[i]] <- 0
    }
  
}

此外，我根据上面的代码编写了以下函数，该函数适用于日期向量和数字向量。我不知道如何使它适用于日期和数字的多个向量（例如，数据框的各个列）。

data.replace.fcn <- function(date.col, number.col){
  for (i in seq_along(date.col)) {
  if (substr(date.col[i], 7, 8) > 22) {
    number.col[i] <- 0
  } else {
    number.col[i] <- number.col[i]
     
  }
    
  }
  return(number.col)
}

提前感谢您的帮助。

Answer 1

您可以在这里使用purrr 中的map2 对"Sum Month" 和"End of" 列进行成对操作。

library(dplyr)
library(purrr)

map2_df(select(sample.data.frame, starts_with('Sum Month')), 
        select(sample.data.frame, starts_with('End of')), 
        ~if_else(substr(.y, 7, 8) > 22, 0, .x))

#   `Sum Month 01` `Sum Month 02` `Sum Month 03` `Sum Month 04`
#           <dbl>          <dbl>          <dbl>          <dbl>
#1              3              5              9              0
#2              9             10              6              0
#3              8              4              5              0

同样的内容可以写在base R中，使用mapply/Map：

sum_month <- grep('Sum Month', names(sample.data.frame))
end_month <- grep('End of', names(sample.data.frame))

sample.data.frame[sum_month] <- Map(function(x, y) 
               ifelse(substr(y, 7, 8) > 22, 0, x), 
                sample.data.frame[sum_month], sample.data.frame[end_month])

Answer 2

作为 purrr 的替代方法，您可以尝试先将数据转换为整洁的格式吗？那么它只是一个 if_else 语句来得到你想要的。

library(tidyverse)

# using your input data.frame
sample.data.frame %>% 
  
  pivot_longer(
    cols = -SKU,
    names_to = c(".value", "Month"),
    names_pattern = "(.*) (\\d\\d)",
    names_transform = list(Month = readr::parse_integer),
    values_transform = list(`End of Month` = lubridate::mdy, `Sum Month` = as.integer)
  ) %>% 
  
  mutate(`Sum Month` = if_else(lubridate::year(`End of Month`) > 2022, 0L, `Sum Month`))

Answer 3

在我看来，最简单的方法是将数据转换为 tidy 格式（每个变量是一列，每个观察值是一行），tidyverse 中的大多数函数设计：

library(tidyverse)
sample.data.frame_long <- sample.data.frame %>% 
  pivot_longer(cols = c(starts_with("Sum Month"), starts_with("End of Month")),
               names_to = c(".value", "Month"),
               names_pattern =  "(\\w+).*?(\\d+)")
sample.data.frame_long
#> # A tibble: 12 x 4
#>    SKU   Month   Sum End     
#>    <chr> <chr> <dbl> <chr>   
#>  1 ABC   01        3 10/28/22
#>  2 ABC   02        5 12/02/22
#>  3 ABC   03        9 12/30/22
#>  4 ABC   04        5 01/27/23
#>  5 DEF   01        9 10/28/22
#>  6 DEF   02       10 12/02/22
#>  7 DEF   03        6 12/30/22
#>  8 DEF   04        9 01/27/23
#>  9 GHI   01        8 10/28/22
#> 10 GHI   02        4 12/02/22
#> 11 GHI   03        5 12/30/22
#> 12 GHI   04       10 01/27/23

完成此操作后，比较两个变量会容易得多：

sample.data.frame_long %>% 
  mutate(Sum = ifelse(
    as.numeric(str_extract(End, "\\d+$")) > 22, 0, Sum))
#> # A tibble: 12 x 4
#>    SKU   Month   Sum End     
#>    <chr> <chr> <dbl> <chr>   
#>  1 ABC   01        3 10/28/22
#>  2 ABC   02        5 12/02/22
#>  3 ABC   03        9 12/30/22
#>  4 ABC   04        0 01/27/23
#>  5 DEF   01        9 10/28/22
#>  6 DEF   02       10 12/02/22
#>  7 DEF   03        6 12/30/22
#>  8 DEF   04        0 01/27/23
#>  9 GHI   01        8 10/28/22
#> 10 GHI   02        4 12/02/22
#> 11 GHI   03        5 12/30/22
#> 12 GHI   04        0 01/27/23

或者先转换成合适的日期：

sample.data.frame_long%>% 
  mutate(End2 = lubridate::mdy(End)) %>% 
  mutate(Sum = ifelse(End2 > "2022-12-31", 0, Sum))
#> # A tibble: 12 x 5
#>    SKU   Month   Sum End      End2      
#>    <chr> <chr> <dbl> <chr>    <date>    
#>  1 ABC   01        3 10/28/22 2022-10-28
#>  2 ABC   02        5 12/02/22 2022-12-02
#>  3 ABC   03        9 12/30/22 2022-12-30
#>  4 ABC   04        0 01/27/23 2023-01-27
#>  5 DEF   01        9 10/28/22 2022-10-28
#>  6 DEF   02       10 12/02/22 2022-12-02
#>  7 DEF   03        6 12/30/22 2022-12-30
#>  8 DEF   04        0 01/27/23 2023-01-27
#>  9 GHI   01        8 10/28/22 2022-10-28
#> 10 GHI   02        4 12/02/22 2022-12-02
#> 11 GHI   03        5 12/30/22 2022-12-30
#> 12 GHI   04        0 01/27/23 2023-01-27