Logic for Date Selection

user_11727464 0
Viewed 42

I am stuck in writing this logic in R. Can someone help me to write this logic?

Logic:

(Priority1) For an Item, Date1 == Calendar then we have to select that row. Eg - Item B

(Priority2) For an Item if not Priority1 then, Date1 ~ Previous date in Calendar column then select that row. Eg - Item C

(Priority3) For an Item if not Priority1 & 2 then, Date1 ~ Next date in Calendar column then select that row. Eg - Item A

Input:

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

This is the dput of the data

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))

Output:

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

This is the dput of the expected output.

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))
conditional-statements r
2 Answers

Here is another tidyverse approach. Calculate the absolute difference between Date1 and Calendar. Then, assign priority values based on rules described above (for priorities 1, 2, or 3). Then, sort based on priority, and the difference in days. Finally, for each group take the first row (highest priority, based on rules and closest date).

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)

Output

  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
user_34606700

You can create a helper function that uses case_when for your logic.

The data:

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))

The rules:

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

Modifying things

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

This is the helper function you can use.

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

As you can see, ties might be a problem here, you didn't specify a rule for ties, but you can probably update the logic at the end of the function such that only one TRUE is returned on the logical vector.

Now let's calculate a difference in days on the input by group.

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

Which produces

  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
user_32159400
Related