根据 R 中第二个 df 的条件进行平均答案

【问题标题】：Make an average based on condition from second df in R根据 R 中第二个 df 的条件进行平均
【发布时间】：2021-05-02 08:34:03
【问题描述】：

我有以下问题。我有两个数据框。在第二个。有关于如何计算第一个数据框中的新列的条件。请参见下面的示例：第一个df：

df1 <- data.frame(country = c("01", "01", "02", "03", "03", "03" , "04", "05"),
                  date = c("2020-01-01", "2020-01-02", "2020-01-02", "2020-01-02", "2020-01-03", "2020-01-04", "2020-01-01", "2020-01-02"),
                  value = c(4, 3, 2, -3, 1.5, 12, 10, 15),
                  blabla = c(23, 41, 32, 8, 50, 27, 8, 7)
)

第二个df：

df2 <- data.frame(       country = c("01",  "02", "03", "04", "05" ),
                  match_country1 = c("02",  "03", "01", "01", "01"), 
                  match_country2 = c("03",  "04", "02", "02", "03"), 
                  match_country3 = c("05",  "05", "04", "03", "04")
)

现在我需要计算一个 new_value，它是 df2 中定义的三个值的平均值。我需要尊重 df1 中的日期。例如，国家“01”和日期“2020-01-01”的 new_value 是国家“02”、国家“03”、国家“05”所有日期“2020-01-01”的平均值。

所需的输出如下：

new_df <- data.frame(country = c("01", "01", "02", "03", "03", "03" , "04", "05"),
                  date = c("2020-01-01", "2020-01-02", "2020-01-02", "2020-01-02", "2020-01-03", "2020-01-04", "2020-01-01", "2020-01-02"),
                  value = c(4, 3, 2, -3, 1.5, 12, 10, 15),
                  blabla = c(23, 41, 32, 8, 50, 27, 8, 7),
                  new_value = c(NA, #because no data for 02, 03, 05 from 2020-01-01
                                (2-3+15)/3,
                                (-3+15)/2, #because no data for 04 from 2020-01-02
                                (3+2)/2, #because no data for 04 from 2020-01-02
                                NA,  #because no data for 01, 02, 04 from 2020-01-03
                                NA,  #because no data for 01, 02, 04 from 2020-01-04
                                4, #because no data for 02, 03 from 2020-01-01
                                (3-3)/2 #because no data for 04 from 2020-01-02
  )
)

请问我该怎么做？

【问题讨论】：

标签： r

【解决方案1】：

这可以使用 SQL 三重连接来完成。对于 df1 中的每一行，通过左连接在 df2 中获取匹配的国家行，然后在 df1 的 b 实例中获取日期相同且在 df2 中有国家匹配的所有行。然后取匹配行中的平均 b 值。

library(sqldf)
sqldf("select a.*, avg(b.value) new_value
  from df1 a
  left join df2 c on a.country = c.country
  left join df1 b on a.date = b.date and 
    b.country in (c.match_country1, c.match_country2, c.match_country3)
  group by a.rowid")

给出这个数据框：

  country       date value blabla new_value
1      01 2020-01-01   4.0     23        NA
2      01 2020-01-02   3.0     41  4.666667
3      02 2020-01-02   2.0     32  6.000000
4      03 2020-01-02  -3.0      8  2.500000
5      03 2020-01-03   1.5     50        NA
6      03 2020-01-04  12.0     27        NA
7      04 2020-01-01  10.0      8  4.000000
8      05 2020-01-02  15.0      7  0.000000

变化

这里有两种变体。第一个生成in (...) 字符串为matches 并将其替换，第二个将df2 转换为长格式，首先是long。

matches <- toString(names(df2)[-1])
fn$sqldf("select a.*, avg(b.value) new_value
  from df1 a
  left join df2 c on a.country = c.country
  left join df1 b on a.date = b.date and b.country in ($matches)
  group by a.rowid")


varying <- list(match_country = names(df2)[-1])
long <- reshape(df2, dir = "long", varying = varying, v.names = names(varying))
sqldf("select a.*, avg(b.value) new_value
  from df1 a
  left join long c on a.country = c.country
  left join df1 b on a.date = b.date and b.country = c.match_country
  group by a.rowid")

【讨论】：

如果有人匹配三个以上的国家，每列的名字会写在in里面吗？还是有通用的方法？
参见末尾添加的变体部分。

【解决方案2】：

这种 tidyverse 方法可能会有所帮助

df1
#>   country       date value blabla
#> 1      01 2020-01-01   4.0     23
#> 2      01 2020-01-02   3.0     41
#> 3      02 2020-01-02   2.0     32
#> 4      03 2020-01-02  -3.0      8
#> 5      03 2020-01-03   1.5     50
#> 6      03 2020-01-04  12.0     27
#> 7      04 2020-01-01  10.0      8
#> 8      05 2020-01-02  15.0      7

df2
#>   country match_country1 match_country2 match_country3
#> 1      01             02             03             05
#> 2      02             03             04             05
#> 3      03             01             02             04
#> 4      04             01             02             03
#> 5      05             01             03             04

suppressMessages(library(tidyverse))

df1 %>% 
  left_join(df2, by = 'country') %>% 
  nest(data = !date) %>%
  mutate(data = map(data, ~.x %>%
                      mutate(across(contains('match'), ~value[match(., country)])) %>%
                      rowwise() %>%
                      mutate(avg = mean(c_across(contains('match')), na.rm = T)) %>%
                      select(!contains('match'))
                    )
         ) %>%
  unnest(data)
#> # A tibble: 8 x 5
#>   date       country value blabla    avg
#>   <chr>      <chr>   <dbl>  <dbl>  <dbl>
#> 1 2020-01-01 01        4       23 NaN   
#> 2 2020-01-01 04       10        8   4   
#> 3 2020-01-02 01        3       41   4.67
#> 4 2020-01-02 02        2       32   6   
#> 5 2020-01-02 03       -3        8   2.5 
#> 6 2020-01-02 05       15        7   0   
#> 7 2020-01-03 03        1.5     50 NaN   
#> 8 2020-01-04 03       12       27 NaN

^{由reprex package (v2.0.0) 于 2021 年 5 月 2 日创建}

【讨论】：

【解决方案3】：

虽然已经有一个accepted answer，但这里是一个基础 R，因为发布的两个答案 (2nd) 需要外部包。

df1$new_value <- with(df1, ave(seq_len(n), date, FUN = function(i){
  mrg <- merge(df1[i, ], df2)
  j <- grep("^match", names(mrg))
  ctry <- unique(df1[i, "country"])
  apply(mrg[j], 1, function(row){
    k <- match(row, ctry)
    if(any(!is.na(k)))
      mean(mrg[k, "value"], na.rm = TRUE)
    else NA_real_
  })
}))

identical(df1$new_value, new_df$new_value)
#[1] TRUE

【讨论】：