Question

我有以下数据框：

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

如果有两个相同的值，我们可以按任意顺序放置它们。

Answer 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

Answer 2

我们还可以将apply与rank

中的base 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

找到每行中具有最高值的3列，并将其名称放在R中的新数据框中

2 个答案: