В R: как извлечь информацию о действительных периодах времени и применить ее к другому набору данных?

#r #time #dplyr #period

#r #время #dplyr #точка

Вопрос:

У меня есть наборы данных, которые я хочу объединить:

Набор данных 1: Содержит периоды времени, для которых допустимо значение «perc»:

 set.seed(1)

example_df <- data.frame(ID = rep(1:2, each=2),   
start = c(as.Date("2014-01-01"), as.Date("2014-03-05"), as.Date("2014-01-13"), as.Date("2014-03-15")), 
                         end = c(as.Date("2014-03-05"), as.Date("2014-04-12"), as.Date("2014-03-01"), as.Date("2014-04-02")), 
                         perc = rnorm(mean= 30, sd= 10, 4)) 
  

Набор данных 2: Содержит оплату за каждый месяц:

  month_start <- as.Date("2014-01-01")   months(0:3)
    month_end <-  ceiling_date(month_start, "month") - days(1)

set.seed(1)
example_df2 <-  data.frame(month_start, month_end,
                           ID = rep(1:2, each=4),
                           pay = rnorm(mean= 2000, sd= 80, 8))
  

Цель состоит в том, чтобы рассчитать оплату для каждого человека за каждый месяц на основе того, сколько perc они отработали. Важно учитывать действительные периоды времени для perc, которые могут измениться в течение месяца.

например:

Январь 2014 для идентификатора 1: Pay = 1949.884 (оплата) *23.73546 (perc) / 100

потому что perc действителен для всего января.

Однако для марта perc равен 23,73546 до 5-го числа, а perc равен 31,83643 до конца марта.

Таким образом,

Март 2014 для идентификатора 1: Оплата = 1949.884 (оплата)*23.73546 (perc) / 100 / 31 (дни марта) * 5 1949.884 (оплата) * 31.83643 (perc) / 100 / 31 (дни марта) * 26

Ответ №1:

Начните с left_join() между вашими 2 фреймами данных. Каждый период работы an ID будет реплицироваться в каждом периоде этого платежного месяца ID . Затем, последовательно ifelse() , вы можете определить, следует ли учитывать общий месяц, только часть или не учитывать вообще.

 library(tidyverse)

result <- example_df %>% 
  left_join(example_df2, by = 'ID') %>% 
  mutate(
    TEST_MONTH = ifelse(end >= month_start amp; start < month_end, 1, 0), 
    TEST_DAYS  = ifelse(TEST_MONTH == 1,
                        ifelse(end > month_end,
                               ifelse(start >= month_start, month_end - start   1, month_end - month_start   1), 
                               end - month_start   1), 
                        0),
    PAID = pay * perc/100 * TEST_DAYS / as.numeric(month_end - month_start   1)
  )

result %>% filter(ID == 1)

# ID      start        end     perc month_start  month_end      pay TEST_MONTH TEST_DAYS      PAID
# 1  1 2014-01-01 2014-03-05 23.73546  2014-01-01 2014-01-31 1949.884          1        31 462.81390
# 2  1 2014-01-01 2014-03-05 23.73546  2014-02-01 2014-02-28 2014.691          1        28 478.19633
# 3  1 2014-01-01 2014-03-05 23.73546  2014-03-01 2014-03-31 1933.150          1         5  74.00678
# 4  1 2014-01-01 2014-03-05 23.73546  2014-04-01 2014-04-30 2127.622          0         0   0.00000
# 5  1 2014-03-05 2014-04-12 31.83643  2014-01-01 2014-01-31 1949.884          0         0   0.00000
# 6  1 2014-03-05 2014-04-12 31.83643  2014-02-01 2014-02-28 2014.691          0         0   0.00000
# 7  1 2014-03-05 2014-04-12 31.83643  2014-03-01 2014-03-31 1933.150          1        27 536.03354
# 8  1 2014-03-05 2014-04-12 31.83643  2014-04-01 2014-04-30 2127.622          1        12 270.94364
  

Комментарии:

1. Большое вам спасибо!!! Да, это работает. Я бы не придумал left_join. Имеет смысл. 🙂