R-다른 데이터 프레임의 값에 의해 정의 된 열 집합에서 최고 / 최저 값 얻기

Question

두 개의 데이터 프레임이 있습니다. 하나는 (A) 이벤트의 시작 및 종료 날짜 (Julian 날짜, 따라서 연속적인 일 수)를 포함하고 다른 하나 (B)는 시작에서 종료 날짜 이후의 날짜 값을 포함합니다. 데이터 프레임. A의 시작일은 안정적이며 종료일은 다양합니다.

나는 각 행에 대해, 최대로 값을 식별 할 수 있기를 원하는 크기 변화 (최고 및 / 또는 가장 낮은 값) 한 후, B에서 시리즈의 시작과 끝 날짜 사이에 새로운 dataframe에 기록.

데이터 프레임 예

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

Matt의 답변에서 영감을 얻었지만 시간 간격 내 에서 가장 높은 값과 가장 낮은 값을 사용 합니다 (질문을 이해했듯이).

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