Question

我在R中有一个37x21的矩阵，其中包含许多NA。为了进行分析，我需要摆脱所有NA。我可以删除所有包含NA的行，所有包含NA的列或两者的某种组合。

我要删除特定的行和列，以便删除所有NA，但要保留尽可能多的数据单元。

例如用NA删除所有ROWS会得到10x21矩阵（10 * 21 = 210个数据单元）。用NA删除所有列将得到一个37x12的矩阵（37x12 = 444个数据单元）。但是，我不想删除这些极端情况中的任何一个，而是要删除行和列的组合，以使保留的数据单元数最多。我该怎么办？

Answer 1

这是使用我想到的第一个算法的一种方法。如果矩阵中至少有一个NA并且矩阵中的非NA值最少，那么该方法就是删除迭代中的行或列（因此，删除行/柱）。为此，我创建了一个行和列的数据帧，其行数分别为NA和非NA以及维数和索引。目前，如果存在平局，它将通过删除列之前的行和索引之前的行来解决。

我不确定这是否会给出全局最大值（例如，在关系上只取一个分支），但它比删除行/列要好。在此示例中，使用新方法时，删除行的信息为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，同时保留尽可能多的数据

2 个答案: