在R中快速检索集合列表的严格子集：包与树结构实现咨询

一、使用现成R包实现 #

1. sets包：直观的集合操作 #

sets包提供原生集合对象与子集判断函数，适合中小规模集合列表：

# 安装并加载包
install.packages("sets")
library(sets)

# 示例集合列表与二进制矩阵
set_list <- list(set("a", "b"), set("a", "b", "c"))
binary_matrix <- matrix(c(1,1,0,1,1,1), nrow = 2, byrow = TRUE)
colnames(binary_matrix) <- c("a", "b", "c")

# 定义目标函数
subset <- function(target_binary) {
  # 将二进制向量转换为集合对象
  target_set <- set(names(target_binary)[target_binary == 1])
  # 筛选严格子集：是子集且与目标集合不相等
  strict_subset_idx <- which(is_subset(set_list, target_set) & !setequal(set_list, target_set))
  
  if (length(strict_subset_idx) == 0) return(NULL)
  binary_matrix[strict_subset_idx,, drop = FALSE]
}

# 测试
subset(c(1,1,1))  # 返回对应{a,b}的二进制矩阵
subset(c(1,1,0))  # 返回NULL

2. data.table+位运算：大规模数据优化 #

如果集合数量较多，用位运算将二进制行转为整数，结合data.table快速筛选可大幅提升速度：

library(data.table)

# 预处理：将二进制行转为整数
binary_matrix <- matrix(c(1,1,0,1,1,1), nrow = 2, byrow = TRUE)
dt <- data.table(
  set_int = apply(binary_matrix, 1, function(row) sum(row * 2^(rev(seq_along(row)) - 1))),
  binary_row = lapply(1:nrow(binary_matrix), function(i) binary_matrix[i,])
)

# 快速检索函数
subset_fast <- function(target_binary) {
  target_int <- sum(target_binary * 2^(rev(seq_along(target_binary)) - 1))
  # 位运算判断严格子集：(目标整数 & 集合整数) == 集合整数 且 两者不相等
  res <- dt[(target_int & set_int) == set_int & target_int != set_int, binary_row]
  
  if (length(res) == 0) return(NULL)
  do.call(rbind, res)
}

# 测试
subset_fast(c(1,1,1))
subset_fast(c(1,1,0))

二、手动实现前缀树（Trie） #

如果需要自定义数据结构，前缀树是高效检索子集的理想选择，以下是R中的实现：

核心思路 #

前缀树的每个节点对应集合元素的存在状态（0或1），根节点为空，叶子节点存储对应集合的行索引。构建树时将每个二进制行按元素顺序插入；检索时遍历目标二进制，允许选择与目标一致的1分支，或在目标为1时选择0分支（此时已满足严格子集），最终收集所有符合条件的叶子节点。

代码实现 #

# 创建树节点
create_node <- function() {
  list(children = list(), is_leaf = FALSE, row_idx = integer(0))
}

# 构建前缀树
build_trie <- function(binary_matrix) {
  root <- create_node()
  for (i in 1:nrow(binary_matrix)) {
    current_node <- root
    for (val in binary_matrix[i,]) {
      val_char <- as.character(val)
      if (is.null(current_node$children[[val_char]])) {
        current_node$children[[val_char]] <- create_node()
      }
      current_node <- current_node$children[[val_char]]
    }
    current_node$is_leaf <- TRUE
    current_node$row_idx <- c(current_node$row_idx, i)
  }
  root
}

# 检索严格子集
retrieve_strict_subsets <- function(root, target_row, binary_matrix) {
  traverse <- function(node, pos, is_strict) {
    if (pos > length(target_row)) {
      return(if (node$is_leaf && is_strict) node$row_idx else integer(0))
    }
    target_val <- target_row[pos]
    idx <- integer(0)
    
    if (target_val == 1) {
      # 目标为1时，可走0分支（此时已满足严格子集）
      if (!is.null(node$children[["0"]])) {
        idx <- c(idx, traverse(node$children[["0"]], pos + 1, TRUE))
      }
      # 走1分支，继续判断后续元素
      if (!is.null(node$children[["1"]])) {
        idx <- c(idx, traverse(node$children[["1"]], pos + 1, is_strict))
      }
    } else {
      # 目标为0时，只能走0分支
      if (!is.null(node$children[["0"]])) {
        idx <- c(idx, traverse(node$children[["0"]], pos + 1, is_strict))
      }
    }
    idx
  }
  
  subset_idx <- traverse(root, 1, FALSE)
  if (length(subset_idx) == 0) return(NULL)
  binary_matrix[subset_idx,, drop = FALSE]
}

# 测试
binary_matrix <- matrix(c(1,1,0,1,1,1), nrow = 2, byrow = TRUE)
trie_root <- build_trie(binary_matrix)
retrieve_strict_subsets(trie_root, c(1,1,1), binary_matrix)
retrieve_strict_subsets(trie_root, c(1,1,0), binary_matrix)

内容的提问来源于stack exchange，提问作者monotonic