的R - 留一个聚集上的分组变量（NA存在）

Question

欲计算从“具有”的数据集，R中新的变量，如下所示：

RE：的“R”值的平均在给定的“Cat”变量值内，不包括具体的观察值（注意：缺少数据存在，我希望RE在R缺失时作为RE的组平均值）。 IE：与RE一样，给定“Cat”变量值内的“I”响应的平均值不包括特定观察值（相同的缺失数据技术）。

下面给出了一个示例数据集和所需的输出。

有：

ID CAT R I … (Additional variables I need to retain) 
1 1 1 3 … 
2 1 2 NA … 
3 1 1 1 … 
4 2 NA 3 … 
5 2 4 5 … 
6 2 4 NA … 

的期望的数据集（ “想”），则应该是：

想要：

ID CAT R I RE IE  … (Additional variables retained) 
1 1 1 3 1.5 1  … 
2 1 2 NA 1 2  … 
3 1 1 1 1.5 3  … 
4 2 NA 3 ... ... … 
5 2 4 5    … 
6 2 4 NA    … 

值得注意的是，下面的基于SQL的溶液产生所需的输出在 SAS，但我无法得到它在R（使用sqldf包）工作。我知道的一个问题是缺少的函数是SAS特定的（通用SQL中不可用）。所有这一切都可能为使用sqldf包的SQL解决方案提供了一个有用的起点：

proc sql; 
create table want as 
select *, 
    (sum(R)-coalesce(R, 0))/(count(R)-1+missing(R)) as RE, 
    (sum(I)-coalesce(I, 0))/(count(I)-1+missing(I)) as IE 
from have 
group by CAT 
order by ID, CAT; 
quit; 

非常感谢您的帮助。

Answer 1

With dplyr如果您熟悉该域中的概念，则可以将函数应用于行的子集，而不会影响其他行，有点像sql中的“窗口”。

创建一个函数来为一个ID组执行所需的计算。使用group_by()对行进行分组，然后将结果传递给mutate()并运行自定义函数。对于分组数据，它一次只会影响一个组，并给出所需的结果。

library(dplyr) 

# Data from example 
have <- read.table(header = TRUE, text = 
"ID CAT R I 
1 1 1 3 
2 1 2 NA 
3 1 1 1 
4 2 NA 3 
5 2 4 5 
6 2 4 NA") 

# Create a leave-one-out mean function -- for a single ID group 

leave_one_out_mean <- function(x) { 
    result <- c() 

    for (i in seq_along(x)) { 
     # note minus-i subsetting is used to subset one observation in each iteration 
     # and the na.rm option to handle missing values 
     result[i] <- mean(x[-i], na.rm = TRUE) 
    } 

    return(result) 
} 

# Use group by but _do not_ pipe the result through summarize() 

want <- have %>% 
    group_by(CAT) %>% 
    mutate(RE = leave_one_out_mean(R), 
      IE = leave_one_out_mean(I)) 

结果

want 

Source: local data frame [6 x 6] 
Groups: CAT [2] 

    ID CAT  R  I RE IE 
    <int> <int> <int> <int> <dbl> <dbl> 
1  1  1  1  3 1.5  1 
2  2  1  2 NA 1.0  2 
3  3  1  1  1 1.5  3 
4  4  2 NA  3 4.0  5 
5  5  2  4  5 4.0  3 
6  6  2  4 NA 4.0  4 

的for循环可以与应用功能所取代，但我之所以如此突出的逻辑，而不是优化执行。

Answer 2

一个基本的R解决方案，没有循环，受你的SQL代码的启发。

d <- read.table(text = 
'ID CAT R I 
1 1 1 3 
2 1 2 NA 
3 1 1 1 
4 2 NA 3 
5 2 4 5 
6 2 4 NA', header = TRUE) 

myfunc <- function(x) { 
    tmp <- x ; tmp[is.na(tmp)] <- 0 
    ((sum(x, na.rm = TRUE)-tmp)/(length(x[!is.na(x)])-1 + is.na(x))) 
} 
RE <- as.vector(t(aggregate(d["R"], d["CAT"], myfunc)$R)) 
IE <- as.vector(t(aggregate(d["I"], d["CAT"], myfunc)$I)) 

cbind(d, RE, IE)