加快 data.frame 操作而不是循环

Question

我在R中有以下数据集

dat <- data.frame(t = rep(seq(1, 5, 1),4), id = rep(c(rep("A",5), rep("B",5), rep("C",5), rep("D",5)), 1),
                  x = 1:20, y = 51:70, h = c(rep(1,10), rep(0,10) ) ) 
require(dplyr)
dat <- arrange(dat, t)

数据集是一个面板，t 作为时间变量，id 作为主题 ID。我需要附加一个额外的行，在这里我计算 x 乘以 y 在时间 t 的其余科目的总和，并将其除以 x 在时间 @ 其余科目的变量的标准偏差987654329@。对于 h == 0 的主题，这一新行应显示为零。

例如，对于主题A在时间t == 1，操作是：(6 * 56 + 11 * 61 + 16 * 66) / sd(c(6, 11, 16))。主题B 在时间t == 1 的类似操作是(1 * 51 + 11 * 61 + 16 * 66) / sd(c(1, 11, 16))。但是，对于主题 C 和 D，新行将仅包含 0。

没有循环的最快方法是什么？我相信dplyr 包是最快的，但我对它很陌生，我不确定如何处理它。在我的尝试中，我首先按时间分组，然后收集变量，但我收到警告并且删除了几个变量。我不确定如何为每个组选择变量。

dat %>%
  group_by(t) %>%
  gather(key, value, -t)
# Warning message:
# attributes are not identical across measure variables;
# they will be dropped

调理

如何在前面的操作中包含一个条件，使得在下表中，该操作仅在cond == id 时计算。例如，对于第一行，我们将有：0，因为主题 B、C 和 D 的值都不同于它们的 id（cond 是 A）。对于第 6 行，操作是 (2*52 + 12*62 + 17*67) / sd(c(2,12,17))。

dat <- data.frame(t = rep(seq(1, 5, 1),4), id = rep(c(rep("A",5), rep("B",5), rep("C",5), rep("D",5)), 1),
                  x = 1:20, y = 51:70, h = c(rep(1,10), rep(0,10) ) )
dat <- arrange(dat, t)
dat <- data.frame(dat, cond = c("B", "A", "A", "A", "A", "B", "C", "D", "A", "B", "D", "C", "A", "D", "C", "A", "A", "C", "C", "B") )
dat

#    t  id x y  h   cond
# 1  1  A  1 51 1    B
# 2  1  B  6 56 1    A
# 3  1  C 11 61 0    A
# 4  1  D 16 66 0    A
# 5  2  A  2 52 1    A
# 6  2  B  7 57 1    B
# 7  2  C 12 62 0    C
# 8  2  D 17 67 0    D
# 9  3  A  3 53 1    A
# 10 3  B  8 58 1    B
# 11 3  C 13 63 0    D
# 12 3  D 18 68 0    C
# 13 4  A  4 54 1    A
# 14 4  B  9 59 1    D
# 15 4  C 14 64 0    C
# 16 4  D 19 69 0    A
# 17 5  A  5 55 1    A
# 18 5  B 10 60 1    C
# 19 5  C 15 65 0    C
# 20 5  D 20 70 0    B

建议的解决方案

dat %>% 
 filter(id == cond) %>% 
 group_by(t) %>% 
 mutate(new = h * ((sum(x *y) - (x * y))/map_dbl(row_number(), ~ sd(x[-.x])))) %>% 
 bind_rows(dat %>% filter(id != cond))

效果很好，但部分效果很好，因为它通过乘以 0 * Inf 创建了 NaN。相反，当条件不适用或分母的标准差为0 时，我希望有0。非常感谢！

Answer 1

按“t”分组后，通过取“x”和“y”乘积的sum与乘积“x”和“y”之差创建“新”列（排除当前行乘积）并通过遍历行索引（row_number()）来获取'x'元素的sd来除以用于排除当前行并乘以'h'，这样我们就得到0，其中' h' 为 0。

library(tidyverse)
out <- dat %>% 
         group_by(t) %>% 
         mutate(new =  h * ((sum(x *y) - (x * y))/map_dbl(row_number(),
                                                     ~ sd(x[-.x]))))
head(out, 4)
# A tibble: 4 x 6
# Groups:   t [1]
#      t id        x     y     h   new
#  <dbl> <fct> <int> <int> <dbl> <dbl>
#1     1 A         1    51     1  413.
#2     1 B         6    56     1  233.
#3     1 C        11    61     0    0 
#4     1 D        16    66     0    0