how to generate pseudo-random positive definite matrix with constraints on the off-diagonal elements?

后端 未结 4 1385
误落风尘
误落风尘 2021-01-13 12:24

The user wants to impose a unique, non-trivial, upper/lower bound on the correlation between every pair of variable in a var/covar matrix.

For example: I want a vari

4条回答
  •  心在旅途
    2021-01-13 12:53

    OK, fantastic Gregg: we're getting somewhere. Combining your idea with that of woodchips, yields this alternative approach. It's mathematically very dirty but it seems to work:

    library(MCMCpack)
    library(MASS)
    p<-10
    lb<-.6
    ub<-.8
    zupa<-function(theta){
        ac<-matrix(theta,p,p)
        fe<-rwish(100*p,ac%*%t(ac))
        det(fe)
    }
    ba<-optim(runif(p^2,-10,-5),zupa,control=list(maxit=10))
    ac<-matrix(ba$par,p,p)
    fe<-rwish(100*p,ac%*%t(ac))
    me<-mvrnorm(p+1,rep(0,p),fe)
    A<-cor(me)
    bofi<-sqrt(diag(var(me)))%*%t(sqrt((diag(var(me)))))
    va<-A[lower.tri(A)]
    l1=100
    while(l1>0){
        r1<-which(va>ub)
        l1<-length(r1)
        va[r1]<-va[r1]*.9
    }
    A[lower.tri(A)]<-va
    A[upper.tri(A)]<-va
    vari<-bofi*A
    mk<-mvrnorm(10*p,rep(0,p),vari)
    pc<-sign(runif(p,-1,1))
    mf<-sweep(mk,2,pc,"*")
    B<-cor(mf)
    summary(abs(B[lower.tri(B)]))
    

    Basically, this is the idea (say upper bound =.8 and lower it bound=.6), it has a good enough acceptance rate, which is not 100%, but it'll do at this stage of the project.

提交回复
热议问题