2

我有一个数据框，其中包含由 1 或 0 指示的标签的个人偏好：

mydata <- data.frame(
    ID = c(1:4),
    tag1 = c(1, 0, 1, 0),
    tag2 = c(0, 0, 0, 0),
    tag3 = c(1, 0, 1, 1),
    tag4 = c(1, 1, 0, 1),
    tag5 = c(0, 1, 1, 1)
)

（我的数据有更多的标签，而不仅仅是 5 个）

对于网络图，我正在寻找一种将宽格式数据转换为连续每对 tag=1 之间出现的长格式列表的方法。对于上面的示例，它看起来像这样：

mydata2 <- data.frame(
    ID = c(1,1,1,2,3,3,3,4,4,4),
    target = c("tag1","tag1","tag3","tag4","tag1","tag1","tag3","tag3","tag3","tag4"),
    source = c("tag3","tag4","tag4","tag5","tag3","tag5","tag5","tag4","tag5","tag5")
)

我想为此使用tidyr's gather()，但不知道如何将它用于成对的列。我可以为每一对创建新变量并收集它们，但是对于一长串标签，这将变得不切实际。有没有更优雅的方法来做到这一点？甚至是特定的功能？

4

4 回答 4

2

这是一个基于apply()（在每一行上应用函数）并combn( ... , 2)找到所有对的答案。

ll  <-  apply(mydata,1,
              function(x){
                  if(sum(x[-1])<2)
                      # otherwise you'll get errors if there are less than two
                      # elements selected
                      return(NULL)

                  tmp = combn(names(x[-1])[ !!(x[-1]) ],# see note below
                              2) # pairs

                  # the return value
                  data.frame(ID = x['ID'],
                             target = tmp[1,],
                             source = tmp[2,],
                             # otherwise you get names warning, which is
                             # annoying.j
                             check.names=FALSE)
              })

# bind the individual results together
do.call(rbind,ll)

#>  ID target source
#>   1   tag1   tag3
#>   1   tag1   tag4
#>   1   tag3   tag4
#>   2   tag4   tag5
#>   3   tag1   tag3
#>   3   tag1   tag5
#>   3   tag3   tag5
#>   4   tag3   tag4
#>   4   tag3   tag5
#>   4   tag4   tag5

请注意，这!!x是一种将值强制为逻辑值的标准 JavaScript 技巧，它也适用于 R。

于 2015-03-01T03:04:41.450 回答
1

一个选项使用tidyr/dplyr

library(tidyr)
library(dplyr)

tD <- gather(mydata, Var, Val, -ID) %>% #change wide to long format
                          filter(Val!=0) %>% #remove rows with 0 Val
                          select(-Val) #remove the Val column

tD1 <- left_join(tD, tD, by='ID') %>% #self join with the created data
                      filter(Var.x!=Var.y) %>% #remove rows that are same
                      arrange(ID, Var.x, Var.y) #to order (if needed)

tD1[-1] <- t(apply(tD1[-1], 1, sort)) #sort the rows of 2nd and 3rd columns
res <- unique(tD1, by='ID') %>% #keep only unique rows by "ID"
              rename(target=Var.x, source=Var.y) #rename the column names
row.names(res) <- NULL #change the rownames to NULL
#checking the results with the expected result
mydata2[2:3] <- lapply(mydata2[2:3], as.character)  
all.equal(mydata2, res,check.attributes=FALSE)
#[1] TRUE

res
#   ID target source
#1   1   tag1   tag3
#2   1   tag1   tag4
#3   1   tag3   tag4
#4   2   tag4   tag5
#5   3   tag1   tag3
#6   3   tag1   tag5
#7   3   tag3   tag5
#8   4   tag3   tag4
#9   4   tag3   tag5
#10  4   tag4   tag5
于 2015-03-01T06:29:06.447 回答
0

这是一种使用方法data.table，尽管使用的是未导出的函数vecseq。

require(data.table)
foo <- function(x) {
    lx = length(x)
    idx1 = data.table:::vecseq(rep.int(1L, lx), (lx-1L):0L, NULL)
    idx2 = data.table:::vecseq(c(seq_len(lx)[-1L], 1L), (lx-1L):0L, NULL)
    list(x[idx1], x[idx2])
}

melt(dt, id="ID")[value == 1L, foo(variable), by=ID]
#     ID   V1   V2
#  1:  1 tag1 tag3
#  2:  1 tag3 tag4
#  3:  1 tag1 tag4
#  4:  3 tag1 tag3
#  5:  3 tag3 tag5
#  6:  3 tag1 tag5
#  7:  4 tag3 tag4
#  8:  4 tag4 tag5
#  9:  4 tag3 tag5
# 10:  2 tag4 tag5
于 2015-03-01T08:37:12.007 回答
0

我能想到的最直接的方法是使用melt“reshape2”，然后combn再次使用melt：

library(reshape2)
M <- melt(mydata, id.vars = "ID")               ## Melt the dataset
M2 <- M[M$value > 0, 1:2]                       ## Subset the rows of interest
melt(
  lapply(
    split(M2$variable, M2$ID), function(x) {
      data.frame(t(combn(as.character(x), 2)))  ## Inside, we use combn
    }), id.vars = c("X1", "X2"))                ## We know we'll just have X1 and X2 
#      X1   X2 L1
# 1  tag1 tag3  1
# 2  tag1 tag4  1
# 3  tag3 tag4  1
# 4  tag4 tag5  2
# 5  tag1 tag3  3
# 6  tag1 tag5  3
# 7  tag3 tag5  3
# 8  tag3 tag4  4
# 9  tag3 tag5  4
# 10 tag4 tag5  4

或者，避免melt像这样的第二个：

library(reshape2)
M <- melt(mydata, id.vars = "ID")
M2 <- M[M$value > 0, 1:2]


MS <- split(M2$variable, M2$ID)
do.call(rbind, 
        lapply(names(MS), function(x) {
          data.frame(ID = x, t(combn(as.character(MS[[x]]), 2)))
        }))
于 2015-03-01T07:05:02.843 回答