Last updated on 2020-02-19 10:48:55 CET.
| Flavor | Version | Tinstall | Tcheck | Ttotal | Status | Flags |
|---|---|---|---|---|---|---|
| r-devel-linux-x86_64-debian-clang | 0.8.1 | 8.25 | 36.69 | 44.94 | ERROR | |
| r-devel-linux-x86_64-debian-gcc | 0.8.1 | 5.94 | 28.58 | 34.52 | ERROR | |
| r-devel-linux-x86_64-fedora-clang | 0.8.1 | 54.06 | ERROR | |||
| r-devel-linux-x86_64-fedora-gcc | 0.8.1 | 50.90 | ERROR | |||
| r-devel-windows-ix86+x86_64 | 0.8.1 | 14.00 | 64.00 | 78.00 | OK | |
| r-devel-windows-ix86+x86_64-gcc8 | 0.8.1 | 22.00 | 102.00 | 124.00 | OK | |
| r-patched-linux-x86_64 | 0.8.1 | 4.48 | 33.82 | 38.30 | OK | |
| r-patched-solaris-x86 | 0.8.1 | 74.10 | OK | |||
| r-release-linux-x86_64 | 0.8.1 | 4.98 | 34.18 | 39.16 | OK | |
| r-release-windows-ix86+x86_64 | 0.8.1 | 12.00 | 63.00 | 75.00 | OK | |
| r-release-osx-x86_64 | 0.8.1 | OK | ||||
| r-oldrel-windows-ix86+x86_64 | 0.8.1 | 11.00 | 59.00 | 70.00 | OK | |
| r-oldrel-osx-x86_64 | 0.8.1 | OK |
Version: 0.8.1
Check: examples
Result: ERROR
Running examples in 'HLSM-Ex.R' failed
The error most likely occurred in:
> base::assign(".ptime", proc.time(), pos = "CheckExEnv")
> ### Name: HLSMrandomEF
> ### Title: Function to run the MCMC sampler in random effects model (and
> ### HLSMfixedEF for fixed effects model)
> ### Aliases: HLSMrandomEF HLSMfixedEF print.HLSM print.summary.HLSM
> ### summary.HLSM getIntercept getAlpha getLS getLikelihood getBeta
>
> ### ** Examples
>
>
> library(HLSM)
> #Set values for the inputs of the function
> priors = NULL
> tune = NULL
> initialVals = NULL
> niter = 10
>
> #Random effect HLSM on Pitt and Spillane data
> random.fit <- HLSMrandomEF(Y = ps.advice.mat,FullX = ps.edge.vars.mat,
+ initialVals = initialVals,priors = priors,
+ tune = tune,tuneIn = FALSE,dd = 2,niter = niter,
+ intervention = 0)
----------- FAILURE REPORT --------------
--- failure: the condition has length > 1 ---
--- srcref ---
:
--- package (from environment) ---
HLSM
--- call from context ---
HLSMrandomEF(Y = ps.advice.mat, FullX = ps.edge.vars.mat, initialVals = initialVals,
priors = priors, tune = tune, tuneIn = FALSE, dd = 2, niter = niter,
intervention = 0)
--- call from argument ---
if (class(Y) == "list" & class(Y[[1]]) != "matrix" & class(Y[[1]]) !=
"data.frame") {
stop("Invalid data structure type")
}
--- R stacktrace ---
where 1: HLSMrandomEF(Y = ps.advice.mat, FullX = ps.edge.vars.mat, initialVals = initialVals,
priors = priors, tune = tune, tuneIn = FALSE, dd = 2, niter = niter,
intervention = 0)
--- value of length: 2 type: logical ---
[1] FALSE TRUE
--- function from context ---
function (Y, edgeCov = NULL, receiverCov = NULL, senderCov = NULL,
FullX = NULL, initialVals = NULL, priors = NULL, tune = NULL,
tuneIn = TRUE, TT = NULL, dd, niter, intervention)
{
if (class(Y) != "list") {
if (dim(Y)[2] != 4) {
stop("Invalid data structure type")
}
}
if (class(Y) == "list" & class(Y[[1]]) != "matrix" & class(Y[[1]]) !=
"data.frame") {
stop("Invalid data structure type")
}
if (class(Y) == "list") {
KK = length(Y)
if (dim(Y[[1]])[1] == dim(Y[[1]])[2]) {
nn = sapply(1:length(Y), function(x) nrow(Y[[x]]))
}
if (dim(Y[[1]])[1] != dim(Y[[1]])[2] & dim(Y[[1]])[2] ==
4) {
nn = sapply(1:length(Y), function(x) length(unique(c(Y[[x]]$Receiver,
Y[[x]]$Sender))))
nodenames = lapply(1:length(Y), function(x) unique(c(Y[[x]]$Receiver,
Y[[x]]$Sender)))
}
}
if (class(Y) != "list") {
if (dim(Y)[2] == 4) {
nid = unique(Y$id)
KK = length(nid)
nn = rep(0, KK)
df.list = list()
nodenames = list()
for (k in 1:KK) {
df.sm = Y[which(Y$id == nid[k], ), ]
nn[k] = length(unique(c(df.sm$Receiver, df.sm$Sender)))
nodenames[[k]] = unique(c(df.sm$Receiver, df.sm$Sender))
df.list[[k]] = array(0, dim = c(nn[k], nn[k]))
dimnames(df.list[[k]])[[1]] = dimnames(df.list[[k]])[[2]] = nodenames[[k]]
for (i in 1:dim(df.sm)[1]) {
df.list[[k]][paste(df.sm$Sender[i]), paste(df.sm$Receiver[i])] = df.sm$Outcome[i]
}
}
Y = df.list
}
}
noCOV = FALSE
if (!is.null(FullX) & !is.null(edgeCov) & !is.null(receiverCov) &
!is.null(senderCov))
(stop("FullX cannot be used when nodal or edge covariates are provided"))
if (is.null(FullX) & is.null(edgeCov) & is.null(receiverCov) &
is.null(senderCov)) {
X = lapply(1:KK, function(x) array(0, dim = c(nn[x],
nn[x], 1)))
noCOV = TRUE
}
if (is.null(FullX)) {
if (!is.null(edgeCov) | !is.null(senderCov) | !is.null(receiverCov)) {
if (!is.null(edgeCov)) {
if (class(edgeCov) != "data.frame") {
stop("edgeCov must be of class data.frame")
}
X1 = getEdgeCov(edgeCov, nn, nodenames)
}
else (X1 = NULL)
if (!is.null(senderCov)) {
if (class(senderCov) != "data.frame") {
stop("senderCov must be of class data.frame")
}
X2 = getSenderCov(senderCov, nn, nodenames)
}
else (X2 = NULL)
if (!is.null(receiverCov)) {
if (class(receiverCov) != "data.frame") {
stop("receiverCov must be of class data.frame")
}
X3 = getReceiverCov(receiverCov, nn, nodenames)
}
else (X3 = NULL)
X = lapply(1:KK, function(x) {
if (!is.null(X1) & !is.null(X2) & !is.null(X3)) {
ncov = dim(X1[[x]])[3] + dim(X2[[x]])[3] +
dim(X3[[x]])[3]
df = array(0, dim = c(nn[x], nn[x], ncov))
df[, , 1:dim(X1[[x]])[3]] = X1[[x]]
df[, , (dim(X1[[x]])[3] + 1):(dim(X1[[x]])[3] +
dim(X2[[x]])[3])] = X2[[x]]
df[, , (dim(X1[[x]])[3] + dim(X2[[x]])[3] +
1):(dim(X1[[x]])[3] + dim(X2[[x]])[3] + dim(X3[[x]])[3])] = X3[[x]]
}
if (!is.null(X1) & !is.null(X2) & is.null(X3)) {
ncov = dim(X1[[x]])[3] + dim(X2[[x]])[3]
df = array(0, dim = c(nn[x], nn[x], ncov))
df[, , 1:dim(X1[[x]])[3]] = X1[[x]]
df[, , (dim(X1[[x]])[3] + 1):(dim(X1[[x]])[3] +
dim(X2[[x]])[3])] = X2[[x]]
}
if (!is.null(X1) & !is.null(X3) & is.null(X2)) {
ncov = dim(X1[[x]])[3] + dim(X3[[x]])[3]
df = array(0, dim = c(nn[x], nn[x], ncov))
df[, , 1:dim(X1[[x]])[3]] = X1[[x]]
df[, , (dim(X1[[x]])[3] + 1):(dim(X1[[x]])[3] +
dim(X3[[x]])[3])] = X3[[x]]
}
if (!is.null(X2) & !is.null(X3) & is.null(X1)) {
ncov = dim(X2[[x]])[3] + dim(X3[[x]])[3]
df = array(0, dim = c(nn[x], nn[x], ncov))
df[, , 1:dim(X2[[x]])[3]] = X2[[x]]
df[, , (dim(X2[[x]])[3] + 1):(dim(X2[[x]])[3] +
dim(X3[[x]])[3])] = X3[[x]]
}
if (!is.null(X1) & is.null(X2) & is.null(X3)) {
df = X1[[x]]
}
if (is.null(X1) & !is.null(X2) & is.null(X3)) {
df = X2[[x]]
}
if (is.null(X1) & is.null(X2) & !is.null(X3)) {
df = X3[[x]]
}
return(df)
})
}
}
if (!is.null(FullX))
X = FullX
PP = dim(X[[1]])[3]
XX = unlist(X)
YY = unlist(Y)
YY[which(is.na(YY))] = 0
XX[which(is.na(XX))] = 0
if (is.null(priors)) {
MuBeta = rep(0, (PP + 1))
VarBeta = rep(1, (PP + 1))
MuAlpha = 0
VarAlpha = 1
MuZ = c(0, 0)
VarZ = c(20, 20)
PriorA = 100
PriorB = 150
}
else {
if (class(priors) != "list")
(stop("priors must be of class list, if not NULL"))
MuBeta = priors$MuBeta
VarBeta = priors$VarBeta
MuAlpha = priors$MuAlpha
VarAlpha = priors$VarAlpha
MuZ = priors$MuZ
VarZ = priors$VarZ
PriorA = priors$PriorA
PriorB = priors$PriorB
}
C = lapply(1:KK, function(tt) {
diag(nn[tt]) - (1/nn[tt]) * array(1, dim = c(nn[tt],
nn[tt]))
})
Z0 = lapply(1:KK, function(tt) {
g = graph.adjacency(Y[[tt]])
ss = shortest.paths(g)
ss[ss > 4] = 4
Z0 = cmdscale(ss, k = dd)
dimnames(Z0)[[1]] = dimnames(YY[[tt]])[[1]]
return(Z0)
})
Z00 = lapply(1:KK, function(tt) C[[tt]] %*% Z0[[tt]])
if (is.null(initialVals)) {
Z0 = unlist(Z00)
beta0 = replicate(KK, rnorm(PP, 0, 1))
intercept0 = rnorm(KK, 0, 1)
if (intervention == 1) {
alpha0 = rnorm(1, 0, 1)
}
print("Starting Values Set")
}
else {
if (class(initialVals) != "list")
(stop("initialVals must be of class list, if not NULL"))
Z0 = initialVals$ZZ
beta0 = initialVals$beta
intercept0 = initialVals$intercept
if (intervention == 1) {
alpha0 = initialVals$alpha
}
}
if (intervention == 0) {
alpha0 = 0
TT = rep(0, KK)
}
if (is.null(tune)) {
a.number = 5
tuneAlpha = 0.9
tuneBeta = array(1, dim = c(PP, KK))
tuneInt = rep(0.2, KK)
tuneZ = lapply(1:KK, function(x) rep(1.2, nn[x]))
}
else {
if (class(tune) != "list")
(stop("tune must be of class list, if not NULL"))
a.number = 1
tuneAlpha = tune$tuneAlpha
tuneBeta = tune$tuneBeta
tuneInt = tune$tuneInt
tuneZ = tune$tuneZ
}
do.again = 1
tuneX = 1
if (tuneIn == TRUE) {
while (do.again == 1) {
print("Tuning the Sampler")
for (counter in 1:a.number) {
rslt = MCMCfunction(nn = nn, PP = PP, KK = KK,
dd = dd, XX = XX, YY = YY, ZZ = Z0, TT = TT,
beta = beta0, intercept = intercept0, alpha = alpha0,
MuAlpha = MuAlpha, SigmaAlpha = VarAlpha, MuBeta = MuBeta,
SigmaBeta = VarBeta, MuZ = MuZ, VarZ = VarZ,
tuneBetaAll = tuneBeta, tuneInt = tuneInt,
tuneAlpha = tuneAlpha, tuneZAll = unlist(tuneZ),
niter = 200, PriorA = PriorA, PriorB = PriorB,
intervention = intervention)
tuneAlpha = adjust.my.tune(tuneAlpha, rslt$acc$alpha,
1)
tuneZ = lapply(1:KK, function(x) adjust.my.tune(tuneZ[[x]],
rslt$acc$Z[[x]], 2))
tuneBeta = array(sapply(1:KK, function(x) adjust.my.tune(tuneBeta[,
x], rslt$acc$beta[, x], 1)), dim = c(PP, KK))
tuneInt = sapply(1:KK, function(x) adjust.my.tune(tuneInt[x],
rslt$acc$intercept[x], 1))
print(paste("TuneDone = ", tuneX))
tuneX = tuneX + 1
}
extreme = lapply(1:KK, function(x) which.suck(rslt$acc$Z[[x]],
2))
do.again = max(sapply(extreme, length)) > 5
}
print("Tuning is finished")
}
rslt = MCMCfunction(nn = nn, PP = PP, KK = KK, dd = dd, XX = XX,
YY = YY, ZZ = Z0, TT = TT, beta = beta0, intercept = intercept0,
alpha = alpha0, MuAlpha = MuAlpha, SigmaAlpha = VarAlpha,
MuBeta = MuBeta, SigmaBeta = VarBeta, MuZ = MuZ, VarZ = VarZ,
tuneBetaAll = tuneBeta, tuneInt = tuneInt, tuneAlpha = tuneAlpha,
tuneZAll = unlist(tuneZ), niter = niter, PriorA = PriorA,
PriorB = PriorB, intervention = intervention)
Ztransformed = lapply(1:niter, function(ii) {
lapply(1:KK, function(tt) {
z = rslt$draws$ZZ[[ii]][[tt]]
z = C[[tt]] %*% z
pr = t(Z00[[tt]]) %*% z
ssZ = svd(pr)
tx = ssZ$v %*% t(ssZ$u)
zfinal = z %*% tx
return(zfinal)
})
})
rslt$draws$ZZ = Ztransformed
rslt$call = match.call()
if (noCOV == TRUE & intervention == 0) {
rslt$tune = list(tuneZ = tuneZ, tuneInt = tuneInt)
rslt$draws$Beta = NA
rslt$draws$Alpha = NA
}
if (noCOV == TRUE & intervention == 1) {
rslt$tune = list(tuneAlpha = tuneAlpha, tuneZ = tuneZ,
tuneInt = tuneInt)
rslt$draws$Beta = NA
}
if (noCOV == FALSE & intervention == 0) {
rslt$tune = list(tuneBeta = tuneBeta, tuneZ = tuneZ,
tuneInt = tuneInt)
rslt$draws$Alpha = NA
}
if (noCOV == FALSE & intervention == 1) {
rslt$tune = list(tuneBeta = tuneBeta, tuneAlpha = tuneAlpha,
tuneZ = tuneZ, tuneInt = tuneInt)
}
class(rslt) = "HLSM"
rslt
}
<bytecode: 0xf619e8>
<environment: namespace:HLSM>
--- function search by body ---
Function HLSMrandomEF in namespace HLSM has this body.
----------- END OF FAILURE REPORT --------------
Error in if (class(Y) == "list" & class(Y[[1]]) != "matrix" & class(Y[[1]]) != :
the condition has length > 1
Calls: HLSMrandomEF
Execution halted
Flavor: r-devel-linux-x86_64-debian-clang
Version: 0.8.1
Check: examples
Result: ERROR
Running examples in ‘HLSM-Ex.R’ failed
The error most likely occurred in:
> base::assign(".ptime", proc.time(), pos = "CheckExEnv")
> ### Name: HLSMrandomEF
> ### Title: Function to run the MCMC sampler in random effects model (and
> ### HLSMfixedEF for fixed effects model)
> ### Aliases: HLSMrandomEF HLSMfixedEF print.HLSM print.summary.HLSM
> ### summary.HLSM getIntercept getAlpha getLS getLikelihood getBeta
>
> ### ** Examples
>
>
> library(HLSM)
> #Set values for the inputs of the function
> priors = NULL
> tune = NULL
> initialVals = NULL
> niter = 10
>
> #Random effect HLSM on Pitt and Spillane data
> random.fit <- HLSMrandomEF(Y = ps.advice.mat,FullX = ps.edge.vars.mat,
+ initialVals = initialVals,priors = priors,
+ tune = tune,tuneIn = FALSE,dd = 2,niter = niter,
+ intervention = 0)
----------- FAILURE REPORT --------------
--- failure: the condition has length > 1 ---
--- srcref ---
:
--- package (from environment) ---
HLSM
--- call from context ---
HLSMrandomEF(Y = ps.advice.mat, FullX = ps.edge.vars.mat, initialVals = initialVals,
priors = priors, tune = tune, tuneIn = FALSE, dd = 2, niter = niter,
intervention = 0)
--- call from argument ---
if (class(Y) == "list" & class(Y[[1]]) != "matrix" & class(Y[[1]]) !=
"data.frame") {
stop("Invalid data structure type")
}
--- R stacktrace ---
where 1: HLSMrandomEF(Y = ps.advice.mat, FullX = ps.edge.vars.mat, initialVals = initialVals,
priors = priors, tune = tune, tuneIn = FALSE, dd = 2, niter = niter,
intervention = 0)
--- value of length: 2 type: logical ---
[1] FALSE TRUE
--- function from context ---
function (Y, edgeCov = NULL, receiverCov = NULL, senderCov = NULL,
FullX = NULL, initialVals = NULL, priors = NULL, tune = NULL,
tuneIn = TRUE, TT = NULL, dd, niter, intervention)
{
if (class(Y) != "list") {
if (dim(Y)[2] != 4) {
stop("Invalid data structure type")
}
}
if (class(Y) == "list" & class(Y[[1]]) != "matrix" & class(Y[[1]]) !=
"data.frame") {
stop("Invalid data structure type")
}
if (class(Y) == "list") {
KK = length(Y)
if (dim(Y[[1]])[1] == dim(Y[[1]])[2]) {
nn = sapply(1:length(Y), function(x) nrow(Y[[x]]))
}
if (dim(Y[[1]])[1] != dim(Y[[1]])[2] & dim(Y[[1]])[2] ==
4) {
nn = sapply(1:length(Y), function(x) length(unique(c(Y[[x]]$Receiver,
Y[[x]]$Sender))))
nodenames = lapply(1:length(Y), function(x) unique(c(Y[[x]]$Receiver,
Y[[x]]$Sender)))
}
}
if (class(Y) != "list") {
if (dim(Y)[2] == 4) {
nid = unique(Y$id)
KK = length(nid)
nn = rep(0, KK)
df.list = list()
nodenames = list()
for (k in 1:KK) {
df.sm = Y[which(Y$id == nid[k], ), ]
nn[k] = length(unique(c(df.sm$Receiver, df.sm$Sender)))
nodenames[[k]] = unique(c(df.sm$Receiver, df.sm$Sender))
df.list[[k]] = array(0, dim = c(nn[k], nn[k]))
dimnames(df.list[[k]])[[1]] = dimnames(df.list[[k]])[[2]] = nodenames[[k]]
for (i in 1:dim(df.sm)[1]) {
df.list[[k]][paste(df.sm$Sender[i]), paste(df.sm$Receiver[i])] = df.sm$Outcome[i]
}
}
Y = df.list
}
}
noCOV = FALSE
if (!is.null(FullX) & !is.null(edgeCov) & !is.null(receiverCov) &
!is.null(senderCov))
(stop("FullX cannot be used when nodal or edge covariates are provided"))
if (is.null(FullX) & is.null(edgeCov) & is.null(receiverCov) &
is.null(senderCov)) {
X = lapply(1:KK, function(x) array(0, dim = c(nn[x],
nn[x], 1)))
noCOV = TRUE
}
if (is.null(FullX)) {
if (!is.null(edgeCov) | !is.null(senderCov) | !is.null(receiverCov)) {
if (!is.null(edgeCov)) {
if (class(edgeCov) != "data.frame") {
stop("edgeCov must be of class data.frame")
}
X1 = getEdgeCov(edgeCov, nn, nodenames)
}
else (X1 = NULL)
if (!is.null(senderCov)) {
if (class(senderCov) != "data.frame") {
stop("senderCov must be of class data.frame")
}
X2 = getSenderCov(senderCov, nn, nodenames)
}
else (X2 = NULL)
if (!is.null(receiverCov)) {
if (class(receiverCov) != "data.frame") {
stop("receiverCov must be of class data.frame")
}
X3 = getReceiverCov(receiverCov, nn, nodenames)
}
else (X3 = NULL)
X = lapply(1:KK, function(x) {
if (!is.null(X1) & !is.null(X2) & !is.null(X3)) {
ncov = dim(X1[[x]])[3] + dim(X2[[x]])[3] +
dim(X3[[x]])[3]
df = array(0, dim = c(nn[x], nn[x], ncov))
df[, , 1:dim(X1[[x]])[3]] = X1[[x]]
df[, , (dim(X1[[x]])[3] + 1):(dim(X1[[x]])[3] +
dim(X2[[x]])[3])] = X2[[x]]
df[, , (dim(X1[[x]])[3] + dim(X2[[x]])[3] +
1):(dim(X1[[x]])[3] + dim(X2[[x]])[3] + dim(X3[[x]])[3])] = X3[[x]]
}
if (!is.null(X1) & !is.null(X2) & is.null(X3)) {
ncov = dim(X1[[x]])[3] + dim(X2[[x]])[3]
df = array(0, dim = c(nn[x], nn[x], ncov))
df[, , 1:dim(X1[[x]])[3]] = X1[[x]]
df[, , (dim(X1[[x]])[3] + 1):(dim(X1[[x]])[3] +
dim(X2[[x]])[3])] = X2[[x]]
}
if (!is.null(X1) & !is.null(X3) & is.null(X2)) {
ncov = dim(X1[[x]])[3] + dim(X3[[x]])[3]
df = array(0, dim = c(nn[x], nn[x], ncov))
df[, , 1:dim(X1[[x]])[3]] = X1[[x]]
df[, , (dim(X1[[x]])[3] + 1):(dim(X1[[x]])[3] +
dim(X3[[x]])[3])] = X3[[x]]
}
if (!is.null(X2) & !is.null(X3) & is.null(X1)) {
ncov = dim(X2[[x]])[3] + dim(X3[[x]])[3]
df = array(0, dim = c(nn[x], nn[x], ncov))
df[, , 1:dim(X2[[x]])[3]] = X2[[x]]
df[, , (dim(X2[[x]])[3] + 1):(dim(X2[[x]])[3] +
dim(X3[[x]])[3])] = X3[[x]]
}
if (!is.null(X1) & is.null(X2) & is.null(X3)) {
df = X1[[x]]
}
if (is.null(X1) & !is.null(X2) & is.null(X3)) {
df = X2[[x]]
}
if (is.null(X1) & is.null(X2) & !is.null(X3)) {
df = X3[[x]]
}
return(df)
})
}
}
if (!is.null(FullX))
X = FullX
PP = dim(X[[1]])[3]
XX = unlist(X)
YY = unlist(Y)
YY[which(is.na(YY))] = 0
XX[which(is.na(XX))] = 0
if (is.null(priors)) {
MuBeta = rep(0, (PP + 1))
VarBeta = rep(1, (PP + 1))
MuAlpha = 0
VarAlpha = 1
MuZ = c(0, 0)
VarZ = c(20, 20)
PriorA = 100
PriorB = 150
}
else {
if (class(priors) != "list")
(stop("priors must be of class list, if not NULL"))
MuBeta = priors$MuBeta
VarBeta = priors$VarBeta
MuAlpha = priors$MuAlpha
VarAlpha = priors$VarAlpha
MuZ = priors$MuZ
VarZ = priors$VarZ
PriorA = priors$PriorA
PriorB = priors$PriorB
}
C = lapply(1:KK, function(tt) {
diag(nn[tt]) - (1/nn[tt]) * array(1, dim = c(nn[tt],
nn[tt]))
})
Z0 = lapply(1:KK, function(tt) {
g = graph.adjacency(Y[[tt]])
ss = shortest.paths(g)
ss[ss > 4] = 4
Z0 = cmdscale(ss, k = dd)
dimnames(Z0)[[1]] = dimnames(YY[[tt]])[[1]]
return(Z0)
})
Z00 = lapply(1:KK, function(tt) C[[tt]] %*% Z0[[tt]])
if (is.null(initialVals)) {
Z0 = unlist(Z00)
beta0 = replicate(KK, rnorm(PP, 0, 1))
intercept0 = rnorm(KK, 0, 1)
if (intervention == 1) {
alpha0 = rnorm(1, 0, 1)
}
print("Starting Values Set")
}
else {
if (class(initialVals) != "list")
(stop("initialVals must be of class list, if not NULL"))
Z0 = initialVals$ZZ
beta0 = initialVals$beta
intercept0 = initialVals$intercept
if (intervention == 1) {
alpha0 = initialVals$alpha
}
}
if (intervention == 0) {
alpha0 = 0
TT = rep(0, KK)
}
if (is.null(tune)) {
a.number = 5
tuneAlpha = 0.9
tuneBeta = array(1, dim = c(PP, KK))
tuneInt = rep(0.2, KK)
tuneZ = lapply(1:KK, function(x) rep(1.2, nn[x]))
}
else {
if (class(tune) != "list")
(stop("tune must be of class list, if not NULL"))
a.number = 1
tuneAlpha = tune$tuneAlpha
tuneBeta = tune$tuneBeta
tuneInt = tune$tuneInt
tuneZ = tune$tuneZ
}
do.again = 1
tuneX = 1
if (tuneIn == TRUE) {
while (do.again == 1) {
print("Tuning the Sampler")
for (counter in 1:a.number) {
rslt = MCMCfunction(nn = nn, PP = PP, KK = KK,
dd = dd, XX = XX, YY = YY, ZZ = Z0, TT = TT,
beta = beta0, intercept = intercept0, alpha = alpha0,
MuAlpha = MuAlpha, SigmaAlpha = VarAlpha, MuBeta = MuBeta,
SigmaBeta = VarBeta, MuZ = MuZ, VarZ = VarZ,
tuneBetaAll = tuneBeta, tuneInt = tuneInt,
tuneAlpha = tuneAlpha, tuneZAll = unlist(tuneZ),
niter = 200, PriorA = PriorA, PriorB = PriorB,
intervention = intervention)
tuneAlpha = adjust.my.tune(tuneAlpha, rslt$acc$alpha,
1)
tuneZ = lapply(1:KK, function(x) adjust.my.tune(tuneZ[[x]],
rslt$acc$Z[[x]], 2))
tuneBeta = array(sapply(1:KK, function(x) adjust.my.tune(tuneBeta[,
x], rslt$acc$beta[, x], 1)), dim = c(PP, KK))
tuneInt = sapply(1:KK, function(x) adjust.my.tune(tuneInt[x],
rslt$acc$intercept[x], 1))
print(paste("TuneDone = ", tuneX))
tuneX = tuneX + 1
}
extreme = lapply(1:KK, function(x) which.suck(rslt$acc$Z[[x]],
2))
do.again = max(sapply(extreme, length)) > 5
}
print("Tuning is finished")
}
rslt = MCMCfunction(nn = nn, PP = PP, KK = KK, dd = dd, XX = XX,
YY = YY, ZZ = Z0, TT = TT, beta = beta0, intercept = intercept0,
alpha = alpha0, MuAlpha = MuAlpha, SigmaAlpha = VarAlpha,
MuBeta = MuBeta, SigmaBeta = VarBeta, MuZ = MuZ, VarZ = VarZ,
tuneBetaAll = tuneBeta, tuneInt = tuneInt, tuneAlpha = tuneAlpha,
tuneZAll = unlist(tuneZ), niter = niter, PriorA = PriorA,
PriorB = PriorB, intervention = intervention)
Ztransformed = lapply(1:niter, function(ii) {
lapply(1:KK, function(tt) {
z = rslt$draws$ZZ[[ii]][[tt]]
z = C[[tt]] %*% z
pr = t(Z00[[tt]]) %*% z
ssZ = svd(pr)
tx = ssZ$v %*% t(ssZ$u)
zfinal = z %*% tx
return(zfinal)
})
})
rslt$draws$ZZ = Ztransformed
rslt$call = match.call()
if (noCOV == TRUE & intervention == 0) {
rslt$tune = list(tuneZ = tuneZ, tuneInt = tuneInt)
rslt$draws$Beta = NA
rslt$draws$Alpha = NA
}
if (noCOV == TRUE & intervention == 1) {
rslt$tune = list(tuneAlpha = tuneAlpha, tuneZ = tuneZ,
tuneInt = tuneInt)
rslt$draws$Beta = NA
}
if (noCOV == FALSE & intervention == 0) {
rslt$tune = list(tuneBeta = tuneBeta, tuneZ = tuneZ,
tuneInt = tuneInt)
rslt$draws$Alpha = NA
}
if (noCOV == FALSE & intervention == 1) {
rslt$tune = list(tuneBeta = tuneBeta, tuneAlpha = tuneAlpha,
tuneZ = tuneZ, tuneInt = tuneInt)
}
class(rslt) = "HLSM"
rslt
}
<bytecode: 0x5561fe211988>
<environment: namespace:HLSM>
--- function search by body ---
Function HLSMrandomEF in namespace HLSM has this body.
----------- END OF FAILURE REPORT --------------
Error in if (class(Y) == "list" & class(Y[[1]]) != "matrix" & class(Y[[1]]) != :
the condition has length > 1
Calls: HLSMrandomEF
Execution halted
Flavor: r-devel-linux-x86_64-debian-gcc
Version: 0.8.1
Check: examples
Result: ERROR
Running examples in ‘HLSM-Ex.R’ failed
The error most likely occurred in:
> ### Name: HLSMrandomEF
> ### Title: Function to run the MCMC sampler in random effects model (and
> ### HLSMfixedEF for fixed effects model)
> ### Aliases: HLSMrandomEF HLSMfixedEF print.HLSM print.summary.HLSM
> ### summary.HLSM getIntercept getAlpha getLS getLikelihood getBeta
>
> ### ** Examples
>
>
> library(HLSM)
> #Set values for the inputs of the function
> priors = NULL
> tune = NULL
> initialVals = NULL
> niter = 10
>
> #Random effect HLSM on Pitt and Spillane data
> random.fit <- HLSMrandomEF(Y = ps.advice.mat,FullX = ps.edge.vars.mat,
+ initialVals = initialVals,priors = priors,
+ tune = tune,tuneIn = FALSE,dd = 2,niter = niter,
+ intervention = 0)
----------- FAILURE REPORT --------------
--- failure: the condition has length > 1 ---
--- srcref ---
:
--- package (from environment) ---
HLSM
--- call from context ---
HLSMrandomEF(Y = ps.advice.mat, FullX = ps.edge.vars.mat, initialVals = initialVals,
priors = priors, tune = tune, tuneIn = FALSE, dd = 2, niter = niter,
intervention = 0)
--- call from argument ---
if (class(Y) == "list" & class(Y[[1]]) != "matrix" & class(Y[[1]]) !=
"data.frame") {
stop("Invalid data structure type")
}
--- R stacktrace ---
where 1: HLSMrandomEF(Y = ps.advice.mat, FullX = ps.edge.vars.mat, initialVals = initialVals,
priors = priors, tune = tune, tuneIn = FALSE, dd = 2, niter = niter,
intervention = 0)
--- value of length: 2 type: logical ---
[1] FALSE TRUE
--- function from context ---
function (Y, edgeCov = NULL, receiverCov = NULL, senderCov = NULL,
FullX = NULL, initialVals = NULL, priors = NULL, tune = NULL,
tuneIn = TRUE, TT = NULL, dd, niter, intervention)
{
if (class(Y) != "list") {
if (dim(Y)[2] != 4) {
stop("Invalid data structure type")
}
}
if (class(Y) == "list" & class(Y[[1]]) != "matrix" & class(Y[[1]]) !=
"data.frame") {
stop("Invalid data structure type")
}
if (class(Y) == "list") {
KK = length(Y)
if (dim(Y[[1]])[1] == dim(Y[[1]])[2]) {
nn = sapply(1:length(Y), function(x) nrow(Y[[x]]))
}
if (dim(Y[[1]])[1] != dim(Y[[1]])[2] & dim(Y[[1]])[2] ==
4) {
nn = sapply(1:length(Y), function(x) length(unique(c(Y[[x]]$Receiver,
Y[[x]]$Sender))))
nodenames = lapply(1:length(Y), function(x) unique(c(Y[[x]]$Receiver,
Y[[x]]$Sender)))
}
}
if (class(Y) != "list") {
if (dim(Y)[2] == 4) {
nid = unique(Y$id)
KK = length(nid)
nn = rep(0, KK)
df.list = list()
nodenames = list()
for (k in 1:KK) {
df.sm = Y[which(Y$id == nid[k], ), ]
nn[k] = length(unique(c(df.sm$Receiver, df.sm$Sender)))
nodenames[[k]] = unique(c(df.sm$Receiver, df.sm$Sender))
df.list[[k]] = array(0, dim = c(nn[k], nn[k]))
dimnames(df.list[[k]])[[1]] = dimnames(df.list[[k]])[[2]] = nodenames[[k]]
for (i in 1:dim(df.sm)[1]) {
df.list[[k]][paste(df.sm$Sender[i]), paste(df.sm$Receiver[i])] = df.sm$Outcome[i]
}
}
Y = df.list
}
}
noCOV = FALSE
if (!is.null(FullX) & !is.null(edgeCov) & !is.null(receiverCov) &
!is.null(senderCov))
(stop("FullX cannot be used when nodal or edge covariates are provided"))
if (is.null(FullX) & is.null(edgeCov) & is.null(receiverCov) &
is.null(senderCov)) {
X = lapply(1:KK, function(x) array(0, dim = c(nn[x],
nn[x], 1)))
noCOV = TRUE
}
if (is.null(FullX)) {
if (!is.null(edgeCov) | !is.null(senderCov) | !is.null(receiverCov)) {
if (!is.null(edgeCov)) {
if (class(edgeCov) != "data.frame") {
stop("edgeCov must be of class data.frame")
}
X1 = getEdgeCov(edgeCov, nn, nodenames)
}
else (X1 = NULL)
if (!is.null(senderCov)) {
if (class(senderCov) != "data.frame") {
stop("senderCov must be of class data.frame")
}
X2 = getSenderCov(senderCov, nn, nodenames)
}
else (X2 = NULL)
if (!is.null(receiverCov)) {
if (class(receiverCov) != "data.frame") {
stop("receiverCov must be of class data.frame")
}
X3 = getReceiverCov(receiverCov, nn, nodenames)
}
else (X3 = NULL)
X = lapply(1:KK, function(x) {
if (!is.null(X1) & !is.null(X2) & !is.null(X3)) {
ncov = dim(X1[[x]])[3] + dim(X2[[x]])[3] +
dim(X3[[x]])[3]
df = array(0, dim = c(nn[x], nn[x], ncov))
df[, , 1:dim(X1[[x]])[3]] = X1[[x]]
df[, , (dim(X1[[x]])[3] + 1):(dim(X1[[x]])[3] +
dim(X2[[x]])[3])] = X2[[x]]
df[, , (dim(X1[[x]])[3] + dim(X2[[x]])[3] +
1):(dim(X1[[x]])[3] + dim(X2[[x]])[3] + dim(X3[[x]])[3])] = X3[[x]]
}
if (!is.null(X1) & !is.null(X2) & is.null(X3)) {
ncov = dim(X1[[x]])[3] + dim(X2[[x]])[3]
df = array(0, dim = c(nn[x], nn[x], ncov))
df[, , 1:dim(X1[[x]])[3]] = X1[[x]]
df[, , (dim(X1[[x]])[3] + 1):(dim(X1[[x]])[3] +
dim(X2[[x]])[3])] = X2[[x]]
}
if (!is.null(X1) & !is.null(X3) & is.null(X2)) {
ncov = dim(X1[[x]])[3] + dim(X3[[x]])[3]
df = array(0, dim = c(nn[x], nn[x], ncov))
df[, , 1:dim(X1[[x]])[3]] = X1[[x]]
df[, , (dim(X1[[x]])[3] + 1):(dim(X1[[x]])[3] +
dim(X3[[x]])[3])] = X3[[x]]
}
if (!is.null(X2) & !is.null(X3) & is.null(X1)) {
ncov = dim(X2[[x]])[3] + dim(X3[[x]])[3]
df = array(0, dim = c(nn[x], nn[x], ncov))
df[, , 1:dim(X2[[x]])[3]] = X2[[x]]
df[, , (dim(X2[[x]])[3] + 1):(dim(X2[[x]])[3] +
dim(X3[[x]])[3])] = X3[[x]]
}
if (!is.null(X1) & is.null(X2) & is.null(X3)) {
df = X1[[x]]
}
if (is.null(X1) & !is.null(X2) & is.null(X3)) {
df = X2[[x]]
}
if (is.null(X1) & is.null(X2) & !is.null(X3)) {
df = X3[[x]]
}
return(df)
})
}
}
if (!is.null(FullX))
X = FullX
PP = dim(X[[1]])[3]
XX = unlist(X)
YY = unlist(Y)
YY[which(is.na(YY))] = 0
XX[which(is.na(XX))] = 0
if (is.null(priors)) {
MuBeta = rep(0, (PP + 1))
VarBeta = rep(1, (PP + 1))
MuAlpha = 0
VarAlpha = 1
MuZ = c(0, 0)
VarZ = c(20, 20)
PriorA = 100
PriorB = 150
}
else {
if (class(priors) != "list")
(stop("priors must be of class list, if not NULL"))
MuBeta = priors$MuBeta
VarBeta = priors$VarBeta
MuAlpha = priors$MuAlpha
VarAlpha = priors$VarAlpha
MuZ = priors$MuZ
VarZ = priors$VarZ
PriorA = priors$PriorA
PriorB = priors$PriorB
}
C = lapply(1:KK, function(tt) {
diag(nn[tt]) - (1/nn[tt]) * array(1, dim = c(nn[tt],
nn[tt]))
})
Z0 = lapply(1:KK, function(tt) {
g = graph.adjacency(Y[[tt]])
ss = shortest.paths(g)
ss[ss > 4] = 4
Z0 = cmdscale(ss, k = dd)
dimnames(Z0)[[1]] = dimnames(YY[[tt]])[[1]]
return(Z0)
})
Z00 = lapply(1:KK, function(tt) C[[tt]] %*% Z0[[tt]])
if (is.null(initialVals)) {
Z0 = unlist(Z00)
beta0 = replicate(KK, rnorm(PP, 0, 1))
intercept0 = rnorm(KK, 0, 1)
if (intervention == 1) {
alpha0 = rnorm(1, 0, 1)
}
print("Starting Values Set")
}
else {
if (class(initialVals) != "list")
(stop("initialVals must be of class list, if not NULL"))
Z0 = initialVals$ZZ
beta0 = initialVals$beta
intercept0 = initialVals$intercept
if (intervention == 1) {
alpha0 = initialVals$alpha
}
}
if (intervention == 0) {
alpha0 = 0
TT = rep(0, KK)
}
if (is.null(tune)) {
a.number = 5
tuneAlpha = 0.9
tuneBeta = array(1, dim = c(PP, KK))
tuneInt = rep(0.2, KK)
tuneZ = lapply(1:KK, function(x) rep(1.2, nn[x]))
}
else {
if (class(tune) != "list")
(stop("tune must be of class list, if not NULL"))
a.number = 1
tuneAlpha = tune$tuneAlpha
tuneBeta = tune$tuneBeta
tuneInt = tune$tuneInt
tuneZ = tune$tuneZ
}
do.again = 1
tuneX = 1
if (tuneIn == TRUE) {
while (do.again == 1) {
print("Tuning the Sampler")
for (counter in 1:a.number) {
rslt = MCMCfunction(nn = nn, PP = PP, KK = KK,
dd = dd, XX = XX, YY = YY, ZZ = Z0, TT = TT,
beta = beta0, intercept = intercept0, alpha = alpha0,
MuAlpha = MuAlpha, SigmaAlpha = VarAlpha, MuBeta = MuBeta,
SigmaBeta = VarBeta, MuZ = MuZ, VarZ = VarZ,
tuneBetaAll = tuneBeta, tuneInt = tuneInt,
tuneAlpha = tuneAlpha, tuneZAll = unlist(tuneZ),
niter = 200, PriorA = PriorA, PriorB = PriorB,
intervention = intervention)
tuneAlpha = adjust.my.tune(tuneAlpha, rslt$acc$alpha,
1)
tuneZ = lapply(1:KK, function(x) adjust.my.tune(tuneZ[[x]],
rslt$acc$Z[[x]], 2))
tuneBeta = array(sapply(1:KK, function(x) adjust.my.tune(tuneBeta[,
x], rslt$acc$beta[, x], 1)), dim = c(PP, KK))
tuneInt = sapply(1:KK, function(x) adjust.my.tune(tuneInt[x],
rslt$acc$intercept[x], 1))
print(paste("TuneDone = ", tuneX))
tuneX = tuneX + 1
}
extreme = lapply(1:KK, function(x) which.suck(rslt$acc$Z[[x]],
2))
do.again = max(sapply(extreme, length)) > 5
}
print("Tuning is finished")
}
rslt = MCMCfunction(nn = nn, PP = PP, KK = KK, dd = dd, XX = XX,
YY = YY, ZZ = Z0, TT = TT, beta = beta0, intercept = intercept0,
alpha = alpha0, MuAlpha = MuAlpha, SigmaAlpha = VarAlpha,
MuBeta = MuBeta, SigmaBeta = VarBeta, MuZ = MuZ, VarZ = VarZ,
tuneBetaAll = tuneBeta, tuneInt = tuneInt, tuneAlpha = tuneAlpha,
tuneZAll = unlist(tuneZ), niter = niter, PriorA = PriorA,
PriorB = PriorB, intervention = intervention)
Ztransformed = lapply(1:niter, function(ii) {
lapply(1:KK, function(tt) {
z = rslt$draws$ZZ[[ii]][[tt]]
z = C[[tt]] %*% z
pr = t(Z00[[tt]]) %*% z
ssZ = svd(pr)
tx = ssZ$v %*% t(ssZ$u)
zfinal = z %*% tx
return(zfinal)
})
})
rslt$draws$ZZ = Ztransformed
rslt$call = match.call()
if (noCOV == TRUE & intervention == 0) {
rslt$tune = list(tuneZ = tuneZ, tuneInt = tuneInt)
rslt$draws$Beta = NA
rslt$draws$Alpha = NA
}
if (noCOV == TRUE & intervention == 1) {
rslt$tune = list(tuneAlpha = tuneAlpha, tuneZ = tuneZ,
tuneInt = tuneInt)
rslt$draws$Beta = NA
}
if (noCOV == FALSE & intervention == 0) {
rslt$tune = list(tuneBeta = tuneBeta, tuneZ = tuneZ,
tuneInt = tuneInt)
rslt$draws$Alpha = NA
}
if (noCOV == FALSE & intervention == 1) {
rslt$tune = list(tuneBeta = tuneBeta, tuneAlpha = tuneAlpha,
tuneZ = tuneZ, tuneInt = tuneInt)
}
class(rslt) = "HLSM"
rslt
}
<bytecode: 0x22a2c08>
<environment: namespace:HLSM>
--- function search by body ---
Function HLSMrandomEF in namespace HLSM has this body.
----------- END OF FAILURE REPORT --------------
Error in if (class(Y) == "list" & class(Y[[1]]) != "matrix" & class(Y[[1]]) != :
the condition has length > 1
Calls: HLSMrandomEF
Execution halted
Flavor: r-devel-linux-x86_64-fedora-clang
Version: 0.8.1
Check: examples
Result: ERROR
Running examples in ‘HLSM-Ex.R’ failed
The error most likely occurred in:
> ### Name: HLSMrandomEF
> ### Title: Function to run the MCMC sampler in random effects model (and
> ### HLSMfixedEF for fixed effects model)
> ### Aliases: HLSMrandomEF HLSMfixedEF print.HLSM print.summary.HLSM
> ### summary.HLSM getIntercept getAlpha getLS getLikelihood getBeta
>
> ### ** Examples
>
>
> library(HLSM)
> #Set values for the inputs of the function
> priors = NULL
> tune = NULL
> initialVals = NULL
> niter = 10
>
> #Random effect HLSM on Pitt and Spillane data
> random.fit <- HLSMrandomEF(Y = ps.advice.mat,FullX = ps.edge.vars.mat,
+ initialVals = initialVals,priors = priors,
+ tune = tune,tuneIn = FALSE,dd = 2,niter = niter,
+ intervention = 0)
----------- FAILURE REPORT --------------
--- failure: the condition has length > 1 ---
--- srcref ---
:
--- package (from environment) ---
HLSM
--- call from context ---
HLSMrandomEF(Y = ps.advice.mat, FullX = ps.edge.vars.mat, initialVals = initialVals,
priors = priors, tune = tune, tuneIn = FALSE, dd = 2, niter = niter,
intervention = 0)
--- call from argument ---
if (class(Y) == "list" & class(Y[[1]]) != "matrix" & class(Y[[1]]) !=
"data.frame") {
stop("Invalid data structure type")
}
--- R stacktrace ---
where 1: HLSMrandomEF(Y = ps.advice.mat, FullX = ps.edge.vars.mat, initialVals = initialVals,
priors = priors, tune = tune, tuneIn = FALSE, dd = 2, niter = niter,
intervention = 0)
--- value of length: 2 type: logical ---
[1] FALSE TRUE
--- function from context ---
function (Y, edgeCov = NULL, receiverCov = NULL, senderCov = NULL,
FullX = NULL, initialVals = NULL, priors = NULL, tune = NULL,
tuneIn = TRUE, TT = NULL, dd, niter, intervention)
{
if (class(Y) != "list") {
if (dim(Y)[2] != 4) {
stop("Invalid data structure type")
}
}
if (class(Y) == "list" & class(Y[[1]]) != "matrix" & class(Y[[1]]) !=
"data.frame") {
stop("Invalid data structure type")
}
if (class(Y) == "list") {
KK = length(Y)
if (dim(Y[[1]])[1] == dim(Y[[1]])[2]) {
nn = sapply(1:length(Y), function(x) nrow(Y[[x]]))
}
if (dim(Y[[1]])[1] != dim(Y[[1]])[2] & dim(Y[[1]])[2] ==
4) {
nn = sapply(1:length(Y), function(x) length(unique(c(Y[[x]]$Receiver,
Y[[x]]$Sender))))
nodenames = lapply(1:length(Y), function(x) unique(c(Y[[x]]$Receiver,
Y[[x]]$Sender)))
}
}
if (class(Y) != "list") {
if (dim(Y)[2] == 4) {
nid = unique(Y$id)
KK = length(nid)
nn = rep(0, KK)
df.list = list()
nodenames = list()
for (k in 1:KK) {
df.sm = Y[which(Y$id == nid[k], ), ]
nn[k] = length(unique(c(df.sm$Receiver, df.sm$Sender)))
nodenames[[k]] = unique(c(df.sm$Receiver, df.sm$Sender))
df.list[[k]] = array(0, dim = c(nn[k], nn[k]))
dimnames(df.list[[k]])[[1]] = dimnames(df.list[[k]])[[2]] = nodenames[[k]]
for (i in 1:dim(df.sm)[1]) {
df.list[[k]][paste(df.sm$Sender[i]), paste(df.sm$Receiver[i])] = df.sm$Outcome[i]
}
}
Y = df.list
}
}
noCOV = FALSE
if (!is.null(FullX) & !is.null(edgeCov) & !is.null(receiverCov) &
!is.null(senderCov))
(stop("FullX cannot be used when nodal or edge covariates are provided"))
if (is.null(FullX) & is.null(edgeCov) & is.null(receiverCov) &
is.null(senderCov)) {
X = lapply(1:KK, function(x) array(0, dim = c(nn[x],
nn[x], 1)))
noCOV = TRUE
}
if (is.null(FullX)) {
if (!is.null(edgeCov) | !is.null(senderCov) | !is.null(receiverCov)) {
if (!is.null(edgeCov)) {
if (class(edgeCov) != "data.frame") {
stop("edgeCov must be of class data.frame")
}
X1 = getEdgeCov(edgeCov, nn, nodenames)
}
else (X1 = NULL)
if (!is.null(senderCov)) {
if (class(senderCov) != "data.frame") {
stop("senderCov must be of class data.frame")
}
X2 = getSenderCov(senderCov, nn, nodenames)
}
else (X2 = NULL)
if (!is.null(receiverCov)) {
if (class(receiverCov) != "data.frame") {
stop("receiverCov must be of class data.frame")
}
X3 = getReceiverCov(receiverCov, nn, nodenames)
}
else (X3 = NULL)
X = lapply(1:KK, function(x) {
if (!is.null(X1) & !is.null(X2) & !is.null(X3)) {
ncov = dim(X1[[x]])[3] + dim(X2[[x]])[3] +
dim(X3[[x]])[3]
df = array(0, dim = c(nn[x], nn[x], ncov))
df[, , 1:dim(X1[[x]])[3]] = X1[[x]]
df[, , (dim(X1[[x]])[3] + 1):(dim(X1[[x]])[3] +
dim(X2[[x]])[3])] = X2[[x]]
df[, , (dim(X1[[x]])[3] + dim(X2[[x]])[3] +
1):(dim(X1[[x]])[3] + dim(X2[[x]])[3] + dim(X3[[x]])[3])] = X3[[x]]
}
if (!is.null(X1) & !is.null(X2) & is.null(X3)) {
ncov = dim(X1[[x]])[3] + dim(X2[[x]])[3]
df = array(0, dim = c(nn[x], nn[x], ncov))
df[, , 1:dim(X1[[x]])[3]] = X1[[x]]
df[, , (dim(X1[[x]])[3] + 1):(dim(X1[[x]])[3] +
dim(X2[[x]])[3])] = X2[[x]]
}
if (!is.null(X1) & !is.null(X3) & is.null(X2)) {
ncov = dim(X1[[x]])[3] + dim(X3[[x]])[3]
df = array(0, dim = c(nn[x], nn[x], ncov))
df[, , 1:dim(X1[[x]])[3]] = X1[[x]]
df[, , (dim(X1[[x]])[3] + 1):(dim(X1[[x]])[3] +
dim(X3[[x]])[3])] = X3[[x]]
}
if (!is.null(X2) & !is.null(X3) & is.null(X1)) {
ncov = dim(X2[[x]])[3] + dim(X3[[x]])[3]
df = array(0, dim = c(nn[x], nn[x], ncov))
df[, , 1:dim(X2[[x]])[3]] = X2[[x]]
df[, , (dim(X2[[x]])[3] + 1):(dim(X2[[x]])[3] +
dim(X3[[x]])[3])] = X3[[x]]
}
if (!is.null(X1) & is.null(X2) & is.null(X3)) {
df = X1[[x]]
}
if (is.null(X1) & !is.null(X2) & is.null(X3)) {
df = X2[[x]]
}
if (is.null(X1) & is.null(X2) & !is.null(X3)) {
df = X3[[x]]
}
return(df)
})
}
}
if (!is.null(FullX))
X = FullX
PP = dim(X[[1]])[3]
XX = unlist(X)
YY = unlist(Y)
YY[which(is.na(YY))] = 0
XX[which(is.na(XX))] = 0
if (is.null(priors)) {
MuBeta = rep(0, (PP + 1))
VarBeta = rep(1, (PP + 1))
MuAlpha = 0
VarAlpha = 1
MuZ = c(0, 0)
VarZ = c(20, 20)
PriorA = 100
PriorB = 150
}
else {
if (class(priors) != "list")
(stop("priors must be of class list, if not NULL"))
MuBeta = priors$MuBeta
VarBeta = priors$VarBeta
MuAlpha = priors$MuAlpha
VarAlpha = priors$VarAlpha
MuZ = priors$MuZ
VarZ = priors$VarZ
PriorA = priors$PriorA
PriorB = priors$PriorB
}
C = lapply(1:KK, function(tt) {
diag(nn[tt]) - (1/nn[tt]) * array(1, dim = c(nn[tt],
nn[tt]))
})
Z0 = lapply(1:KK, function(tt) {
g = graph.adjacency(Y[[tt]])
ss = shortest.paths(g)
ss[ss > 4] = 4
Z0 = cmdscale(ss, k = dd)
dimnames(Z0)[[1]] = dimnames(YY[[tt]])[[1]]
return(Z0)
})
Z00 = lapply(1:KK, function(tt) C[[tt]] %*% Z0[[tt]])
if (is.null(initialVals)) {
Z0 = unlist(Z00)
beta0 = replicate(KK, rnorm(PP, 0, 1))
intercept0 = rnorm(KK, 0, 1)
if (intervention == 1) {
alpha0 = rnorm(1, 0, 1)
}
print("Starting Values Set")
}
else {
if (class(initialVals) != "list")
(stop("initialVals must be of class list, if not NULL"))
Z0 = initialVals$ZZ
beta0 = initialVals$beta
intercept0 = initialVals$intercept
if (intervention == 1) {
alpha0 = initialVals$alpha
}
}
if (intervention == 0) {
alpha0 = 0
TT = rep(0, KK)
}
if (is.null(tune)) {
a.number = 5
tuneAlpha = 0.9
tuneBeta = array(1, dim = c(PP, KK))
tuneInt = rep(0.2, KK)
tuneZ = lapply(1:KK, function(x) rep(1.2, nn[x]))
}
else {
if (class(tune) != "list")
(stop("tune must be of class list, if not NULL"))
a.number = 1
tuneAlpha = tune$tuneAlpha
tuneBeta = tune$tuneBeta
tuneInt = tune$tuneInt
tuneZ = tune$tuneZ
}
do.again = 1
tuneX = 1
if (tuneIn == TRUE) {
while (do.again == 1) {
print("Tuning the Sampler")
for (counter in 1:a.number) {
rslt = MCMCfunction(nn = nn, PP = PP, KK = KK,
dd = dd, XX = XX, YY = YY, ZZ = Z0, TT = TT,
beta = beta0, intercept = intercept0, alpha = alpha0,
MuAlpha = MuAlpha, SigmaAlpha = VarAlpha, MuBeta = MuBeta,
SigmaBeta = VarBeta, MuZ = MuZ, VarZ = VarZ,
tuneBetaAll = tuneBeta, tuneInt = tuneInt,
tuneAlpha = tuneAlpha, tuneZAll = unlist(tuneZ),
niter = 200, PriorA = PriorA, PriorB = PriorB,
intervention = intervention)
tuneAlpha = adjust.my.tune(tuneAlpha, rslt$acc$alpha,
1)
tuneZ = lapply(1:KK, function(x) adjust.my.tune(tuneZ[[x]],
rslt$acc$Z[[x]], 2))
tuneBeta = array(sapply(1:KK, function(x) adjust.my.tune(tuneBeta[,
x], rslt$acc$beta[, x], 1)), dim = c(PP, KK))
tuneInt = sapply(1:KK, function(x) adjust.my.tune(tuneInt[x],
rslt$acc$intercept[x], 1))
print(paste("TuneDone = ", tuneX))
tuneX = tuneX + 1
}
extreme = lapply(1:KK, function(x) which.suck(rslt$acc$Z[[x]],
2))
do.again = max(sapply(extreme, length)) > 5
}
print("Tuning is finished")
}
rslt = MCMCfunction(nn = nn, PP = PP, KK = KK, dd = dd, XX = XX,
YY = YY, ZZ = Z0, TT = TT, beta = beta0, intercept = intercept0,
alpha = alpha0, MuAlpha = MuAlpha, SigmaAlpha = VarAlpha,
MuBeta = MuBeta, SigmaBeta = VarBeta, MuZ = MuZ, VarZ = VarZ,
tuneBetaAll = tuneBeta, tuneInt = tuneInt, tuneAlpha = tuneAlpha,
tuneZAll = unlist(tuneZ), niter = niter, PriorA = PriorA,
PriorB = PriorB, intervention = intervention)
Ztransformed = lapply(1:niter, function(ii) {
lapply(1:KK, function(tt) {
z = rslt$draws$ZZ[[ii]][[tt]]
z = C[[tt]] %*% z
pr = t(Z00[[tt]]) %*% z
ssZ = svd(pr)
tx = ssZ$v %*% t(ssZ$u)
zfinal = z %*% tx
return(zfinal)
})
})
rslt$draws$ZZ = Ztransformed
rslt$call = match.call()
if (noCOV == TRUE & intervention == 0) {
rslt$tune = list(tuneZ = tuneZ, tuneInt = tuneInt)
rslt$draws$Beta = NA
rslt$draws$Alpha = NA
}
if (noCOV == TRUE & intervention == 1) {
rslt$tune = list(tuneAlpha = tuneAlpha, tuneZ = tuneZ,
tuneInt = tuneInt)
rslt$draws$Beta = NA
}
if (noCOV == FALSE & intervention == 0) {
rslt$tune = list(tuneBeta = tuneBeta, tuneZ = tuneZ,
tuneInt = tuneInt)
rslt$draws$Alpha = NA
}
if (noCOV == FALSE & intervention == 1) {
rslt$tune = list(tuneBeta = tuneBeta, tuneAlpha = tuneAlpha,
tuneZ = tuneZ, tuneInt = tuneInt)
}
class(rslt) = "HLSM"
rslt
}
<bytecode: 0x3d41428>
<environment: namespace:HLSM>
--- function search by body ---
Function HLSMrandomEF in namespace HLSM has this body.
----------- END OF FAILURE REPORT --------------
Error in if (class(Y) == "list" & class(Y[[1]]) != "matrix" & class(Y[[1]]) != :
the condition has length > 1
Calls: HLSMrandomEF
Execution halted
Flavor: r-devel-linux-x86_64-fedora-gcc