Продолжительность отсчета от интервалов в R

Question

Мне нужно посчитать из общего периода, в течение которого каждый человек принимал участие в исследовании, сколько времени они дали по возрастным интервалам. Возраст представлен в днях. Например, первый участник начал в 1306 году и закончил в 8509, для первого интервала он выделил 520 дней (1826-1306), для второго интервала он внес 1460 дней (3287 - 1827) и так далее до возраста 14,999. года. Более конкретно, я хочу разделить общую продолжительность до 14,9999 лет на четыре переменные, каждая из которых содержит общую продолжительность для каждого интервала.

library(tidyverse)
Age4 <- round(4.999*365.25) 
Age8 <- round(8.999*365.25) 
Age12 <- round(12.999*365.25) 
Age14 <- round(14.999*365.25) 

df <- tibble(code = 1:15, start_age = round(rnorm(15, 2000, 1500)), end_age = round(rnorm(15, 6000, 2000)),
             mo_dur = end_age - start_age, 
         Age4 , # from 0 to 4.99, 
         Age8 , # from 5 to 8.999
         Age12, # from 9 to 12.999
         Age14) # from 13 to 14.999

    code start_age end_age mo_dur  Age4  Age8 Age12 Age14
      1      1306    8509   7203  1826  3287  4748  5478
      2      2007    3743   1736  1826  3287  4748  5478
      3      4176    9119   4943  1826  3287  4748  5478
      4      3129    7416   4287  1826  3287  4748  5478
      5      3449    7869   4420  1826  3287  4748  5478
      6      2703    7367   4664  1826  3287  4748  5478
      7      1639    8038   6399  1826  3287  4748  5478
      8      3549    5519   1970  1826  3287  4748  5478
      9      1040    9355   8315  1826  3287  4748  5478
     10        26    6818   6792  1826  3287  4748  5478
     11      2543    4223   1680  1826  3287  4748  5478
     12      3082    4602   1520  1826  3287  4748  5478
     13      5728    7040   1312  1826  3287  4748  5478
     14       522    8314   7792  1826  3287  4748  5478
     15      1492    5779   4287  1826  3287  4748  5478

ggplot(df) + 
  geom_segment(aes(x = start_age/365.25, xend = end_age/365.25,
               y = code, yend = code ), 
           arrow = arrow(length = unit(0.03, "npc"))) +
 geom_point(aes(start_age/365.25, code)) +
 geom_text(vjust = -0.5, hjust=0, size = 3,
        aes(x = start_age/365.25, y = code, 
            label = paste(round(mo_dur/365.25, 2), "Total duration"))) +
 geom_vline(xintercept = Age4/365.25, color = "red") + geom_vline(xintercept = Age8/365.25, color = "red") + 
 geom_vline(xintercept = Age12/365.25, color = "red") + geom_vline(xintercept = Age14/365.25, color = "red")

Редактировать: Я сделал это с ужасным кодом, но это то, что я ожидаю:

df %>%
  mutate(
     firstcont = Age4 - start_age,
     firstcont = if_else(firstcont < 0, 0, firstcont),
     firstcont = if_else((end_age <= Age4), start_age+end_age,firstcont),
     second = if_else(firstcont == 0 & (start_age >= Age4) & (end_age <= Age8), end_age-start_age, 0),
     second = if_else(firstcont == 0 & (start_age <= Age8) & (end_age >= Age8), Age8-start_age, second),
     second = if_else(firstcont != 0 & (end_age <= Age4), 0, second),
     second = if_else(firstcont != 0 & (end_age >= Age4) & (end_age <= Age8), end_age-Age4, second),
     second = if_else(firstcont != 0 & (end_age >= Age4) & (end_age >= Age8), Age8-Age4, second),

     third = if_else(second == 0 & (start_age >= Age8) & (end_age <= Age12), end_age-start_age, 0),
     third = if_else(second == 0 & (start_age <= Age12) & (end_age >= Age12), Age12-start_age, third),
     third = if_else(second != 0 & (end_age <= Age8), 0, third),
     third = if_else(second != 0 & (end_age >= Age8) & (end_age <= Age12), end_age-Age8, third),
     third = if_else(second != 0 & (end_age >= Age8) & (end_age >= Age12), Age12-Age8, third),

     fourth = if_else(third == 0 & (start_age >= Age12) & (end_age <= Age14), end_age-start_age, 0),
     fourth = if_else(third == 0 & (start_age <= Age14) & (end_age >= Age14), Age14-start_age, fourth),
     fourth = if_else(third != 0 & (end_age <= Age12), 0, fourth),
     fourth = if_else(third != 0 & (end_age >= Age12) & (end_age <= Age14), end_age-Age12, fourth),
     fourth = if_else(third != 0 & (end_age >= Age12) & (end_age >= Age14), Age14-Age12, fourth),

     total = firstcont+second+third+fourth)

Answer 1

Учитывая описание проблемы, приведенное ниже решение является сложным, но я считаю, что оно делает свою работу. Это базовое решение R.

contribAge <- function(X){
  f <- function(start_age, ages){
    inx <- findInterval(start_age, c(0, ages))
    res <- numeric(length(ages))
    if(inx < length(ages)){
      d <- diff(c(start_age, a[inx:length(ages)]))
      res[inx:length(ages)] <- d
    }
    res
  }
  inx_ages <- grep("Age", names(X))
  Ages <- X[, inx_ages]
  Start_Age <- X[['start_age']]
  res <- lapply(seq_along(Start_Age), function(k){
    f(Start_Age[k], unlist(Ages[k, ]))
  })
  res <- do.call(rbind.data.frame, res)
  names(res) <- paste(names(X)[inx_ages], "Count", sep = "_")
  res
}

contribAge(df)