我想解决具有预定行和列总数的矩阵,其最接近类似于具有相同属性(但可能具有不同行/列总数)的第二预定矩阵。
因此,两个矩阵必须满足以下条件: 所有元素必须在[0,1]范围内。
列号小于行号的任何元素在解决方案中都必须为0.
列号大于行号+ 2的任何元素必须为0.
所以从这样的事情开始:
0.07 0.17 0.47 0.29
0.07 0.1 0.14 0 0.31
0 0.07 0.18 0.07 0.32
0 0 0.15 0.04 0.19
0 0 0 0.18 0.18
我想尽量减少与此的“距离”:
0.10 0.21 0.37 0.32
0.10 0.11 0.12 0 0.33
0 0.10 0.13 0.10 0.33
0 0 0.12 0.09 0.21
0 0 0 0.13 0.13
这样就保留了第一个矩阵的原始行和列总数。我将这里定义的距离定义为每个矩阵中第i个,第j个条目之间的平方差的总和,但如果由于某种原因这是一个问题,我会使用其他一些措施。
到目前为止,我一直在尝试使用Rsolnp包中的solnp这样做:
rowVals<-c(.31,.32,.19,.18)
colVals<-c(.07,.17,.47,.29)
In<-c(.07,.15,.1,.18,.04,.14,.07)
tar<-c(.1,.11,.12,0,0,.1,.13,.1,0,0,.12,.09,0,0,0,.13)
tar<-matrix(tar,byrow=T,nrow=4)
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,4,5,6
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
}
##objective function
fn<-function(inpt, targt, n, ...){
x<-makeMat(inpt, n=n)
y<-targt
z<-sum((x-y)^2)
z
}
##equality constraint function
eq<-function(x,...){c(rowSums(makeMat(x,length(rowVals))),colSums(makeMat(x,length(colVals))))}
##row/column constraints
eqB<-c(rowVals, colVals)
opt1<-solnp(pars = In, fun = fn, eqfun = eq, eqB = eqB, LB = rep(0,7), targt = tar, n=4)
但是,当我尝试解决时,我收到此错误:
solnp-->Redundant constraints were found. Poor
solnp-->intermediate results may result.Suggest that you
solnp-->remove redundant constraints and re-OPTIMIZE
Iter: 1 fn: 0.0116 Pars: 0.07000 0.15000 0.10000 0.18000 0.04000 0.14000 0.07000
solnp--> Solution not reliable....Problem Inverting Hessian.
我也遇到过类似的事情:
Error in solve.default(a %*% t(a), constraint, tol = 2.220446e-16) :
Lapack routine dgesv: system is exactly singular: U[4,4] = 0
我希望我能够清楚地解释这个问题;关于我如何处理这个问题的任何建议都将不胜感激。
感谢。
答案 0 :(得分:0)
谢谢!
看起来像使用类似的东西来实现等式约束功能:
##equality constraint function
eq<-function(x,...){c(rowSums(makeMat(x,length(rowVals)))[-c(4,3)],colSums(makeMat(x,length(colVals)))[-1])}
##row/column constraints
eqB<-c(rowVals[-c(4,3)], colVals[-1])