测试数据:
x <- c(2,2,2,1,1,1,1)
rowVals <- c(6,4,3,4)
colVals <- c(3,4,4,6)
从 (3N-5) 参数构造适当测试矩阵的函数:
makeMat <- function(x,n) {
## first and last element of diag are constrained by row/col sums
diagVals <- c(colVals[1],x[1:(n-2)],rowVals[n])
## set up off-diagonals 2,3
sup2Vals <- x[(n-1):(2*n-3)]
sup3Vals <- x[(2*n-2):(3*n-5)]
## set up matrix
m <- diag(diagVals)
m[row(m)==col(m)-1] <- sup2Vals
m[row(m)==col(m)-2] <- sup3Vals
m
}
目标函数(行和列偏差的平方和):
objFun <- function(x,n) {
m <- makeMat(x,n)
## compute SSQ deviation from row/col constraints
sum((rowVals-rowSums(m))^2+(colVals-colSums(m))^2)
}
优化:
opt1 <- optim(fn=objFun,par=x,n=4)
## recovers original values, although it takes a lot of steps
opt2 <- optim(fn=objFun,par=rep(0,length(x)),n=4)
makeMat(opt2$par,n=4)
## [,1] [,2] [,3] [,4]
## [1,] 3 2.658991 0.3410682 0.0000000
## [2,] 0 1.341934 1.1546649 1.5038747
## [3,] 0 0.000000 2.5042858 0.4963472
## [4,] 0 0.000000 0.0000000 4.0000000
##
## conjugate gradients might be better
opt3 <- optim(fn=objFun,par=rep(0,length(x)),n=4,
method="CG")
这个问题似乎有多种解决方案,这并不奇怪(因为 (N-2)+(N-1)+(N-2)= 3N-5 个参数有 2N 个约束)。
您没有说是否需要整数解决方案-如果需要,您将需要更专业的工具...