在R中计算连续两个数字的平均值。

Question

我有一个数据集，其中每年都有一些基于特定年份的列数据。

    result_birth <- tibble::tibble( "1970" =c(8.816455, 21.41139,39.0443,51.639236, 59.196197,      100.759485, 76.829107,103.278472,79.348094,99.499991, 81.867081, 78.088601), 
                      "1971"=  c(18.878066 ,30.204906 ,42.790284 ,65.443964 ,69.219577 ,80.546417   ,114.526936 ,94.390332 ,108.234248 ,83.063492 ,103.200096 ,72.99519 ), 
                      "1972"=  c(8.801375 ,22.632107 ,36.462839 ,56.580268 ,69.153661 ,76.697696 ,80.469714 ,109.388518 ,96.815125 ,108.131179 ,69.153661 ,91.785768 ), 
                      "1973"= c(14.675905 ,20.790865 ,31.797794 ,64.818581 ,58.70362 ,86.832438 ,85.609446 ,96.616375 ,97.839367 ,78.271493 ,105.177319 ,53.811652 ))
   
     
     

我想要逐对计算数据的平均值，从数据框的底部开始。最后一行必须与原始数据集相同。例如，对于第一行，我们将得到类似以下的结果：

我写了一些代码来实现这个功能，但是这段代码有两个问题：首先，它从上方开始；因此，第一行必须与旧数据相同（我希望相反，最后一行与旧行相同）。其次，这些代码非常繁琐，我需要更加用户友好的解决方案。

nrows <- nrow(result_birth)

total_birth <- data.frame(matrix(NA, nrow = nrows, ncol = 
ncol(result_birth)))

for (i in 1:ncol(result_birth)) {
    for (j in 2:nrows) {
        total_birth[j, i]<-(result_birth[j,i]+result_birth[j-1,i])/2
    }
}

- Azam Mirzaei

---

对于新的数据集，我不需要旧数据，新数据必须填补旧数据的位置。 - undefined

Answer 1

你可以使用dplyr::lead()和dplyr::mutate中的.names参数来实现这一点。通常你的函数可以简单地是~(.x + lead(.x)) / 2)，但是这会在最后一行留下一个NA值 - 因为你希望最后一行等于行中的原始值，一个快速的解决方法是在其中嵌套一个if_else语句来测试是否存在NA值:

library(dplyr)

result_birth %>% 
  mutate(across(everything(), 
                ~(.x + if_else(!is.na(lead(.x)), lead(.x), .x)) / 2, 
                .names = "mean_{col}"))

输出：

#    `1970` `1971` `1972` `1973` mean_1970 mean_1971 mean_1972 mean_1973
# <dbl>  <dbl>  <dbl>  <dbl>     <dbl>     <dbl>     <dbl>     <dbl>
# 1   8.82   18.9   8.80    14.7      15.1      24.5      15.7      17.7
# 2   21.4    30.2  22.6    20.8      30.2      36.5      29.5      26.3
# 3   39.0    42.8  36.5    31.8      45.3      54.1      46.5      48.3
# 4   51.6    65.4  56.6    64.8      55.4      67.3      62.9      61.8
# 5   59.2    69.2  69.2    58.7      80.0      74.9      72.9      72.8
# 6   101.    80.5  76.7    86.8      88.8      97.5      78.6      86.2
# 7   76.8    115.  80.5    85.6      90.1      104.      94.9      91.1
# 8   103.    94.4  109.    96.6      91.3      101.      103.      97.2
# 9   79.3    108.  96.8    97.8      89.4      95.6      102.      88.1
# 10  99.5    83.1  108.    78.3      90.7      93.1      88.6      91.7
# 11  81.9    103.  69.2    105.      80.0      88.1      80.5      79.5
# 12  78.1    73.0  91.8    53.8      78.1      73.0      91.8      53.8

如果你只想用均值替换原始列（而不是创建新列），只需删除.names参数即可。

result_birth %>% 
  mutate(across(everything(), 
                ~(.x + if_else(!is.na(lead(.x)), lead(.x), .x)) / 2))

- jpsmith

---

亲爱的@jpsmith，如果我想让过程从数据框的底部开始，并且第一行与旧数据相同，那么代码的哪部分必须修改？ - undefined

@AzamMirzaei - 将lead(...)的两个实例都更改为lag(...)。 - undefined

亲爱的@jpsmith，如何使用lead(...)和lag(...)函数来计算类似这样的东西： x是列中的一个数字：(x+(x+1)*2+(x+3)*2+(x+4)*2+x+5)/8 - undefined

样本 <- 样本 %>% 变异(prob = (x + 2 * lead(x) + 2 * lead(x, 2) + 2 * lead(x, 3) + lead(x, 4))/8) %>% 转为数据框() - undefined

Answer 2

另一个选项是使用zoo。根据新的要求进行了编辑。

library(zoo)
library(tidyverse)
result_birth2 <- result_birth %>% 
  mutate(across(everything(),
                .fns = ~rollapply(.x, 2,mean,
                                  align = 'right', partial = T)))

输出：

# A tibble: 12 x 4
# `1970` `1971` `1972` `1973`
# <dbl>  <dbl>  <dbl>  <dbl>
#   1   8.82   18.9   8.80   14.7
# 2  15.1    24.5  15.7    17.7
# 3  30.2    36.5  29.5    26.3
# 4  45.3    54.1  46.5    48.3
# 5  55.4    67.3  62.9    61.8
# 6  80.0    74.9  72.9    72.8
# 7  88.8    97.5  78.6    86.2
# 8  90.1   104.   94.9    91.1
# 9  91.3   101.  103.     97.2
# 10  89.4    95.6 102.     88.1
# 11  90.7    93.1  88.6    91.7
# 12  80.0    88.1  80.5    79.5

- Juan C

---

有没有可能删除旧数据，只保留具有相同列名的新数据？ - undefined

是的，如果您不使用.names参数，它们将自动被替换。 - undefined

亲爱的@JuanC，如果我想让过程从数据框的底部开始，并且第一行与旧数据相同，那么代码的哪个部分必须更改？ - undefined

在代码中将左边改为右边。 - undefined

亲爱的@JuanC，我在我的数据集中想要使用lead(...)和lag(...)函数来计算类似以下的内容： x是列中的一个数字： (x+(x+1)*2+(x+3)*2+(x+4)*2+x+5)/8 直到超过一千个观测值的列的末尾。 - undefined

Answer 3

library(tidyverse)
library(slider)

result_birth <- tibble::tibble( "1970" =c(8.816455, 21.41139,39.0443,51.639236, 59.196197,      100.759485, 76.829107,103.278472,79.348094,99.499991, 81.867081, 78.088601), 
                                "1971"=  c(18.878066 ,30.204906 ,42.790284 ,65.443964 ,69.219577 ,80.546417   ,114.526936 ,94.390332 ,108.234248 ,83.063492 ,103.200096 ,72.99519 ), 
                                "1972"=  c(8.801375 ,22.632107 ,36.462839 ,56.580268 ,69.153661 ,76.697696 ,80.469714 ,109.388518 ,96.815125 ,108.131179 ,69.153661 ,91.785768 ), 
                                "1973"= c(14.675905 ,20.790865 ,31.797794 ,64.818581 ,58.70362 ,86.832438 ,85.609446 ,96.616375 ,97.839367 ,78.271493 ,105.177319 ,53.811652 ))




ave2_birth <- map_dfc(
  result_birth,
  \(x) rev(slide_dbl(.x = rev(x),
                 .f = mean,
                 .before = 1,
                 .complete = FALSE))
)

result_birth
ave2_birth

- Nir Graham