Сопоставить два столбца из двух кадров данных и предоставить другой столбец

Question

Я хочу сопоставить два кадра данных разных измерений (df1 и df2) на основе столбца «Индекс».Затем добавьте два столбца из df2 (shift & shiftdate) в df1 в зависимости от совпадения.Но у меня есть несколько правил, которым я должен следовать.

df1 <- data.frame("Index" = c("Adams10-1", "Adams10-1", "Adams10-2", "Adams10-2", "Ball10-1", "Ball10-2", "Cash10-1", "Cash10-2", "David10-1", "David10-2"),
                    "CaseDate" = c("2005-10-01", "2005-10-01", "2005-10-02", "2005-10-02", "2005-10-01", "2005-10-02", "2005-10-01", "2005-10-02", "2005-10-01", "2005-10-02"),
                    "Type" = c("heart", "local", "knee", "nose", "heart", "foot", "shin", "foot", "spine", "delivery"),
                  "StartTime" = c(1640, 1755, 0112, 0300, 2145, 0233, 2123, 0326, 858, 1024))

df2 <- data.frame("Index" = c("Adams10-1", "Adams10-1", "Ball10-1", "Cash10-1", "David10-1", "David10-1", "David10-3"),
                     "ShiftDate" = c("2005-10-01", "2005-10-01", "2005-10-01", "2005-10-01", "2005-10-01", "2005-10-01", "2005-10-03"),
                  "Shift" = c("OB", "CV", "Night", "Super", "OB", "Day", "OB"),
                  "Multiple" = c("yes", "yes", "no", "no", "yes", "yes", "no"))

Правила:

1. Если есть совпадение между индексом df1 $ и индексом df2 $ И:

   • если df2 $ Multiple == "нет", то добавьте df2 $ Shift и df2 $ ShiftDate к df1

   • , если df2 $ Multiple == "да ", затем введите NA (UNLESS df1 $ Type ==" heart "& df2 $ Shift ==" CV "(в этом случае добавьте сдвиг CV и дату перехода от df2 к df1))

2. Если нет совпадения между индексом df1 $ и индексом df2 $, укажите NA

   • UNLESS df1 $ StartTime> 0000 и <0700 (в этом случаедобавьте df2 $ shift и df2 $ shiftdate от df2 $ shiftdate, то есть за один день до df1 $ CaseDate) </p>

   • UNLESS df1 $ Type == "delivery" & df2 $ Shift = "OB"(в этом случае добавьте df2 $ shift и df2 $ shiftdate от df2 $ shiftdate, которая является одним днем ​​после df1 $ CaseDate)

Я хочу получить результатыниже.

df3 <- data.frame("Index" = c("Adams10-1", "Adams10-1", "Adams10-2", "Adams10-2", "Ball10-1", "Ball10-2", "Cash10-1", "Cash10-2", "David10-1", "David10-2"),
                     "CaseDate" = c("2005-10-01", "2005-10-01", "2005-10-02", "2005-10-02", "2005-10-01", "2005-10-02", "2005-10-01", "2005-10-02", "2005-10-01", "2005-10-02"),
                     "Type" = c("heart", "local", "knee", "nose", "heart", "foot", "shin", "foot", "spine", "delivery"),
                     "StartTime" = c(1640, 1755, 0112, 0300, 2145, 0233, 2123, 0326, 858, 1024),
                     "Shift" = c("CV", NA, NA, NA, "Night", "Night", "Super", "Super", NA, "OB"),
                      "ShiftDate" = c("2005-10-01", NA, NA, NA, "2005-10-01", "2005-10-01", "2005-10-01", "2005-10-01", NA, "2005-10-03"))

Даже если я не могу сделать это на основе всехСами правила, просто получить помощь с соответствием будет полезно.Заранее спасибо!

Answer 1

Я собираюсь сделать здесь некоторые предположения, основываясь на структуре df1 и df2 и содержании целевого набора данных, представленного в вопросе.

