3

我在这里遇到以下问题：我有一个如下所示的数据框：

  aa<-c(0,0,0,1,1,0,0)
  bb<-c(1,1,0,0,1,0,1)
  cc<-c(0,1,0,0,0,1,0)

  d<-data.frame(aa,bb,cc)

数据始终是二进制的，并为缺席/在场数据编码。我想要的是新列，其中包含满足某些假设的变量的所有可能组合。对于这个数据框，它就像

d$aabb<-ifelse(d$aa=="1"&d$bb=="1"&d$cc=="0",1,0) #aa=1,bb=1,cc=0
d$aacc<-ifelse(d$aa=="1"&d$cc=="1"&d$bb=="0",1,0) #aa=1,bb=0,cc=1
d$bbcc<-ifelse(d$bb=="1"&d$cc=="1"&d$aa=="0",1,0) #aa=0,bb=1,cc=0
d$daabbcc<-ifelse(d$aa=="1"&d$bb=="1"&d$cc=="1",1,0) #aa=bb==cc=1

但是，我有 30 列，我不想手动填写它们。另一件好事是，如果生成的列名是原始列名的组合(aa+bb->aabb)，等等。

我查看了该expand.grid()功能，但这不是我想要的提前谢谢

4

4 回答 4

4

一些数据：

aa<-c(0,0,0,1,1,0,0)
bb<-c(1,1,0,0,1,0,1)
cc<-c(0,1,0,0,0,1,0)
dd<-rbinom(7,1,.5)
ee<-rbinom(7,1,.5)
ff<-rbinom(7,1,.5)
d<-data.frame(aa,bb,cc,dd,ee,ff)

创建一个变量，它是值的所有可能组合：

combinations <- apply(d,1,function(x) paste(names(d)[as.logical(x)],collapse=""))

将该变量转换为一组命名变量并将结果绑定到d：

d2 <- sapply(unique(combinations), function(x) as.numeric(combinations==x))

当原始 df 中仅存在一个值时，防止列名重复：

colnames(d2) <- paste0(colnames(d2),"1") # could be any naming convention
d2 <- cbind(d, d2)
于 2013-06-27T09:33:35.450 回答
2

不管它对实际问题的适用性如何，这都是一种有趣的编程练习。这是从 6 列中创建所有 63 (=2^6 - 1) 种可能组合的代码，不包括空值。（顺便说一句，我看不出这个问题有什么不清楚的地方；它在第二句话中说“所有可能的组合”，示例代码中创建的变量之一全为零（d$aabbcc.））

# create the source data
d <- data.frame(matrix(rbinom(60, 1, 0.5), ncol=6))
names(d) <- letters[1:6]


# generate matrix of all possible combinations (except the null)
v <- as.matrix(expand.grid(rep(list(c(FALSE, TRUE)), ncol(d))))[-1, ]

# convert the matrix into a list of column indexes
indexes <- lapply(seq_len(nrow(v)), function(x) v[x, ])
names(indexes) <- apply(v, 1, function(x) paste(names(d)[x], collapse="."))

# compute values from the source data
out <- data.frame(lapply(indexes, function(i) as.numeric(apply(d[i], 1, all))))

有一些不必要的计算正在进行，最明显的是后来的组合如何不重用早期组合的值。尽管如此，即使有 1000 行，这也只需要几分之一秒，而 100000 行只需几秒钟。鉴于该问题仅适用于少数列，我认为进一步优化不值得。

于 2013-06-27T14:03:08.783 回答
1

使用sets包的可能解决方案...

给定的设置：

aa <- c(0, 0, 0, 1, 1, 0, 0)
bb <- c(1, 1, 0, 0, 1, 0, 1)
cc <- c(0, 1, 0, 0, 0, 1, 0)

d <- data.frame(aa, bb, cc)

还有准备环境...

require(sets, quietly = T)
require(data.table, quietly = T)

通过创建一组集合，以“集合”顺序创建唯一的名称列表d。

# Created as a list so that duplicates are kept.
namesets <- sapply(seq_len(nrow(d)), function(i) {
    gset(colnames(d), memberships = d[i, ])
})

# Then combine the set memberships into names and assign to the sets.
setnames <- sapply(namesets, function(s) {
    ifelse(set_is_empty(s), "none", paste(as.character(s), collapse = ""))
})
names(namesets) <- setnames

# Creating set of sets from namesets orders the names and removes duplicates.
namesets <- as.set(namesets)

print(namesets)

## {none = {}, aa = {"aa"}, bb = {"bb"}, cc = {"cc"}, aabb = {"aa",
##  "bb"}, bbcc = {"bb", "cc"}}

# Making it easy to create an ordered listing that we can use as a key.
setnames <- ordered(setnames, levels = names(namesets))
print(setnames)

## [1] bb   bbcc none aa   aabb cc   bb  
## Levels: none < aa < bb < cc < aabb < bbcc

转换d为 data.table 后，我们可以以各种方式填充成员集列......

# First a simple membership to key-by
dt <- data.table(membership = setnames, d, key = "membership")
print(dt)

##    membership aa bb cc
## 1:       none  0  0  0
## 2:         aa  1  0  0
## 3:         bb  0  1  0
## 4:         bb  0  1  0
## 5:         cc  0  0  1
## 6:       aabb  1  1  0
## 7:       bbcc  0  1  1


# That might be enough for some, but the OP wants columns
# indicating a membership; so just join a matrix...
membership.map <- t(sapply(dt$membership, function(m) {
    m == levels(dt$membership)
}) * 1)
colnames(membership.map) <- levels(dt$membership)

dt <- cbind(dt, split = " ==> ", membership.map)

print(dt)

##    membership aa bb cc split none aa bb cc aabb bbcc
## 1:       none  0  0  0  ==>     1  0  0  0    0    0
## 2:         aa  1  0  0  ==>     0  1  0  0    0    0
## 3:         bb  0  1  0  ==>     0  0  1  0    0    0
## 4:         bb  0  1  0  ==>     0  0  1  0    0    0
## 5:         cc  0  0  1  ==>     0  0  0  1    0    0
## 6:       aabb  1  1  0  ==>     0  0  0  0    1    0
## 7:       bbcc  0  1  1  ==>     0  0  0  0    0    1

这一切都可以包含在一个快速而肮脏的函数中，如下所示：

membership.table <- function(df) {

    namesets <- sapply(seq_len(nrow(d)), function(i) {
        gset(colnames(d), memberships = d[i, ])
    })

    setnames <- sapply(namesets, function(s) {
        ifelse(set_is_empty(s), "none", paste(as.character(s), collapse = ""))
    })
    names(namesets) <- setnames

    namesets <- as.set(namesets)
    setnames <- ordered(setnames, levels = names(namesets))

    dt <- data.table(membership = setnames, d, key = "membership")
    membership.map <- t(sapply(dt$membership, function(m) {
        m == levels(dt$membership)
    }) * 1)
    colnames(membership.map) <- levels(dt$membership)

    cbind(dt, split = " ==> ", membership.map)
}



mt <- membership.table(d)
identical(dt, mt)

## [1] TRUE

我们现在应该在按关键字汇总成员表和从原始数据创建广义集时的成员信息时得到匹配结果。

mt[, lapply(.SD, sum), by = membership, .SDcols = seq(3 + ncol(d), ncol(mt))]

##    membership none aa bb cc aabb bbcc
## 1:       none    1  0  0  0    0    0
## 2:         aa    0  1  0  0    0    0
## 3:         bb    0  0  2  0    0    0
## 4:         cc    0  0  0  1    0    0
## 5:       aabb    0  1  1  0    1    0
## 6:       bbcc    0  0  1  1    0    1


as.list(as.gset(d))

## $`3`
## (aa = 0, bb = 0, cc = 0)
## 
## $`6`
## (aa = 0, bb = 0, cc = 1)
## 
## $`1`
## (aa = 0, bb = 1, cc = 0)
## 
## $`2`
## (aa = 0, bb = 1, cc = 1)
## 
## $`4`
## (aa = 1, bb = 0, cc = 0)
## 
## $`5`
## (aa = 1, bb = 1, cc = 0)
## 
## attr(,"memberships")
## 
## 1 2 3 4 5 6 
## 1 1 2 1 1 1

请注意，在成员表中bb有一个总和2，并且广义集合列表中的第三项（表示bb）也显示了 2 个这样的集合。

如果将相同的算法应用于 Hong 的示例，则结果为：

##     membership a b c d e f split a bc ce abd acd ade abef acdef abcdef
##  1:          a 1 0 0 0 0 0  ==>  1  0  0   0   0   0    0     0      0
##  2:         bc 0 1 1 0 0 0  ==>  0  1  0   0   0   0    0     0      0
##  3:         ce 0 0 1 0 1 0  ==>  0  0  1   0   0   0    0     0      0
##  4:        abd 1 1 0 1 0 0  ==>  0  0  0   1   0   0    0     0      0
##  5:        acd 1 0 1 1 0 0  ==>  0  0  0   0   1   0    0     0      0
##  6:        ade 1 0 0 1 1 0  ==>  0  0  0   0   0   1    0     0      0
##  7:       abef 1 1 0 0 1 1  ==>  0  0  0   0   0   0    1     0      0
##  8:      acdef 1 0 1 1 1 1  ==>  0  0  0   0   0   0    0     1      0
##  9:     abcdef 1 1 1 1 1 1  ==>  0  0  0   0   0   0    0     0      1
## 10:     abcdef 1 1 1 1 1 1  ==>  0  0  0   0   0   0    0     0      1

虽然这个解决方案做得更多（如排序和排序），但与 Hong 的解决方案相比，时间并不算太糟糕；但比起托马斯...

## Unit: milliseconds
##        expr     min      lq  median      uq     max neval
##          hf 241.810 246.411 253.634 262.544 290.345    10
##          mt 128.105 137.931 142.966 154.244 210.276    10
##          tf   1.754   1.768   1.806   2.312   3.487    10
##  plain.gset   1.220   1.330   1.386   1.475   1.644    10

...两种解决方案都很慢。毫无疑问，如果您只需要使用套装，那么对于更大的会员资格来说，在套装小插曲中花一点时间可能是值得的。

于 2013-06-27T23:31:52.690 回答
0

由于所有数据都是二进制的，也就是逻辑的，为什么不将每个可能的组合转换为一个数字（从零到 2^N），然后，类似于@Thomas 的答案，将数据帧中的每一行转换为一个二进制序列，然后你的新列将只是row_value[j] == column_numeric_value[k]（便宜的伪代码）。也就是说，对于一个简单的 3 列输入，有 8 个可能的输出。如果row[j]是1 0 1则为 row_value[j]十进制“5”，row_value[j] == column_numeric_value[5]为真，对所有其他列为假。

于 2013-06-27T12:04:07.870 回答