R 求最大和最小矩阵边际总可变性

有没有一种更优雅的方法可以根据二元矩阵的填充和大小来计算其边缘列总数的最大或最小可变性水平（CV）？考虑到所有行和列合计必须为非零。e、 g

foo(n_col, n_row, fill){ get maximum possible CV }

假设我们有一个名为

m

的矩阵，其中所有列和行的总计都是

>0

，但矩阵的填充量最小

m <- matrix(rep(0,25), nrow = 5)
diag(m) <- 1
#     [,1] [,2] [,3] [,4] [,5]
#[1,]    1    0    0    0    0
#[2,]    0    1    0    0    0
#[3,]    0    0    1    0    0
#[4,]    0    0    0    1    0
#[5,]    0    0    0    0    1

variability1 <- sd(colSums(m))/mean(colSums(m))
variability1
# [1] 0
# the maximum and minimum for this fill is zero 
# considering that  all column and row totals must be > 0

---

m以下提供了该问题的另一种表述，作为对二元矩阵列和向量选择的优化，该二元矩阵最大化了给定
填充的可变性。非正式参数的有效性，这个公式和由此产生的算法来解决它提供。生成的算法与OP的断言一致

按此方式填充矩阵列可保持边缘列总数的最大可变性

首先，将
fill
定义为
n\u行中
1
的个数
n\u col
通过
n\u col
二进制矩阵
m
。根据问题陈述的约束条件，
m
是一个所有行和列总和都大于零的二进制矩阵，
fill
是一个范围
[max（n行，n列），n行*n列]
内的整数

问题是，对于
[max（n行，n列），n行*n列]
范围内的
fill
给定值，找到最大值

 sd(colSums(m))/mean(colSums(m))

总之，
m
，使得
m
是一个二进制矩阵，其
填充
数量为
1
，且所有行和列总和大于零

我们注意到，最好根据
m
的列和向量来指定该优化问题的域，而不是
m
本身。这是因为存在不同的
m
，它们具有相同的列和向量，因此具有相同的目标值。将列和向量表示为
x
，上述优化问题可以重新表述为最大化：

sd(x)/mean(x)

使得
x
的每个元素都是范围
[1，n_行]
中的整数，
sum（x）
是
fill

此外，由于
sum（x）
被限制为等于
fill
，对于给定的
fill
，分母项
均值（x）
在所有
x
上都是常数。因此，要最大化的等效目标函数只是
sd（x）
，或者等效为
x
的方差

为了使
x
的方差最大化，我们需要选择
x
，以便在满足
x
约束的同时，使其值之间的差异最大化。在这里，我们可以根据
fill
归纳地思考这个问题。让我们假设对于给定的
填充
，我们有
x
的解决方案，该解决方案在满足约束的同时最大化
x
的方差。问题是：当我们将
fill
增加到
fill+1
时，最大化其方差的新
x
是什么？因为我们有一个约束，即
sum（x）=fill
，并且
x
中的每个元素都是一个整数，所以增加
fill
意味着我们必须增加
x
中的一个且仅增加一个元素。暂时放松
x
中每个元素的上限约束（即
x[i]
sd(x)/mean(x)

var(x + dx) = var(x) + gradient(var(x)) %*% dx + 1/2 * t(dx) %*% Hessian(var(x)) %*% dx

gradient(var(x))[i] = 2*(x[i]-mean(x))/(n_col-1),      for all i in [1,n_col]
Hessian(var(x))[i,i] = 2/n_col                  ,      for all i in [1,n_col]

var(x_1 + dx_1) > var(x + dx)

var(x_1 + dx_1) = var(x_1) + gradient(var(x_1)) %*% dx_1 + 1/2 * t(dx_1) %*% Hessian(var(x_1)) %*% dx_1
                <= var(x_1) + 2*(max(x_1)-mean(x_1))/(n_col-1) + constant
                <= var(x) + 2*(max(x)-mean(x))/(n_col-1) + constant
                = var(x + dx)

foo <- function(n_col, n_row, fill) {
  ## preallocate the vector of column sums x and initialize to NA
  x <- rep(NA, n_col)
  for (i in seq_len(n_col)) {
    x[i] <- pmin.int(n_row, fill-(n_col-i))
    fill <- fill - x[i]
  }
  ## compute the variability given the vector of column sums x
  sd(x)/mean(x)
}

foo <- function(n_col, n_row, fill) {
  x <- pmin.int(pmax.int(cumsum(c(fill-n_col+1,rep(-n_row+1,n_col-1))),1),n_row)
  ## compute the variability given the vector of column sums x
  sd(x)/mean(x)
}

n_col=5
n_row=5
variability <- sapply(max(n_col,n_row):(n_col*n_row), function(fill) foo(n_col, n_row, fill))
print(variability)
## [1] 0.0000000 0.3726780 0.6388766 0.8385255 0.9938080 0.8660254 0.8131156 0.8122329 0.8426501
##[10] 0.7319251 0.6666667 0.6404344 0.6443795 0.5414886 0.4707512 0.4330127 0.4259177 0.3049184
##[19] 0.1944407 0.0931695 0.0000000