如何有效地交换数据框中的元素?

时间:2017-07-06 21:19:24

标签: r dataframe

假设我们有以下数据框:

set.seed(1)
(tmp <- data.frame(x = 1:10, R1 = sample(LETTERS[1:5], 10, replace =
TRUE), R2 = sample(LETTERS[1:5], 10, replace = TRUE)))

    x R1 R2
1   1  B  B
2   2  B  A
3   3  C  D
4   4  E  B
5   5  B  D
6   6  E  C
7   7  E  D
8   8  D  E
9   9  D  B
10 10  A  D

我想做以下事项:如果级别索引之间存在差异 因子R1的因子和因子R2的因子是一个奇数,其数量是 需要在它们之间切换两个因素,这可以执行 通过以下代码:

for(ii in 1:dim(tmp)[1]) {
   kk <- which(levels(tmp$R2) %in% tmp[ii,'R2'], arr.ind = TRUE) -
which(levels(tmp$R1) %in% tmp[ii,'R1'], arr.ind = TRUE)
   if(kk%%2!=0) { # swap the their levels between the two factors
      qq <- tmp[ii,]$R1
      tmp[ii,]$R1 <- tmp[ii,]$R2
      tmp[ii,]$R2 <- qq
  }
}

更简洁有效的方法来实现这一目标?

P.S。以下略有不同的情况。

set.seed(1)
(tmp <- data.frame(x = 1:10, R1 = sample(LETTERS[1:5], 10, replace = 
 TRUE), R2 = sample(LETTERS[2:6], 10, replace = TRUE)))

   x R1 R2
   1  C  B
   2  B  B
   3  C  E
   4  E  C
   5  E  B
   6  D  E
   7  E  E
   8  D  F
   9  C  D
  10  A  E

请注意,两个因素R1和R2之间的因子水平下滑一个级别;也就是说,因子R1没有等级F,而因子R2没有等级A.我想根据两个因素的综合等级交换因子等级,如下所示:

tl <- unique(c(levels(tmp$R1), levels(tmp$R2)))
for(ii in 1:dim(tmp)[1]) {
   kk <- which(tl %in% tmp[ii,'R2'], arr.ind = TRUE) - which(tl %in% 
      tmp[ii,'R1'], arr.ind = TRUE)
   if(kk%%2!=0) { # swap the their levels between the two factors
      qq <- tmp[ii,]$R1
      tmp[ii,]$R1 <- tmp[ii,]$R2
      tmp[ii,]$R2 <- qq
  }
}

如何处理这个案子?谢谢!

3 个答案:

答案 0 :(得分:2)

#Find out the indices where difference is odd
inds = abs(as.numeric(tmp$R1) - as.numeric(tmp$R2)) %% 2 != 0

#create new columns where values for the appropriate inds are from relevant columns
tmp$R1_new = replace(tmp$R1, inds, tmp$R2[inds])
tmp$R2_new = replace(tmp$R2, inds, tmp$R1[inds])

tmp
#    x R1 R2 R1_new R2_new
#1   1  B  B      B      B
#2   2  B  A      A      B
#3   3  C  D      D      C
#4   4  E  B      B      E
#5   5  B  D      B      D
#6   6  E  C      E      C
#7   7  E  D      D      E
#8   8  D  E      E      D
#9   9  D  B      D      B
#10 10  A  D      D      A

如有必要,请删除旧R1R2

答案 1 :(得分:2)

使用dplyr的解决方案。 dt是最终输出。请注意,我们需要在此使用if_else中的dplyr,而不是来自基础R的公共ifelse

library(dplyr)

dt <- tmp %>%
  mutate(R1_new = if_else((as.numeric(R2) - as.numeric(R1)) %% 2 != 0, R2, R1),
         R2_new = if_else((as.numeric(R2) - as.numeric(R1)) %% 2 != 0, R1, R2)) %>%
  select(x, R1 = R1_new, R2 =  R2_new)

更新

对于更新的案例,请添加一个mutate来重新定义因素级别R1R2。其余的都一样。

tl <- unique(c(levels(tmp$R1), levels(tmp$R2)))

dt <- tmp %>%
  mutate(R1 = factor(R1, levels = tl), R2 = factor(R2, levels = tl)) %>%
  mutate(R1_new = if_else((as.numeric(R2) - as.numeric(R1)) %% 2 != 0, R2, R1),
         R2_new = if_else((as.numeric(R2) - as.numeric(R1)) %% 2 != 0, R1, R2)) %>%
  select(x, R1 = R1_new, R2 =  R2_new)

答案 2 :(得分:1)

以下是使用data.table

的选项
library(data.table)
setDT(tmp)[(as.integer(R1) - as.integer(R2))%%2 != 0, c('R2', 'R1') := .(R1, R2)]
tmp
#    x R1 R2
#1:  1  B  B
#2:  2  A  B
#3:  3  D  C
#4:  4  B  E
#5:  5  B  D
#6:  6  E  C
#7:  7  D  E
#8:  8  E  D
#9:  9  D  B
#10:10  D  A