日期选择逻辑

Question

我一直在用 R 写这个逻辑。有人可以帮我写这个逻辑吗？

逻辑：

(Priority1) 对于一个项目，Date1 == Calendar 然后我们必须选择该行。例如 - 项目 B

(Priority2) 对于一个项目，如果不是 Priority1，则 Date1 ~ Calendar 列中的上一个日期，然后选择该行。例如 - 项目 C

(Priority3) 对于一个项目，如果不是 Priority1 & 2，则 Date1 ~ 日历列中的下一个日期，然后选择该行。例如 - 项目 A

输入：

Item   Date1     Calendar
A   2021-01-08  2021-01-11
A   2021-01-08  2021-01-19
B   2021-02-05  2021-01-29
B   2021-02-05  2021-02-05
B   2021-02-05  2021-02-12
C   2021-02-15  2021-02-07
C   2021-02-15  2021-02-13
C   2021-02-15  2021-02-20
C   2021-02-15  2021-02-27

这是数据的dput

input <- structure(list(Item = c("A", "A", "B", "B","B", "C", "C","C","C"), Date1 = c("2021-01-08", 
                                                            "2021-01-08", "2021-02-05", "2021-02-05", "2021-02-05", "2021-02-15", "2021-02-15", "2021-02-15", "2021-02-15"), Calendar = c("2021-01-11", "2021-01-19", "2021-01-29", "2021-02-05","2021-02-12", "2021-02-07","2021-02-13", "2021-02-20", "2021-02-27")), class = "data.frame", row.names = c(NA, -9L))

输出：

Item   Date1     Calendar
A   2021-01-08  2021-01-11
B   2021-02-05  2021-02-05
C   2021-02-15  2021-02-13

这是预期输出的dput。

output <- structure(list(Item = c("A","B", "C"), Date1 = c("2021-01-08","2021-02-05", "2021-02-15"), Calendar = c("2021-01-11","2021-02-05","2021-02-13")), class = "data.frame", row.names = c(NA, -3L))

Answer 1

您可以创建一个辅助函数，将case_when 用于您的逻辑。

数据：

library(tidyverse)
library(lubridate)
input <- structure(list(Item = c("A", "A", "B", "B","B", "C", "C","C","C"),
                        Date1 = c("2021-01-08", "2021-01-08", "2021-02-05", "2021-02-05", "2021-02-05", "2021-02-15", "2021-02-15", "2021-02-15", "2021-02-15"),
                        Calendar = c("2021-01-11", "2021-01-19", "2021-01-29", "2021-02-05","2021-02-12", "2021-02-07","2021-02-13", "2021-02-20", "2021-02-27")),
                   class = "data.frame", row.names = c(NA, -9L))

规则：

# rules are
# 1) get the equal
# 2) get the closest previous
# 3) get the closest next

修改东西

# make things dates
input %>% 
  mutate(Date1 = as_date(Date1),
         Calendar = as_date(Calendar)) -> input

这是您可以使用的辅助函数。

find_proper_row <- function(x){
  case_when(any(x == 0) ~ x == 0,
            any(x < 0) ~ x == max(x[which(x<0)]),
            # if all positive, get the min
            all(x > 0) ~ x == min(x[which(x>0)]))
}

# try it out
> find_proper_row(c(0, 10, -10, 11))
[1]  TRUE FALSE FALSE FALSE
> find_proper_row(c(20, 10, -10, 11))
[1] FALSE FALSE  TRUE FALSE
> find_proper_row(c(20, 10, 10, 11))
[1] FALSE  TRUE  TRUE FALSE

正如你所看到的，在这里，关系可能是个问题，你没有为关系指定规则，但你可以更新函数末尾的逻辑，这样在@上只返回一个TRUE 987654327@矢量。

现在让我们按组计算input 的天数差异。

input %>% 
  mutate(diff = as.numeric(Calendar - Date1)) %>% 
  group_by(Item) %>%
  mutate(keep = find_proper_row(diff)) -> input


# Now you can filter them 
input %>%
  filter(keep)
# select(-diff, - keep) for proper output

哪个产生

  Item  Date1      Calendar    diff keep 
  <chr> <date>     <date>     <dbl> <lgl>
1 A     2021-01-08 2021-01-11     3 TRUE 
2 B     2021-02-05 2021-02-05     0 TRUE 
3 C     2021-02-15 2021-02-13    -2 TRUE 

Answer 2

这是另一种tidyverse 方法。计算Date1 和Calendar 之间的绝对差值。然后，根据上述规则分配优先级值（对于优先级 1、2 或 3）。然后，根据优先级和天数差异进行排序。最后，为每个组取第一行（最高优先级，基于规则和最接近的日期）。

library(tidyverse)

input$Date1 <- as.Date(input$Date1)
input$Calendar <- as.Date(input$Calendar)

input %>%
  mutate(Diff = abs(Date1 - Calendar)) %>%
  group_by(Item) %>%
  mutate(Priority = case_when(
    Diff == 0 ~ 1,
    Date1 > Calendar ~ 2,
    TRUE ~ 3
  )) %>%
  arrange(Priority, Diff) %>%
  slice(1)

输出

  Item  Date1      Calendar   Diff   Priority
  <chr> <date>     <date>     <drtn>    <dbl>
1 A     2021-01-08 2021-01-11 3 days        3
2 B     2021-02-05 2021-02-05 0 days        1
3 C     2021-02-15 2021-02-13 2 days        2