如何在R中从数值计数矩阵中随机删除指定比例总计数且不产生负值？

核心思路是先计算需要扣除的总数值，再随机把总扣减量分配到矩阵的非零元素上，保证每个元素的扣减量不超过其本身的值，最终扣减总和正好为总计数的10%。

基础实现方案（逻辑简单，无边界问题） #

直接采用逐次扣减1的逻辑，每次从所有非零元素中随机选一个扣1，直到扣满总目标量，天然不会出现负值：

random_reduce_10pct <- function(mat) {
  total_sum <- sum(mat)
  # 计算需要扣除的总数值，四舍五入取整适配计数数据
  reduce_total <- round(total_sum * 0.1)
  if (reduce_total == 0) return(mat)
  
  res_mat <- mat
  remain <- reduce_total
  while (remain > 0) {
    # 筛选所有可扣减（值>0）的位置
    valid_pos <- which(res_mat > 0)
    # 随机选一个位置扣1
    pick <- sample(valid_pos, 1)
    res_mat[pick] <- res_mat[pick] - 1
    remain <- remain - 1
  }
  return(res_mat)
}

测试示例 #

用你给出的示例矩阵测试：

# 输入示例矩阵
mat <- matrix(c(30, 10, 0, 20), nrow = 2, byrow = TRUE)
print(mat)
#      [,1] [,2]
# [1,]   30   10
# [2,]    0   20

# 固定随机种子方便复现结果
set.seed(123)
result <- random_reduce_10pct(mat)
print(result)
# 输出示例（随机结果，总扣减量为6）：
#      [,1] [,2]
# [1,]   29    6
# [2,]    0   19

# 验证扣减总量
sum(mat) - sum(result)
# 输出为6，符合10%的要求

大矩阵优化方案 #

如果矩阵规模极大、总扣减量很高，逐次循环效率偏低，可以用多项式分布一次性生成扣减量分配方案，再加少量修正逻辑避免负值：

fast_random_reduce_10pct <- function(mat) {
  total_sum <- sum(mat)
  reduce_total <- round(total_sum * 0.1)
  if (reduce_total == 0) return(mat)
  
  vec <- as.vector(mat)
  # 按元素值大小分配抽样权重，值越大被分配到扣减量的概率越高
  weights <- vec / sum(vec)
  # 一次性生成所有扣减量的分配
  reduce_vec <- as.vector(rmultinom(1, size = reduce_total, prob = weights))
  
  # 修正极端情况下扣减量超过原值的问题
  over_idx <- which(reduce_vec > vec)
  while (length(over_idx) > 0) {
    for (i in over_idx) {
      extra <- reduce_vec[i] - vec[i]
      reduce_vec[i] <- vec[i]
      # 把多出来的扣减量转移到其他可扣减的位置
      valid_pos <- which(vec > reduce_vec)
      add_pos <- sample(valid_pos, extra, replace = TRUE)
      reduce_vec[add_pos] <- reduce_vec[add_pos] + 1
    }
    over_idx <- which(reduce_vec > vec)
  }
  
  # 还原为原矩阵结构
  res_mat <- matrix(vec - reduce_vec, nrow = nrow(mat), ncol = ncol(mat))
  return(res_mat)
}

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