R - 获取由不同数据框中的值定义的一组列中的最高/最低值

Question

我有两个数据框：一个 (A) 包含事件的开始日期和结束日期（儒略日期，因此是连续的天数），另一个 (B) 包含从开始日期到结束日期之后的日期值在第一个数据框中。 A中的开始日期是稳定的，结束日期是变化的。

我希望能够为每一行确定开始和结束之间（最高和/或最低值）变化最大幅度的值 B 中系列中的日期，然后写入新的数据帧。

示例数据框

dfA <- data.frame(ID = c(1,2,3,4,5), 
                  startDate = rep(1001,5),
                  endDate = c(1007, 1003, 1004, 1005, 1006))

dfB <- data.frame(ID = c(1,2,3,4,5),
                  "1001" = c(0.5,0.3,1,2,1.1),
                  "1002" = c(0.9,0.3,0.5,1.0,1.2), 
                  "1003" = c(0.8,0.3,0.1,1,2), 
                  "1004" = c(1,0.7,0.8,0.9,1.1), 
                  "1005" = c(2,1,3,1,4), 
                  "1006" = c(1,0.5,0.1,0.3,2), 
                  "1007" = c(1,2,3,4,5),
                  "1008" = c(0.5,1,2,1,0.3))

所以，对于ID = 1，我想在B 中找到1001 和1007 之间的最低值，即开始日期和结束日期。然后将其重复为ID = 1,2,3...n

tidyverse 包中有解决方案吗？

提前致谢。

Answer 1

受马特回答的启发，但在时间间隔内内取最高和最低值（据我了解问题）：

test2 <- left_join(dfA, dfB, by = "ID") %>% 
  pivot_longer(-c(ID, startDate, endDate)) %>% 
  mutate(name = str_remove(name, "X")) %>% 
  filter(name >= startDate & name <= endDate) %>% #here we keep only the rows with name between startDate and endDate
  group_by(ID) %>%
  mutate(highest = max(value), 
         lowest = min(value)) %>% 
  select(ID, highest, lowest) %>% 
  distinct()

Answer 2

很难说出您的预期输出应该是什么，但这是通过加入数据帧的dplyr/tidyverse 方法：

library(tidyverse)

    left_join(dfA, dfB, by = "ID") %>% 
  pivot_longer(-c(ID, startDate, endDate)) %>% 
  group_by(ID) %>%
  mutate(name = str_remove(name, "X"),
         highest = max(value), 
         lowest = min(value)) %>% 
  filter(name <= endDate) 

这给了我们：

     ID startDate endDate name  value highest lowest
   <dbl>     <dbl>   <dbl> <chr> <dbl>   <dbl>  <dbl>
 1     1      1001    1007 1001    0.5       2    0.5
 2     1      1001    1007 1002    0.9       2    0.5
 3     1      1001    1007 1003    0.8       2    0.5
 4     1      1001    1007 1004    1         2    0.5
 5     1      1001    1007 1005    2         2    0.5
 6     1      1001    1007 1006    1         2    0.5
 7     1      1001    1007 1007    1         2    0.5
 8     2      1001    1003 1001    0.3       2    0.3
 9     2      1001    1003 1002    0.3       2    0.3
10     2      1001    1003 1003    0.3       2    0.3
11     3      1001    1004 1001    1         3    0.1
12     3      1001    1004 1002    0.5       3    0.1
13     3      1001    1004 1003    0.1       3    0.1
14     3      1001    1004 1004    0.8       3    0.1
15     4      1001    1005 1001    2         4    0.3
16     4      1001    1005 1002    1         4    0.3
17     4      1001    1005 1003    1         4    0.3
18     4      1001    1005 1004    0.9       4    0.3
19     4      1001    1005 1005    1         4    0.3
20     5      1001    1006 1001    1.1       5    0.3

Answer 3

基础 R 解决方案：

如果范围内的所有日期都在 dfB 中作为向量存在：

# Enure all dates in range have a corresponding vector in dfB copy:
jdrng <- seq(min(dfA$startDate, na.rm = TRUE), max(dfA$endDate, na.rm = TRUE))
prod_df <- merge(dfA, dfB, by = "ID")

# Calculate vector indicies to be used in roc, max and min value calcs:
vnidx <- which(grepl("^X\\d+", names(prod_df)))
strtidx <- vnidx[match(prod_df$startDate, jdrng)]
endidx <- vnidx[match(prod_df$endDate, jdrng)]

# Calculate moc, max and min vals:
res <- cbind(ID = prod_df$ID, do.call(rbind, Map(function(x, y, z) {
  data.frame(moc = (x[, z] - x[, y]) / x[, y],
             maxval = max(unlist(x[, y:z]), na.rm = TRUE),
             minval = min(unlist(x[, y:z]), na.rm = TRUE))
}, split(prod_df, prod_df$ID), strtidx, endidx)))

如果没有：

# Ensure all dates in range have a corresponding vector in dfB copy:
jdrng <- seq(min(dfA$startDate, na.rm = TRUE), max(dfA$endDate, na.rm = TRUE))
jdvecs <- as.integer(gsub("\\D+", "", grep("^X\\d+", names(dfB), value = TRUE)))
if(!identical(jdrng, jdvecs)){dfB[,paste0("X", setdiff(jdrng, jdvecs))] <- NA_real_}
prod_df <- merge(dfA,
                 dfB[, c(names(dfB)[!grepl("^X\\d+", names(dfB))],
                         paste0("X", sort(jdrng))),], by = "ID")

# Calculate vector indicies to be used in roc, max and min value calcs:
vnidx <- which(grepl("^X\\d+", names(prod_df)))
strtidx <- vnidx[match(prod_df$startDate, jdrng)]
endidx <- vnidx[match(prod_df$endDate, jdrng)]

# Calculate moc, max and min vals:
res <- cbind(ID = prod_df$ID, do.call(rbind, Map(function(x, y, z) {
  data.frame(moc = (x[, z] - x[, y]) / x[, y],
             maxval = max(unlist(x[, y:z]), na.rm = TRUE),
             minval = min(unlist(x[, y:z]), na.rm = TRUE))
}, split(prod_df, prod_df$ID), strtidx, endidx)))