R data.table - 通过对列编码的子集求和来更新

Question

我有以下问题。我有一个在data.table sets 中编码的集合列表，其中id.s 编码集合的ID，id.e 编码它的元素。 对于每个集合 s，都有其值 m(s)。函数 m() 的值在另一个 data.table m 中，其中每一行包含集合 id.s 及其 value 的 id。

sets <- data.table(
    id.s = c(1,2,2,3,3,3,4,4,4,4),
    id.e = c(3,3,4,2,3,4,1,2,3,4))

v <- data.table(id.s = 1:4, value = c(1/10,2/10,3/10,4/10))

我需要计算新函数 v'() 这样

其中|s|表示集合s的基数（元素个数），b\a表示集合减法（a修改集合 b 的方法是移除带有集合 a 的关节元素）

现在，我使用 for 循环逐行更新。然而，对于包含数千个集合和数千个元素的大型 data.tables，它需要太多时间。

你知道如何让它更容易吗？

我当前的代码：

# convert data.table to wide format 
dc <- dcast(sets, id.s ~ id.e, drop = FALSE, value.var = "id.e" , fill = 0)
# take columns corresponding to elements id.e
cols <- names(dc)[-1]
# convert columns cols to 0-1 coding
dc[, (cols) := lapply(.SD, function(x) ifelse(x > 0,1,0)), .SDcols = cols]

# join dc with v
dc <- dc[v, on = "id.s"]

# calculate the cardinality of each set
dc[, cardinality := sum(.SD > 0), .SDcols = cols, by = id.s]

# prepare column for new value
dc[, value2 := 0]

#   id.s 1 2 3 4 value cardinality value2
#1:    1 0 0 1 0   0.1           1      0
#2:    2 0 0 1 1   0.2           2      0
#3:    3 0 1 1 1   0.3           3      0
#4:    4 1 1 1 1   0.4           4      0

# for each set (row of dc)
for(i in 1:nrow(dc)) {
  row <- dc[i,]
  set <- as.numeric(row[,cols, with = F])
  row.cardinality <- as.numeric(row$cardinality)
  # find its supersets
  dc[,is.superset := ifelse(rowSums(mapply("*",dc[,cols,with=FALSE],set))==row.cardinality,1,0)][]
  # use the formula to update the value
  res <- dc[is.superset==1,][, sum := sum((-1)^(cardinality - row.cardinality)*value)]$sum[1]
  dc[i,value2 := res]
}

dc[,.(id.s, value2), with = TRUE]
#   id.s value2
#1:    1   -0.2
#2:    2    0.3
#3:    3   -0.1
#4:    4    0.4

Answer 1

这可能对你有用：

制作一个小函数来获取每个集合的超集

get_superset <- function(el, setvalue) {
  c(setvalue, sets[id.s!=setvalue, setequal(intersect(el, id.e), el), by=id.s][V1==TRUE, id.s])
}

1. 在sets 对象中获取每个集合的基数，但也可以单独保存以备后用（参见步骤 4）

sets[, cardinality:=.N, by=.(id.s)]
cardinality = unique(sets[, .(id.s, cardinality)])

1. 使用上述函数按集合添加超集

sets <- unique(sets[,!c("id.e")][sets[, .("supersets"=get_superset(id.e, .GRP)),by=id.s], on=.(id.s)])

（注意：作为替代方案，步骤 2 可以分为三个子步骤，如下所示）

# 2a. Get the supersets
supersets = sets[, .("supersets"=get_superset(id.e, .GRP)),by=id.s]
# 2b. Merge the supersets on the original sets 
sets = sets[supersets, on=.(id.s)]
# 2c. Retain only necessary columns, and make unique
sets = unique(sets[, .(id.s, cardinality,supersets)])

1. 增值

sets <- sets[v,on=.(supersets=id.s)][order(id.s)]

4. 获取每个超集的基数

sets <- sets[cardinality, on=.(supersets=id.s)]

5. 得到结果（即估计你的 v' 函数）

result = sets[, .(value2 = sum((-1)^(i.cardinality-cardinality)*value)), by=.(id.s)]

输出：

   id.s value2
1:    1   -0.2
2:    2    0.3
3:    3   -0.1
4:    4    0.4