删除所有 NA，同时保留尽可能多的数据

Question

我在 R 中有一个 37x21 矩阵，其中包含许多 NA。对于我的分析，我需要去掉所有的 NA。我可以删除所有包含 NA 的行、所有包含 NA 的列或两者的某种组合。

我想以这样的方式删除特定的行和列，即删除所有 NA 但保留尽可能多的数据单元格。

例如删除所有带有 NA 的 ROWS 会产生一个 10x21 矩阵（10*21 = 210 个数据单元格）。删除所有带有 NA 的 COLUMNS 会产生一个 37x12 矩阵（37x12 = 444 个数据单元格）。但是，我不想做这两个极端中的任何一个，而是想删除导致保留最多数据单元格的行和列的组合。我该怎么做？

Answer 1

这是使用我能想到的第一种算法的一种方法。如果矩阵中至少有一个 NA 和最少的非 NA 值，则该方法只是在迭代中删除行或列（因此在删除 [= 时丢失的单元格最少25=]).为此，我制作了一个包含行和列的数据框，其中包含 NA 和非 NA 的计数以及维度和索引。目前，如果有平局，它会通过删除列之前的行和之后的之前的索引来解决。

我不确定这是否会给出全局最大值（例如只需要一个分支）但它应该比仅仅删除 rows/columns 做得更好。在此示例中，删除行得到 210，删除列得到 74，但使用新方法得到 272。如果您需要将其用于更大的矩阵或更多 NA.

，则代码也可能会被优化

set.seed(1)
mat <- matrix(sample(x = c(1:10, NA), size = 37 * 21, replace = TRUE), ncol = 21)
# filter rows
prod(dim(mat[apply(mat, 1, function(x) all(!is.na(x))), ]))
#> [1] 210
# filter cols
prod(dim(mat[, apply(mat, 2, function(x) all(!is.na(x)))]))
#> [1] 74

delete_row_col <- function(m) {
  to_delete <- rbind(
    data.frame(
      dim = "row",
      index = seq_len(nrow(m)),
      nas = rowSums(is.na(m)),
      non_nas = rowSums(!is.na(m)),
      stringsAsFactors = FALSE
    ),
    data.frame(
      dim = "col",
      index = seq_len(ncol(m)),
      nas = colSums(is.na(m)),
      non_nas = colSums(!is.na(m)),
      stringsAsFactors = FALSE
    )
  )
  to_delete <- to_delete[to_delete$nas > 0, ]
  to_delete <- to_delete[to_delete$non_nas == min(to_delete$non_nas), ]

  if (nrow(to_delete) == 0) {
    return(m) 
  }
  else if (to_delete$dim[1] == "row") {
    m <- m[-to_delete$index[1], ]
  } else {
    m <- m[, -to_delete$index[1]]
  }
  return(m)
}

remove_matrix_na <- function(m) {
  while (any(is.na(m))) {
    m <- delete_row_col(m)
  }
  return(m)
}

prod(dim(remove_matrix_na(mat)))
#> [1] 272

^{由 reprex package (v0.3.0)}

于 2019-07-06 创建

Answer 2

这是一种使用混合整数规划 (MIP) 的方法。我使用 ompr 包进行数学建模和开源 "glpk" 求解器。我在代码中添加了模型解释作为注释。 MIP 方法在成功时保证最佳解决方案，如代码中所示 solver_status(model) 所示。

这种方法可以轻松扩展以处理大型矩阵。

library(dplyr)
library(ROI)
library(ROI.plugin.glpk)
library(ompr)
library(ompr.roi)

set.seed(1)
mat <- matrix(sample(x = c(1:10, NA), size = 37 * 21, replace = TRUE), ncol = 21)
# filtering all rows with NA retains 126 cells
prod(dim(mat[apply(mat, 1, function(x) all(!is.na(x))), , drop = F]))
# [1] 126
# filtering all cols with NA retains 37 cells
prod(dim(mat[, apply(mat, 2, function(x) all(!is.na(x))), drop = F]))
# [1] 37

m <- +!is.na(mat) # gets logical matrix; 0 if NA else 1    
nr <- nrow(m)
nc <- ncol(m)

model <- MIPModel() %>% 
  # keep[i,j] is 1 if matrix cell [i,j] is to be kept else 0
  add_variable(keep[i,j], i = 1:nr, j = 1:nc, typ = "binary") %>% 
  # rm_row[i] is 1 if row i is selected for removal else 0
  add_variable(rm_row[i], i = 1:nr, type = "binary") %>% 
  # rm_col[j] is 1 if column j is selected for removal else 0
  add_variable(rm_col[j], j = 1:nc, type = "binary") %>% 
  # maximize good cells kept
  set_objective(sum_expr(keep[i,j], i = 1:nr, j = 1:nc), "max") %>% 
  # cell can be kept only when row is not selected for removal
  add_constraint(sum_expr(keep[i,j], j = 1:nc) <= 1 - rm_row[i], i = 1:nr) %>%
  # cell can be kept only when column is not selected for removal
  add_constraint(sum_expr(keep[i,j], i = 1:nr) <= 1 - rm_col[j], j = 1:nc) %>%
  # only non-NA values can be kept
  add_constraint(m[i,j] + rm_row[i] + rm_col[j] >= 1, i = 1:nr, j = 1:nc) %>% 
  # solve using free glpk solver
  solve_model(with_ROI(solver = "glpk"))

获取解决方案-

solver_status(model)
# [1] "optimal"    <- "optimal" guarnatees optimality

# get rows to remove
rm_rows <- model %>%
  get_solution(rm_row[i]) %>% 
  filter(value > 0) %>% 
  pull(i)

# [1]  1  3  4  6  7  8 10 14 18 19 20 21 22 23 24 28 30 33 34 35 37

# get columns to remove
rm_cols <- model %>%
  get_solution(rm_col[j]) %>% 
  filter(value > 0) %>% 
  pull(j)

# [1]  6 14 15 16 17

result <- mat[-rm_rows, -rm_cols]

# result has retained more cells as compared to
# removing just rows (126) or just columns (37)
prod(dim(result))
# [1] 256

这种方法应该也适用于 lpSolve 包，但我认为它涉及手动构建约束矩阵，这非常麻烦。

删除所有 NA，同时保留尽可能多的数据

Removing all NAs while retaining the most data possible

algorithm

r

mathematical-optimization

missing-data