2016-07-05 18 views
0

,我有以下的数据帧:寻找每排3列最高值,并把他们的名字在新的数据帧中的R

temp1=data.frame(id=c(1,2,3,4,5),p1=c(0,0,1,1,2),p2=c(9,2,3,5,3),p3=c(1,4,10,3,7),p4=c(4,4,7,1,10)) 

    id p1 p2 p3 p4 
    1 0 9 1 4 
    2 0 2 3 4 
    3 1 3 10 7 
    4 1 5 3 1 
    5 2 3 7 10 

每个ID我想提取与最高值前三名列并把它们在新的数据帧是这样的:

id top1 top2 top3 
1 p2 p4 p3 
2 p4 p3 p2 
3 p3 p4 p2 
4 p2 p3 p4/p1 
5 p4 p3 p2 

的情况下有我们被允许将它们按任意顺序两个相同的值。

+0

@akrun我会感激你的帮助 – sanaz

+0

是否有只有一个对应一个ID或相同的ID行可以在多行? –

+0

只有一行对应一个ID – sanaz

回答

1
library("tidyr") 
library("dplyr") 
df <- data.frame(id=c(1,2,3,4,5),p1=c(0,0,1,1,2),p2=c(9,2,3,5,3),p3=c(1,4,10,3,7),p4=c(4,4,7,1,10)) 
df2 <- gather(df,col,val,-id) 
res <- group_by(df2,id) %>% arrange(id,desc(val)) %>% summarise(top1 = first(col),top2 = nth(col,2),top3 = nth(col,3)) 

结果

#  id top1 top2 top3 
# <dbl> <chr> <chr> <chr> 
# 1  1 p2 p4 p3 
# 2  2 p3 p4 p2 
# 3  3 p3 p4 p2 
# 4  4 p2 p3 p1 
# 5  5 p4 p3 p2 

以下新信息

res <- group_by(df2,id) %>% mutate(r=rank(-(val/sum(val)*100),ties.method = "min")) %>% arrange(id,r) %>% summarise(top1 = first(col),top2 = nth(col,2),top3 = nth(col,3)) 

结果

#  id top1 top2 top3 
#  <dbl> <chr> <chr> <chr> 
# 1  1 p2 p4 p3 
# 2  2 p3 p4 p2 
# 3  3 p3 p4 p2 
# 4  4 p2 p3 p1 
# 5  5 p4 p3 p2 
+0

好极了,我想我需要详细了解tidyr – sanaz

+1

这很方便,替换'tidyR'就是'reshape2' – theArun

+0

我们可以修改代码来填充列top1:top3按比例?例如对于id1,top1列将是4/14 * 100 – sanaz

1

我们也可以用rank使用applybase R

m1 <- t(apply(temp1[-1], 1, FUN = function(x) { 
       i1 <- rank(-x, ties.method = "min") 
       i2 <- i1[i1 %in% 1:3] 
       tapply(names(i2), i2, FUN=paste, collapse="/")})) 
d1 <- setNames(cbind(temp1[1], m1), c("id", paste0("top", 1:ncol(m1)))) 
d1 
# id top1 top2 top3 
#1 1 p2 p4 p3 
#2 2 p4 p3 p2 
#3 3 p3 p4 p2 
#4 4 p2 p3 p1/p4 
#5 5 p4 p3 p2 

如果我们需要得到的比例来代替列名的

d2 <- d1 
lst <- apply(temp1[-1], 1, FUN = function(x) { 
      i1 <- rank(-x, ties.method = "min") 
      i2 <- i1[i1 %in% 1:3] 
      tapply(names(i2), i2, FUN= list)}) 

lst1 <- setNames(lapply(lst, function(x) unlist(x)), seq_len(nrow(temp1))) 

d2[-1] <- t(sapply(
      relist(unlist(lapply(seq_along(lst1), function(i) { 
      x <- temp1[i, lst1[[i]]] 
    x/sum(x) 
      })), 
    skeleton = lst), 
    function(x) sapply(x, function(y) toString(round(y,2))))) 
d2 
# id top1 top2  top3 
# 1 1 0.64 0.29  0.07 
# 2 2 0.44 0.33  0.22 
# 3 3 0.5 0.35  0.15 
# 4 4 0.5 0.3 0.1, 0.1 
# 5 5 0.5 0.35  0.15 
+0

我们是否可以修改代码以按比例填充列top1:top3?例如对于id1,top1列将是4/14 * 100 – sanaz

+0

@sanaz它是基于比率。在这种情况下,代码中的rank( - ((x/sum(x))* 100),ties.method =“min”)'变化。为什么'9/14'不是顶栏? – akrun

+0

@sanaz为什么9/14不是顶栏? – akrun

相关问题