基于预测矩阵的数据帧的自动子集化

Question

我为大型数据集创建了一个预测矩阵，如下所示：

library(mice)
dfpredm <- quickpred(df, mincor=.3)

    A   B   C   D   E   F   G   H   I   J
A   0   1   1   1   0   1   0   1   1   0
B   1   0   0   0   1   0   1   0   0   1
C   0   0   0   1   1   0   0   0   0   0
D   1   0   1   0   0   1   0   1   0   1
E   0   1   0   1   0   1   1   0   1   0
**F 0   0   1   0   0   0   1   0   0   0**
G   0   1   0   1   0   0   0   0   0   0
H   1   0   1   0   0   1   0   0   0   1
I   0   1   0   1   1   0   1   0   0   0
J   1   0   1   0   0   1   0   1   0   0

我想在dfpredm的基础上创建原始df的一个子集。

更具体地说，我想做以下事情：

假设我的因变量是F。 根据预测矩阵 F 与 C 和 G 相关。 此外，C 和 G 分别由 D,E 和 B,D 预测最好。

现在的想法是根据因变量 F 创建 df 的子集，其中 F 行中的值为 1。

Fpredictors <- df[,(dfpredm["F",]) == 1]

但也对F 中的行为 1 的变量执行相同操作。我正在考虑首先获取这样的列名：

Fpredcol <-colnames(dfpredm[,(dfpredm["c241",]) == 1])

然后用这些列名做一个for loop？

对于具体示例，我想以子集结尾。

dfsub <- df[,c("F","C","G","B","E","D")]

然而，我想自动化这个过程。谁能告诉我如何做到这一点？

Answer 1

这是一种似乎适合您的策略：

first_preds <- function(dat, predictor) {
  cols <- which(dat[predictor, ] == 1)
  names(dat)[cols]
}

# wrap first_preds() for getting best and second best predictors
first_and_second_preds <- function(dat, predictor) {
  matches <- first_preds(dat, predictor)
  matches <- c(matches, unlist(lapply(matches, function(x) first_preds(dat, x))))
  c(predictor, matches) %>% unique()
}

dat[first_and_second_preds(dat, "F")] # order is not exactly the same as your output

  F C G D E B
A 1 1 0 1 0 1
B 0 0 1 0 1 0
C 0 0 0 1 1 0
D 1 1 0 0 0 0
E 1 0 1 1 0 1
F 0 1 1 0 0 0
G 0 0 0 1 0 1
H 1 1 0 0 0 0
I 0 0 1 1 1 1
J 1 1 0 0 0 0

不确定结果中的顺序是否重要，但如果重要，您可以添加逻辑。

从这里使用dat（在 SO 上共享小型 R 数据的一种更友好的方式）：

dat <- read.table(
  text = "A   B   C   D   E   F   G   H   I   J
  A   0   1   1   1   0   1   0   1   1   0
  B   1   0   0   0   1   0   1   0   0   1
  C   0   0   0   1   1   0   0   0   0   0
  D   1   0   1   0   0   1   0   1   0   1
  E   0   1   0   1   0   1   1   0   1   0
  F   0   0   1   0   0   0   1   0   0   0
  G   0   1   0   1   0   0   0   0   0   0
  H   1   0   1   0   0   1   0   0   0   1
  I   0   1   0   1   1   0   1   0   0   0
  J   1   0   1   0   0   1   0   1   0   0",
  header = TRUE
)

一些更通用的东西可以让你直接使用self_select 预测器：

all_preds <- function(dat, predictors) {
  unlist(lapply(predictors, function(x) names(dat)[which(dat[x, ] == 1 )]))
}

dat[all_preds(dat, c("A", "B"))]

  B C D F H I A E G J
A 1 1 1 1 1 1 0 0 0 0
B 0 0 0 0 0 0 1 1 1 1
C 0 0 1 0 0 0 0 1 0 0
D 0 1 0 1 1 0 1 0 0 1
E 1 0 1 1 0 1 0 0 1 0
F 0 1 0 0 0 0 0 0 1 0
G 1 0 1 0 0 0 0 0 0 0
H 0 1 0 1 0 0 1 0 0 1
I 1 0 1 0 0 0 0 1 1 0