https://github.com/cran/mvtBinaryEP
Tip revision: e03023db232593f436717e7be27d1c52d9865644 authored by Kunthel By on 18 February 2009, 00:00:00 UTC
version 1.0
version 1.0
Tip revision: e03023d
ranMvBinEpXch.R
`ranMvBinEpXch` <-
function(u, r, p, nReps, crit=1e-6, maxiter=20, seed)
{
tcor <- tetra1(c(u,u), r, crit=crit, maxiter=maxiter)
if (tcor[[2]])
{
y <- NULL
out <- list(y = y, tcc = tcor[[1]], fail = tcor[[2]])
return(out)
}
pd <- as.logical((tcor[[1]] > (-1/(p-1))))
if (pd)
{
if (missing(seed)) {z <- ranMvnXch(rho=tcor[[1]], n=p, nRep=nReps)}
else {z <- ranMvnXch(rho=tcor[[1]], n=p, nRep=nReps, seed=seed)}
y <- ifelse(z <= qnorm(u),1,0)
}
else
{
y <- NULL
tcor[[2]] <- TRUE
warning("tetra-choric correlation matrix is not positive definite")
}
out <- list(y = y, tcc=tcor[[1]], fail=tcor[[2]])
return(out)
}