R 计算通过外部秩选择的列子集上的行平均值
我有一个数据框，其中包含由多个编码器生成的一组项目评级。并非所有编码人员都对所有项目进行了排名。对于每个项目，我想根据前两名编码员的评分生成一个平均值，如外部排名系统所示。编码员的排名从A（最高）到D（最低）。在我当前的代码中，我按编码器排名（从A到D）对列进行排序，然后使用for循环：R 计算通过外部秩选择的列子集上的行平均值,r,dataframe,R,Dataframe,我有一个数据框，其中包含由多个编码器生成的一组项目评级。并非所有编码人员都对所有项目进行了排名。对于每个项目，我想根据前两名编码员的评分生成一个平均值，如外部排名系统所示。编码员的排名从A（最高）到D（最低）。在我当前的代码中，我按编码器排名（从A到D）对列进行排序，然后使用for循环： CoderA CoderB CoderC CoderD 1 2 1 NA 1 2 1 3 3 NA 3 NA
CoderA CoderB CoderC CoderD
1 2 1 NA 1
2 1 3 3 NA
3 NA NA 4 5
4 7 6 7 6
5 3 3 4 2
6 2 2 NA NA
7 2 NA 2 1
8 5 3 NA 4
9 7 7 6 NA
10 1 NA 3 4
df <- data.frame(
CoderA = c(2,1,NA,7,3,2,2,5,7,1),
CoderB = c(1,3,NA,6,3,2,NA,3,7,NA),
CoderC = c(NA,3,4,7,4,NA,2,NA,6,3),
CoderD = c(1,NA,5,6,2,NA,1,4,NA,4))
df$first_sc <- apply(df, 1, function(x) names(df[which(!is.na(x))])[1])
df$sec_sc <- apply(df, 1, function(x) names(df[which(!is.na(x))])[2])
for (x in seq(1,nrow(df))) {
first_rating <- df[x,df$first_sc[x]]
second_rating <- df[x,df$sec_sc[x]]
df$BestAvg[x] <- (first_rating + second_rating) / 2
}
CoderA CoderB CoderC CoderD
1 2 1 NA 1
2 1 3 NA
3 NA 4 5
4 7 6 7 6
5 3 3 4 2
62NA
7 2 NA 2 1
8 5 3 NA 4
9776NA
101NA34
df使用dplyr
和tidyr
df2 <- df %>% mutate(case=1:n()) %>% #add case numbers
gather(key=coder,value=score,-case) %>% #convert to long format
filter(!is.na(score)) %>% #remove NA scores
arrange(case,coder) %>% #order by case and coder
group_by(case) %>% #group by case
summarise(bestavg=mean(head(score,2))) %>% #mean of top two
right_join(df %>% mutate(case=1:n())) #merge with original data
df2
# A tibble: 10 x 6
case bestavg CoderA CoderB CoderC CoderD
<int> <dbl> <dbl> <dbl> <dbl> <dbl>
1 1 1.5 2 1 NA 1
2 2 2.0 1 3 3 NA
3 3 4.5 NA NA 4 5
4 4 6.5 7 6 7 6
5 5 3.0 3 3 4 2
6 6 2.0 2 2 NA NA
7 7 2.0 2 NA 2 1
8 8 4.0 5 3 NA 4
9 9 7.0 7 7 6 NA
10 10 2.0 1 NA 3 4
df2%变异（case=1:n（））%>%#添加案例编号
聚集（键=编码器，值=分数，-大小写）%>%#转换为长格式
过滤器（！is.na（分数））%>%#删除na分数
安排（案例、编码员）%>%#按案例和编码员排序
分组（个案）%>%#分组（个案）
总结（bestavg=平均值（总分（2）））%>%前两名的平均值
右键连接（df%>%mutate（case=1:n（））#与原始数据合并
df2
#一个tibble:10x6
案例bestavg CoderA CoderB CoderC CoderD
1.5 2 1 NA 1
2.0 1 3北美
3 3 4.5 NA 4 5
4 4 6.5 7 6 7 6
5 5 3.0 3 3 4 2
6 2.0 2不适用
7 2.0 2 NA 2 1
8 4.0 5 3 NA 4
9 9 7.0 7 6 NA
10102.0 1 NA 3 4
如果您的编码者名称按您想要的优先顺序排序（如您所描述的），这将起作用。数据框中列的顺序不相关。使用dplyr
和tidyr
df2 <- df %>% mutate(case=1:n()) %>% #add case numbers
gather(key=coder,value=score,-case) %>% #convert to long format
filter(!is.na(score)) %>% #remove NA scores
arrange(case,coder) %>% #order by case and coder
group_by(case) %>% #group by case
summarise(bestavg=mean(head(score,2))) %>% #mean of top two
right_join(df %>% mutate(case=1:n())) #merge with original data
df2
# A tibble: 10 x 6
case bestavg CoderA CoderB CoderC CoderD
<int> <dbl> <dbl> <dbl> <dbl> <dbl>
1 1 1.5 2 1 NA 1
2 2 2.0 1 3 3 NA
3 3 4.5 NA NA 4 5
4 4 6.5 7 6 7 6
5 5 3.0 3 3 4 2
6 6 2.0 2 2 NA NA
7 7 2.0 2 NA 2 1
8 8 4.0 5 3 NA 4
9 9 7.0 7 7 6 NA
10 10 2.0 1 NA 3 4
df2%变异（case=1:n（））%>%#添加案例编号
聚集（键=编码器，值=分数，-大小写）%>%#转换为长格式
过滤器（！is.na（分数））%>%#删除na分数
安排（案例、编码员）%>%#按案例和编码员排序
分组（个案）%>%#分组（个案）
总结（bestavg=平均值（总分（2）））%>%前两名的平均值
右键连接（df%>%mutate（case=1:n（））#与原始数据合并
df2
#一个tibble:10x6
案例bestavg CoderA CoderB CoderC CoderD
1.5 2 1 NA 1
2.0 1 3北美
3 3 4.5 NA 4 5
4 4 6.5 7 6 7 6
5 5 3.0 3 3 4 2
6 2.0 2不适用
7 2.0 2 NA 2 1
8 4.0 5 3 NA 4
9 9 7.0 7 6 NA
10102.0 1 NA 3 4
如果您的编码者名称按您想要的优先顺序排序（如您所描述的），这将起作用。数据框中列的顺序无关紧要。对于第一个问题，
您可以使用apply
获得每行前2个非NA值的平均值：
df$BestAvg = apply(df,1,function(x) mean(x[!is.na(x)][1:2]))
如果编码器的排名实际上是CoderD>CoderB>CoderC>CoderA
：
r = c("CoderD", "CoderB", "CoderC", "CoderA")
df$BestAvg2 = apply(df,1,function(x) mean(x[r][!is.na(x[r])][1:2]))
这将返回：
CoderA CoderB CoderC CoderD BestAvg BestAvg2
1 2 1 NA 1 1.5 1.0
2 1 3 3 NA 2.0 3.0
3 NA NA 4 5 4.5 4.5
4 7 6 7 6 6.5 6.0
5 3 3 4 2 3.0 2.5
6 2 2 NA NA 2.0 2.0
7 2 NA 2 1 2.0 1.5
8 5 3 NA 4 4.0 3.5
9 7 7 6 NA 7.0 6.5
10 1 NA 3 4 2.0 3.5
第一个问题,，
您可以使用apply
获得每行前2个非NA值的平均值：
df$BestAvg = apply(df,1,function(x) mean(x[!is.na(x)][1:2]))
如果编码器的排名实际上是CoderD>CoderB>CoderC>CoderA
：
r = c("CoderD", "CoderB", "CoderC", "CoderA")
df$BestAvg2 = apply(df,1,function(x) mean(x[r][!is.na(x[r])][1:2]))
这将返回：
CoderA CoderB CoderC CoderD BestAvg BestAvg2
1 2 1 NA 1 1.5 1.0
2 1 3 3 NA 2.0 3.0
3 NA NA 4 5 4.5 4.5
4 7 6 7 6 6.5 6.0
5 3 3 4 2 3.0 2.5
6 2 2 NA NA 2.0 2.0
7 2 NA 2 1 2.0 1.5
8 5 3 NA 4 4.0 3.5
9 7 7 6 NA 7.0 6.5
10 1 NA 3 4 2.0 3.5
对于第一个问题，您可以执行应用（df，1，函数（x）平均值（x[！is.na（x）][1:2]）
。我不确定我是否理解第二个问题，你能不能事先重新安排专栏？你的建议是问题1的一个很好的解决方案；谢谢问题2适用于更具动态性的情况。在我的完整脚本中，编码器的外部排名是根据其他数据进行调整的，并且可以从脚本的一部分更改为另一部分。我不想每次排名发生变化时都对列进行重新排序，这样就可以直接指定列排名。对于第一个问题，您可以执行应用（df，1，函数（x）均值（x[！is.na（x）][1:2]）
。我不确定我是否理解第二个问题，你能不能事先重新安排专栏？你的建议是问题1的一个很好的解决方案；谢谢问题2适用于更具动态性的情况。在我的完整脚本中，编码器的外部排名是根据其他数据进行调整的，并且可以从脚本的一部分更改为另一部分。我不想每次排名发生变化时都对栏目进行重新排序，这样就可以直接指定栏目排名了。谢谢！这很有效。为了确保列无序时编码器名称正确排序，我在arrange语句之前添加了一行，该语句将编码器转换为因子并指定正确的级别顺序：mutate（coder=factor（coder，levels=c（'CoderA'，'CoderB'，'CoderC'，'CoderD'））%>%
谢谢！这很有效。为了确保列无序时编码器名称正确排序，我在arrange语句之前添加了一行，该语句将编码器转换为因子并指定正确的级别顺序：mutate（coder=factor（coder，levels=c（'CoderA'，'CoderB'，'CoderC'，'CoderD'））%>%