• Index - это просто комбинация идентификатора человека (здесь имя) и даты смены или случая. Поэтому мы действительно хотим присоединиться к человеку и дате.
• Multiple в df1 просто определяет, есть ли у человека несколько смен в один день. (Я предполагаю, что no для первой записи David10-1 является опечаткой.) Таким образом, правило 1 действительно о том, имеет ли человек несколько смен в один день.

Если эти два верны, мы можем сделать следующее. Этот код довольно избыточен в нескольких местах; это может быть сильно ужесточено. Но это показывает логику правил очень явно.

library(dplyr)
library(lubridate)

# First, let's do make two changes: (1) convert the dates to real dates, and
# (2) replace Index with Name.
df1 = df1 %>%
  mutate(CaseDate = ymd(CaseDate),
         Name = gsub("[^A-Za-z]", "", Index)) %>%
  select(Name, CaseDate, Type, StartTime)
df2 = df2 %>%
  mutate(ShiftDate = ymd(ShiftDate),
         Name = gsub("[^A-Za-z]", "", Index)) %>%
  select(Name, ShiftDate, Shift)

# Start with df1.
df3 = df1 %>%
  # Bring in matching records in df2.  Filter df2 to records that are either
  # (1) the only record for that person, or (2) CV shifts.
  left_join(df2 %>%
              group_by(Name, ShiftDate) %>%
              mutate(num.shifts = n()) %>%
              filter(num.shifts == 1 | Shift == "CV"),
            by = c("Name", "CaseDate" = "ShiftDate")) %>%
  # We want to keep Shift and ShiftDate for records from df2 that are either
  # (1) the only record for that person, or (2) CV shifts that join to a
  # "heart" type in df1.
  mutate(Shift = case_when(num.shifts == 1 ~ Shift,
                           Type == "heart" & Shift == "CV" ~ Shift,
                           T ~ NA_character_),
         ShiftDate = case_when(num.shifts == 1 ~ CaseDate,
                               Type == "heart" & Shift == "CV" ~ CaseDate)) %>%
  select(Name, CaseDate, Type, StartTime, Shift, ShiftDate) %>%
  # Bring in records in df2 that match on person and whose shift date is the
  # day before the case date.
  left_join(df2 %>%
              group_by(Name, ShiftDate) %>%
              filter(n() == 1) %>%
              mutate(ShiftDateOneDayLater = ShiftDate + 1),
            by = c("Name", "CaseDate" = "ShiftDateOneDayLater")) %>%
  # Keep Shift and ShiftDate only if StartTime is between 0000 and 0700.
  mutate(Shift = case_when(!is.na(Shift.x) ~ Shift.x,
                           StartTime > 0 & StartTime < 700 ~ Shift.y),
         ShiftDate = case_when(!is.na(ShiftDate.x) ~ ShiftDate.x,
                               StartTime > 0 & StartTime < 700 ~ ShiftDate.y)) %>%
  select(Name, CaseDate, Type, StartTime, Shift, ShiftDate) %>%
  # Bring in records in df2 that match on person and whose shift date is the
  # day after the case date.
  left_join(df2 %>%
              group_by(Name, ShiftDate) %>%
              filter(n() == 1) %>%
              mutate(ShiftDateOneDayBefore = ShiftDate - 1),
            by = c("Name", "CaseDate" = "ShiftDateOneDayBefore")) %>%
  # Keep Shift and ShiftDate only if this is a "delivery" case and an "OB"
  # shift.
  mutate(Shift = case_when(!is.na(Shift.x) ~ Shift.x,
                           Type == "delivery" & Shift.y == "OB" ~ Shift.y),
         ShiftDate = case_when(!is.na(Shift.x) ~ ShiftDate.x,
                               Type == "delivery" & Shift.y == "OB" ~ ShiftDate.y)) %>%
  select(Name, CaseDate, Type, StartTime, Shift, ShiftDate)