#
# Extract and save the main results.
setwd(paste0(wd,"/MCresults_",sce,"_n",n))
#
labels = paste0("lambda[",1:4,"]")
aux = as.matrix(output_pexm[, labels])
me <- apply(aux, 2, mean)
hpd <- HPDinterval(coda::as.mcmc(aux))
hpd1 <- hpd[,1]; hpd2 <- hpd[,2];
write.table(matrix(round(me,5),nrow=1), file = "pexm_me.txt", row.names = FALSE, col.names = FALSE, quote = FALSE, append = TRUE)
write.table(matrix(round(hpd1,5),nrow=1), file = "pexm_hpd1.txt", row.names = FALSE, col.names = FALSE, quote = FALSE, append = TRUE)
write.table(matrix(round(hpd2,5),nrow=1), file = "pexm_hpd2.txt", row.names = FALSE, col.names = FALSE, quote = FALSE, append = TRUE)
write.table(matrix(round(time_pexm,5),nrow=1), file = "pexm_time.txt", row.names = FALSE, col.names = FALSE, quote = FALSE, append = TRUE)
aux = as.matrix(output_pois[, labels])
me <- apply(aux, 2, mean)
hpd <- HPDinterval(coda::as.mcmc(aux))
hpd1 <- hpd[,1]; hpd2 <- hpd[,2];
write.table(matrix(round(me,5),nrow=1), file = "pois_me.txt", row.names = FALSE, col.names = FALSE, quote = FALSE, append = TRUE)
write.table(matrix(round(hpd1,5),nrow=1), file = "pois_hpd1.txt", row.names = FALSE, col.names = FALSE, quote = FALSE, append = TRUE)
write.table(matrix(round(hpd2,5),nrow=1), file = "pois_hpd2.txt", row.names = FALSE, col.names = FALSE, quote = FALSE, append = TRUE)
write.table(matrix(round(time_pois,5),nrow=1), file = "pois_time.txt", row.names = FALSE, col.names = FALSE, quote = FALSE, append = TRUE)
#
setwd(wd)
cat("\014"); cat("Scenario = ",sce,"; n = ",n,"; MC progress (in %): ", round(100*step/nMC,2), "\r");
} # end MC iterations.
} # end function runMC.
# Run the MC scheme with the commands below.
# Warning: It will take some time to run each scenario with nMC = 100 replications.
wd = getwd()
# Scenario 1 (increasing lambda)
lambda <- c(0.3, 0.6, 0.8, 1.3)
dir.create(paste0(wd,"/MCresults_s1_n100")); runMC(n = 100, lambda)
set.seed(1981)
# Load some required R libraries.
if(!require("plotrix")){ install.packages("plotrix"); library("plotrix")}
if(!require("msm")){ install.packages("msm"); library("msm")}
if(!require("rjags")){ install.packages("rjags"); library("rjags")}
library("pexm")
loadpexm()
set.seed(1981)
# Function to run the MC scheme.
# Time grid tau is fixed here.
# Sample size n and the true configuration of lambda
# are treated as input arguments.
runMC <- function(n, lambda){
#
nMC <- 100 # Number of replications.
if(sum(diff(lambda)) > 0){ sce = "s1" }
if(sum(diff(lambda)) == 0){ sce = "s2" }
if(sum(diff(lambda)) < 0){ sce = "s3" }
tau <- c(0.0, 2.0, 3.0, 5.0)
m <- length(tau)
pq <- c(1,2,seq(5,95,5),98,99)/100
nq <- length(pq)
burnin <- 1000; lag <- 1; npost <- 2000
#
for(step in 1:nMC){
# Set the same starting values for both types of implementations (pexm and Poisson-zeros).
inits1 <- list( lambda = c(0.1, 0.5, 1, 2), .RNG.name = "base::Super-Duper", .RNG.seed = 1 )
inits2 <- list( lambda = c(0.5, 1.0, 1.5, 2.5), .RNG.name = "base::Wichmann-Hill", .RNG.seed = 2 )
#
# Gernerate the artificial data.
t <- rpexp(n, lambda, tau)
#
# Prepare MCMC for the pexm case.
data = list(t = t, n = n, tau = tau, m = m)
# Compile and run the model using pexm.
Mjags <- rjags::jags.model(file = "Model_pex_MCpexm.R", data = data, inits = list(inits1, inits2), n.chains = 2, n.adapt = burnin, quiet = TRUE)
time0 <- proc.time()
invisible(capture.output( output_pexm <- rjags::coda.samples(Mjags, variable.names = "lambda", n.iter = npost, thin = lag) ))
time_pexm <- proc.time() - time0
#
# Prepare MCMC for the Poisson-zeros strategy.
# Identify the grid interval for each t[i].
id <- as.numeric(cut(t, c(tau,max(t)) ,include.lowest=TRUE))
# Matrix Tnm (nxm) is such that Tnm[i,j] contains the amplitude of the j-th interval with respect to the position of t[i].
Tnm <- matrix(nrow = n, ncol = m);
a <- c(tau, max(t))
for(i in 1:n){ for(j in 1:m){ Tnm[i,j] <- (min(t[i], a[j+1]) - a[j])*(t[i] > a[j]) } }
# The vectors "t" and "tau" are replaced by the matrix "Tnm" and the vector "id".
# "Tnm" and "id" account for the location of each t[i] in the grid.
data <- list(zeros = numeric(n), Tnm = Tnm, id = id, n = n, m = m)
Mjags <- rjags::jags.model(file = "Model_pex_MCpois.R", data = data, inits = list(inits1, inits2), n.chains = 2, n.adapt = burnin, quiet = TRUE)
time0 <- proc.time()
invisible(capture.output( output_pois <- rjags::coda.samples(Mjags, variable.names = "lambda", n.iter = npost, thin = lag) ))
time_pois <- proc.time() - time0
#
# Extract and save the main results.
setwd(paste0(wd,"/MCresults_",sce,"_n",n))
#
labels = paste0("lambda[",1:4,"]")
aux = as.matrix(output_pexm[, labels])
me <- apply(aux, 2, mean)
hpd <- HPDinterval(coda::as.mcmc(aux))
hpd1 <- hpd[,1]; hpd2 <- hpd[,2];
write.table(matrix(round(me,5),nrow=1), file = "pexm_me.txt", row.names = FALSE, col.names = FALSE, quote = FALSE, append = TRUE)
write.table(matrix(round(hpd1,5),nrow=1), file = "pexm_hpd1.txt", row.names = FALSE, col.names = FALSE, quote = FALSE, append = TRUE)
write.table(matrix(round(hpd2,5),nrow=1), file = "pexm_hpd2.txt", row.names = FALSE, col.names = FALSE, quote = FALSE, append = TRUE)
write.table(matrix(round(time_pexm,5),nrow=1), file = "pexm_time.txt", row.names = FALSE, col.names = FALSE, quote = FALSE, append = TRUE)
aux = as.matrix(output_pois[, labels])
me <- apply(aux, 2, mean)
hpd <- HPDinterval(coda::as.mcmc(aux))
hpd1 <- hpd[,1]; hpd2 <- hpd[,2];
write.table(matrix(round(me,5),nrow=1), file = "pois_me.txt", row.names = FALSE, col.names = FALSE, quote = FALSE, append = TRUE)
write.table(matrix(round(hpd1,5),nrow=1), file = "pois_hpd1.txt", row.names = FALSE, col.names = FALSE, quote = FALSE, append = TRUE)
write.table(matrix(round(hpd2,5),nrow=1), file = "pois_hpd2.txt", row.names = FALSE, col.names = FALSE, quote = FALSE, append = TRUE)
write.table(matrix(round(time_pois,5),nrow=1), file = "pois_time.txt", row.names = FALSE, col.names = FALSE, quote = FALSE, append = TRUE)
#
setwd(wd)
cat("\014"); cat("Scenario = ",sce,"; n = ",n,"; MC progress (in %): ", round(100*step/nMC,2), "\r");
} # end MC iterations.
} # end function runMC.
# Run the MC scheme with the commands below.
# Warning: It will take some time to run each scenario with nMC = 100 replications.
wd = getwd()
# Scenario 1 (increasing lambda)
lambda <- c(0.3, 0.6, 0.8, 1.3)
dir.create(paste0(wd,"/MCresults_s1_n100")); runMC(n = 100, lambda)
dir.create(paste0(wd,"/MCresults_s1_n1000")); runMC(n = 1000, lambda)
# Load some required R libraries.
if(!require("plotrix")){ install.packages("plotrix"); library("plotrix")}
if(!require("msm")){ install.packages("msm"); library("msm")}
if(!require("rjags")){ install.packages("rjags"); library("rjags")}
library("pexm")
loadpexm()
# Function to run the MC scheme.
# Time grid tau is fixed here.
# Sample size n and the true configuration of lambda
# are treated as input arguments.
runMC <- function(n, lambda){
#
nMC <- 100 # Number of replications.
if(sum(diff(lambda)) > 0){ sce = "s1" }
if(sum(diff(lambda)) == 0){ sce = "s2" }
if(sum(diff(lambda)) < 0){ sce = "s3" }
tau <- c(0.0, 2.0, 3.0, 5.0)
m <- length(tau)
pq <- c(1,2,seq(5,95,5),98,99)/100
nq <- length(pq)
burnin <- 1000; lag <- 1; npost <- 2000
#
for(step in 1:nMC){
# Set the same starting values for both types of implementations (pexm and Poisson-zeros).
inits1 <- list( lambda = c(0.1, 0.5, 1, 2), .RNG.name = "base::Super-Duper", .RNG.seed = 1 )
inits2 <- list( lambda = c(0.5, 1.0, 1.5, 2.5), .RNG.name = "base::Wichmann-Hill", .RNG.seed = 2 )
#
# Gernerate the artificial data.
t <- rpexp(n, lambda, tau)
#
# Prepare MCMC for the pexm case.
data = list(t = t, n = n, tau = tau, m = m)
# Compile and run the model using pexm.
Mjags <- rjags::jags.model(file = "Model_pex_MCpexm.R", data = data, inits = list(inits1, inits2), n.chains = 2, n.adapt = burnin, quiet = TRUE)
time0 <- proc.time()
invisible(capture.output( output_pexm <- rjags::coda.samples(Mjags, variable.names = "lambda", n.iter = npost, thin = lag) ))
time_pexm <- proc.time() - time0
#
# Prepare MCMC for the Poisson-zeros strategy.
# Identify the grid interval for each t[i].
id <- as.numeric(cut(t, c(tau,max(t)) ,include.lowest=TRUE))
# Matrix Tnm (nxm) is such that Tnm[i,j] contains the amplitude of the j-th interval with respect to the position of t[i].
Tnm <- matrix(nrow = n, ncol = m);
a <- c(tau, max(t))
for(i in 1:n){ for(j in 1:m){ Tnm[i,j] <- (min(t[i], a[j+1]) - a[j])*(t[i] > a[j]) } }
# The vectors "t" and "tau" are replaced by the matrix "Tnm" and the vector "id".
# "Tnm" and "id" account for the location of each t[i] in the grid.
data <- list(zeros = numeric(n), Tnm = Tnm, id = id, n = n, m = m)
Mjags <- rjags::jags.model(file = "Model_pex_MCpois.R", data = data, inits = list(inits1, inits2), n.chains = 2, n.adapt = burnin, quiet = TRUE)
time0 <- proc.time()
invisible(capture.output( output_pois <- rjags::coda.samples(Mjags, variable.names = "lambda", n.iter = npost, thin = lag) ))
time_pois <- proc.time() - time0
#
# Extract and save the main results.
setwd(paste0(wd,"/MCresults_",sce,"_n",n))
#
labels = paste0("lambda[",1:4,"]")
aux = as.matrix(output_pexm[, labels])
me <- apply(aux, 2, mean)
hpd <- HPDinterval(coda::as.mcmc(aux))
hpd1 <- hpd[,1]; hpd2 <- hpd[,2];
write.table(matrix(round(me,5),nrow=1), file = "pexm_me.txt", row.names = FALSE, col.names = FALSE, quote = FALSE, append = TRUE)
write.table(matrix(round(hpd1,5),nrow=1), file = "pexm_hpd1.txt", row.names = FALSE, col.names = FALSE, quote = FALSE, append = TRUE)
write.table(matrix(round(hpd2,5),nrow=1), file = "pexm_hpd2.txt", row.names = FALSE, col.names = FALSE, quote = FALSE, append = TRUE)
write.table(matrix(round(time_pexm,5),nrow=1), file = "pexm_time.txt", row.names = FALSE, col.names = FALSE, quote = FALSE, append = TRUE)
aux = as.matrix(output_pois[, labels])
me <- apply(aux, 2, mean)
hpd <- HPDinterval(coda::as.mcmc(aux))
hpd1 <- hpd[,1]; hpd2 <- hpd[,2];
write.table(matrix(round(me,5),nrow=1), file = "pois_me.txt", row.names = FALSE, col.names = FALSE, quote = FALSE, append = TRUE)
write.table(matrix(round(hpd1,5),nrow=1), file = "pois_hpd1.txt", row.names = FALSE, col.names = FALSE, quote = FALSE, append = TRUE)
write.table(matrix(round(hpd2,5),nrow=1), file = "pois_hpd2.txt", row.names = FALSE, col.names = FALSE, quote = FALSE, append = TRUE)
write.table(matrix(round(time_pois,5),nrow=1), file = "pois_time.txt", row.names = FALSE, col.names = FALSE, quote = FALSE, append = TRUE)
#
setwd(wd)
cat("\014"); cat("Scenario = ",sce,"; n = ",n,"; MC progress (in %): ", round(100*step/nMC,2), "\r");
} # end MC iterations.
} # end function runMC.
# Run the MC scheme with the commands below.
# Warning: It will take some time to run each scenario with nMC = 100 replications.
wd = getwd()
# Load some required R libraries.
if(!require("plotrix")){ install.packages("plotrix"); library("plotrix")}
if(!require("msm")){ install.packages("msm"); library("msm")}
if(!require("rjags")){ install.packages("rjags"); library("rjags")}
library("pexm")
loadpexm()
# Function to run the MC scheme.
# Time grid tau is fixed here.
# Sample size n and the true configuration of lambda
# are treated as input arguments.
runMC <- function(n, lambda){
#
nMC <- 100 # Number of replications.
if(sum(diff(lambda)) > 0){ sce = "s1" }
if(sum(diff(lambda)) == 0){ sce = "s2" }
if(sum(diff(lambda)) < 0){ sce = "s3" }
tau <- c(0.0, 2.0, 3.0, 5.0)
m <- length(tau)
pq <- c(1,2,seq(5,95,5),98,99)/100
nq <- length(pq)
burnin <- 1000; lag <- 1; npost <- 2000
#
for(step in 1:nMC){
# Set the same starting values for both types of implementations (pexm and Poisson-zeros).
inits1 <- list( lambda = c(0.1, 0.5, 1, 2), .RNG.name = "base::Super-Duper", .RNG.seed = 1 )
inits2 <- list( lambda = c(0.5, 1.0, 1.5, 2.5), .RNG.name = "base::Wichmann-Hill", .RNG.seed = 2 )
#
# Gernerate the artificial data.
t <- rpexp(n, lambda, tau)
#
# Prepare MCMC for the pexm case.
data = list(t = t, n = n, tau = tau, m = m)
# Compile and run the model using pexm.
Mjags <- rjags::jags.model(file = "Model_pex_MCpexm.R", data = data, inits = list(inits1, inits2), n.chains = 2, n.adapt = burnin, quiet = TRUE)
time0 <- proc.time()
invisible(capture.output( output_pexm <- rjags::coda.samples(Mjags, variable.names = "lambda", n.iter = npost, thin = lag) ))
time_pexm <- proc.time() - time0
#
# Prepare MCMC for the Poisson-zeros strategy.
# Identify the grid interval for each t[i].
id <- as.numeric(cut(t, c(tau,max(t)) ,include.lowest=TRUE))
# Matrix Tnm (nxm) is such that Tnm[i,j] contains the amplitude of the j-th interval with respect to the position of t[i].
Tnm <- matrix(nrow = n, ncol = m);
a <- c(tau, max(t))
for(i in 1:n){ for(j in 1:m){ Tnm[i,j] <- (min(t[i], a[j+1]) - a[j])*(t[i] > a[j]) } }
# The vectors "t" and "tau" are replaced by the matrix "Tnm" and the vector "id".
# "Tnm" and "id" account for the location of each t[i] in the grid.
data <- list(zeros = numeric(n), Tnm = Tnm, id = id, n = n, m = m)
Mjags <- rjags::jags.model(file = "Model_pex_MCpois.R", data = data, inits = list(inits1, inits2), n.chains = 2, n.adapt = burnin, quiet = TRUE)
time0 <- proc.time()
invisible(capture.output( output_pois <- rjags::coda.samples(Mjags, variable.names = "lambda", n.iter = npost, thin = lag) ))
time_pois <- proc.time() - time0
#
# Extract and save the main results.
setwd(paste0(wd,"/MCresults_",sce,"_n",n))
#
labels = paste0("lambda[",1:4,"]")
aux = as.matrix(output_pexm[, labels])
me <- apply(aux, 2, mean)
hpd <- HPDinterval(coda::as.mcmc(aux))
hpd1 <- hpd[,1]; hpd2 <- hpd[,2];
write.table(matrix(round(me,5),nrow=1), file = "pexm_me.txt", row.names = FALSE, col.names = FALSE, quote = FALSE, append = TRUE)
write.table(matrix(round(hpd1,5),nrow=1), file = "pexm_hpd1.txt", row.names = FALSE, col.names = FALSE, quote = FALSE, append = TRUE)
write.table(matrix(round(hpd2,5),nrow=1), file = "pexm_hpd2.txt", row.names = FALSE, col.names = FALSE, quote = FALSE, append = TRUE)
write.table(matrix(round(time_pexm,5),nrow=1), file = "pexm_time.txt", row.names = FALSE, col.names = FALSE, quote = FALSE, append = TRUE)
aux = as.matrix(output_pois[, labels])
me <- apply(aux, 2, mean)
hpd <- HPDinterval(coda::as.mcmc(aux))
hpd1 <- hpd[,1]; hpd2 <- hpd[,2];
write.table(matrix(round(me,5),nrow=1), file = "pois_me.txt", row.names = FALSE, col.names = FALSE, quote = FALSE, append = TRUE)
write.table(matrix(round(hpd1,5),nrow=1), file = "pois_hpd1.txt", row.names = FALSE, col.names = FALSE, quote = FALSE, append = TRUE)
write.table(matrix(round(hpd2,5),nrow=1), file = "pois_hpd2.txt", row.names = FALSE, col.names = FALSE, quote = FALSE, append = TRUE)
write.table(matrix(round(time_pois,5),nrow=1), file = "pois_time.txt", row.names = FALSE, col.names = FALSE, quote = FALSE, append = TRUE)
#
setwd(wd)
cat("\014"); cat("Scenario = ",sce,"; n = ",n,"; MC progress (in %): ", round(100*step/nMC,2), "\r");
} # end MC iterations.
} # end function runMC.
# Run the MC scheme with the commands below.
# Warning: It will take some time to run each scenario with nMC = 100 replications.
wd = getwd()
set.seed(1981)
# Scenario 1 (increasing lambda)
lambda <- c(0.3, 0.6, 0.8, 1.3)
dir.create(paste0(wd,"/MCresults_s1_n100")); runMC(n = 100, lambda)
dir.create(paste0(wd,"/MCresults_s1_n1000")); runMC(n = 1000, lambda)
set.seed(1981)
# Scenario 2 (constant lambda)
lambda <- c(0.7, 0.7, 0.7, 0.7)
dir.create(paste0(wd,"/MCresults_s2_n100")); runMC(n = 100, lambda)
dir.create(paste0(wd,"/MCresults_s2_n1000")); runMC(n = 1000, lambda)
set.seed(1981)
# Scenario 3 (decreasing lambda)
lambda <- c(1.3, 0.8, 0.6, 0.3)
dir.create(paste0(wd,"/MCresults_s3_n100")); runMC(n = 100, lambda)
dir.create(paste0(wd,"/MCresults_s3_n1000")); runMC(n = 1000, lambda)
# Load some required R libraries.
if(!require("plotrix")){ install.packages("plotrix"); library("plotrix")}
if(!require("msm")){ install.packages("msm"); library("msm")}
if(!require("rjags")){ install.packages("rjags"); library("rjags")}
library("pexm")
loadpexm()
# Function to run the MC scheme. Time grid tau is fixed here.
# Sample size n and the true configuration of lambda are treated as input arguments.
runMC <- function(n, lambda){
#
nMC <- 100 # Number of replications.
if(sum(diff(lambda)) > 0){ sce = "s1" }
if(sum(diff(lambda)) == 0){ sce = "s2" }
if(sum(diff(lambda)) < 0){ sce = "s3" }
tau <- c(0.0, 2.0, 3.0, 5.0)
m <- length(tau)
pq <- c(1, 2, seq(5, 95, 5), 98, 99) / 100
nq <- length(pq)
burnin <- 1000; lag <- 1; npost <- 2000
#
for(step in 1:nMC){
# Set the same starting values for both types of implementations (pexm and Poisson-zeros).
inits1 <- list( lambda = c(0.1, 0.5, 1, 2), .RNG.name = "base::Super-Duper", .RNG.seed = 1 )
inits2 <- list( lambda = c(0.5, 1.0, 1.5, 2.5), .RNG.name = "base::Wichmann-Hill", .RNG.seed = 2 )
#
# Gernerate the artificial data.
t <- rpexp(n, lambda, tau)
#
# Prepare MCMC for the pexm case.
data = list(t = t, n = n, tau = tau, m = m)
# Compile and run the model using pexm.
Mjags1 <- rjags::jags.model(file = "Model_pex_MCpexm.R", data = data, inits = list(inits1, inits2), n.chains = 2, n.adapt = burnin, quiet = TRUE)
time0 <- proc.time()
invisible(capture.output( output_pexm <- rjags::coda.samples(Mjags1, variable.names = "lambda", n.iter = npost, thin = lag) ))
time_pexm <- proc.time() - time0
#
# Prepare MCMC for the Poisson-zeros strategy.
# Identify the grid interval for each t[i].
id <- as.numeric(cut(t, c(tau, max(t)), include.lowest = TRUE))
# Matrix Tnm (nxm) is such that Tnm[i,j] contains the amplitude of the j-th interval with respect to the position of t[i].
Tnm <- matrix(nrow = n, ncol = m);
a <- c(tau, max(t))
for(i in 1:n){ for(j in 1:m){ Tnm[i,j] <- (min(t[i], a[j+1]) - a[j]) * (t[i] > a[j]) } }
# The vectors "t" and "tau" are replaced by the matrix "Tnm" and the vector "id".
# "Tnm" and "id" account for the location of each t[i] in the grid.
data <- list(zeros = numeric(n), Tnm = Tnm, id = id, n = n, m = m)
Mjags2 <- rjags::jags.model(file = "Model_pex_MCpois.R", data = data, inits = list(inits1, inits2), n.chains = 2, n.adapt = burnin, quiet = TRUE)
time0 <- proc.time()
invisible(capture.output( output_pois <- rjags::coda.samples(Mjags2, variable.names = "lambda", n.iter = npost, thin = lag) ))
time_pois <- proc.time() - time0
#
# Extract and save the main results.
setwd(paste0(wd,"/MCresults_",sce,"_n",n))
# pexm:
labels = paste0("lambda[",1:4,"]")
aux1 = as.matrix(output_pexm[, labels])
me <- apply(aux1, 2, mean)
aux2 <- coda::as.mcmc(aux1)
hpd <- HPDinterval(aux2)
hpd1 <- hpd[,1]; hpd2 <- hpd[,2]
aux3 <- output_pexm[, labels][1] # Autocorrelation and effective sample size (only the 1st chain for each parameter).
aco <- coda::autocorr.diag(aux3, lags = c(1), relative=FALSE)
eff <- coda::effectiveSize(aux3)
write.table(matrix(round(me, 5), nrow = 1), file = "pexm_mean.txt", row.names = FALSE, col.names = FALSE, quote = FALSE, append = TRUE)
write.table(matrix(round(hpd1, 5), nrow = 1), file = "pexm_hpd1.txt", row.names = FALSE, col.names = FALSE, quote = FALSE, append = TRUE)
write.table(matrix(round(hpd2, 5), nrow = 1), file = "pexm_hpd2.txt", row.names = FALSE, col.names = FALSE, quote = FALSE, append = TRUE)
write.table(matrix(round(time_pexm[1], 5),nrow = 1), file = "pexm_time.txt", row.names = FALSE, col.names = FALSE, quote = FALSE, append = TRUE)
write.table(matrix(round(aco, 5),nrow = 1), file = "pexm_autocor.txt", row.names = FALSE, col.names = FALSE, quote = FALSE, append = TRUE)
write.table(matrix(round(eff, 5),nrow = 1), file = "pexm_effsize.txt", row.names = FALSE, col.names = FALSE, quote = FALSE, append = TRUE)
# Poisson-zeros:
aux1 = as.matrix(output_pois[, labels])
me <- apply(aux1, 2, mean)
aux2 <- coda::as.mcmc(aux1)
hpd <- HPDinterval(aux2)
hpd1 <- hpd[,1]; hpd2 <- hpd[,2]
aux3 <- output_pexm[, labels][1] # Autocorrelation and effective sample size (only the 1st chain for each parameter).
aco <- coda::autocorr.diag(aux3, lags = c(1), relative=FALSE)
eff <- coda::effectiveSize(aux3)
write.table(matrix(round(me, 5), nrow = 1), file = "pois_mean.txt", row.names = FALSE, col.names = FALSE, quote = FALSE, append = TRUE)
write.table(matrix(round(hpd1, 5),nrow = 1), file = "pois_hpd1.txt", row.names = FALSE, col.names = FALSE, quote = FALSE, append = TRUE)
write.table(matrix(round(hpd2, 5),nrow = 1), file = "pois_hpd2.txt", row.names = FALSE, col.names = FALSE, quote = FALSE, append = TRUE)
write.table(matrix(round(time_pois[1], 5), nrow = 1), file = "pois_time.txt", row.names = FALSE, col.names = FALSE, quote = FALSE, append = TRUE)
write.table(matrix(round(aco, 5),nrow = 1), file = "pois_autocor.txt", row.names = FALSE, col.names = FALSE, quote = FALSE, append = TRUE)
write.table(matrix(round(eff, 5),nrow = 1), file = "pois_effsize.txt", row.names = FALSE, col.names = FALSE, quote = FALSE, append = TRUE)
#
setwd(wd)
cat("\014"); cat("Scenario = ",sce,"; n = ",n,"; MC progress (in %): ", round(100*step/nMC, 2), "\r");
} # end MC iterations.
} # end function runMC.
# Run the MC scheme with the commands below.
# Warning: It will take some time to run each scenario with nMC = 100 replications.
wd = getwd()
set.seed(1981)
# Scenario 1 (increasing lambda)
lambda <- c(0.3, 0.6, 0.8, 1.3)
dir.create(paste0(wd,"/MCresults_s1_n100")); runMC(n = 100, lambda)
dir.create(paste0(wd,"/MCresults_s1_n1000")); runMC(n = 1000, lambda)
set.seed(1981)
# Scenario 2 (constant lambda)
lambda <- c(0.7, 0.7, 0.7, 0.7)
dir.create(paste0(wd,"/MCresults_s2_n100")); runMC(n = 100, lambda)
dir.create(paste0(wd,"/MCresults_s2_n1000")); runMC(n = 1000, lambda)
set.seed(1981)
# Scenario 3 (decreasing lambda)
lambda <- c(1.3, 0.8, 0.6, 0.3)
dir.create(paste0(wd,"/MCresults_s3_n100")); runMC(n = 100, lambda)
dir.create(paste0(wd,"/MCresults_s3_n1000")); runMC(n = 1000, lambda)
wd = getwd() # Path to the main working directory.
# Load the results from the MC simulation.
c_name = c("pexm", "pois")
s_name = c("s1", "s2", "s3")
n_name = c("n100", "n1000")
nMC = 100
real1 = matrix(rep(c(0.3, 0.6, 0.8, 1.3),nMC), nMC, 4, byrow = TRUE)
real2 = matrix(rep(c(0.7, 0.7, 0.7, 0.7),nMC), nMC, 4, byrow = TRUE)
real3 = matrix(rep(c(1.3, 0.8, 0.6, 0.3),nMC), nMC, 4, byrow = TRUE)
for(i in c_name){
for(j in s_name){
for(k in n_name){
setwd(paste0(wd,"/MCresults_",j,"_",k))
me = read.table(paste0(i,"_mean.txt"))
hpd1 = read.table(paste0(i,"_hpd1.txt"))
hpd2 = read.table(paste0(i,"_hpd2.txt"))
time = read.table(paste0(i,"_time.txt"))
aco = read.table(paste0(i,"_autocor.txt"))
eff = read.table(paste0(i,"_effsize.txt"))
if(j == "s1"){real = real1}
if(j == "s2"){real = real2}
if(j == "s3"){real = real3}
rb = 100 * (me - real) / real
cp = 100 * apply( (hpd1 < real & hpd2 > real), 2, sum ) / nMC
assign(paste0(i,"_rb_",j,"_",k), rb)
assign(paste0(i,"_cp_",j,"_",k), cp)
assign(paste0(i,"_ti_",j,"_",k), time)
assign(paste0(i,"_au_",j,"_",k), aco)
assign(paste0(i,"_ef_",j,"_",k), eff)
}
}
}
wd = getwd() # Path to the main working directory.
par(mfrow = c(3, 2))
# Panel 1:
aux = cbind(pexm_ef_s1_n100, rep(NA, nMC), pois_ef_s1_n100)
co = c(rep("powderblue", 4), NA, rep("mistyrose", 4))
boxplot(aux, names = c(1, 2, 3, 4, NA, 1, 2, 3, 4), ylim = c(-10, 2000),
cex.axis = 2, cex.lab = 2, ylab = "Effective size", xlab = "lambda",
whisklty = 1, whisklwd = 2, boxlwd = 2, staplelwd = 2, col = co)
abline(v = 5, lwd = 1)
# Panel 2:
aux = cbind(pexm_ef_s1_n1000, rep(NA, nMC), pois_ef_s1_n1000)
co = c(rep("powderblue",4), NA, rep("mistyrose", 4))
boxplot(aux, names = c(1, 2, 3, 4, NA, 1, 2, 3, 4), ylim = c(-10, 2000),
cex.axis = 2, cex.lab = 2, ylab = "Effective size", xlab = "lambda",
whisklty = 1, whisklwd = 2, boxlwd = 2, staplelwd = 2, col = co)
abline(v = 5, lwd = 1)
# Panel 3:
aux = cbind(pexm_ef_s2_n100, rep(NA, nMC), pois_ef_s2_n100)
co = c(rep("powderblue",4), NA, rep("mistyrose", 4))
boxplot(aux, names = c(1, 2, 3, 4, NA, 1, 2, 3, 4), ylim = c(-10, 2000),
cex.axis = 2, cex.lab = 2, ylab = "Effective size", xlab = "lambda",
whisklty = 1, whisklwd = 2, boxlwd = 2, staplelwd = 2, col = co)
abline(v = 5, lwd = 1)
# Panel 4:
aux = cbind(pexm_ef_s2_n1000, rep(NA, nMC), pois_ef_s2_n1000)
co = c(rep("powderblue", 4), NA, rep("mistyrose", 4))
boxplot(aux, names = c(1, 2, 3, 4, NA, 1, 2, 3, 4), ylim = c(-10, 2000),
cex.axis = 2, cex.lab = 2, ylab = "Effective size", xlab = "lambda",
whisklty = 1, whisklwd = 2, boxlwd = 2, staplelwd = 2, col = co)
abline(v = 5, lwd = 1)
# Panel 5:
aux = cbind(pexm_ef_s3_n100, rep(NA, nMC), pois_ef_s3_n100)
co = c(rep("powderblue",4), NA, rep("mistyrose", 4))
boxplot(aux, names = c(1, 2, 3, 4, NA, 1, 2, 3, 4), ylim = c(-10, 2000),
cex.axis = 2, cex.lab = 2, ylab = "Effective size", xlab = "lambda",
whisklty = 1, whisklwd = 2, boxlwd = 2, staplelwd = 2, col = co)
abline(v = 5, lwd = 1)
# Panel 6:
aux = cbind(pexm_ef_s3_n1000, rep(NA, nMC), pois_ef_s3_n1000)
co = c(rep("powderblue",4), NA, rep("mistyrose", 4))
boxplot(aux, names = c(1, 2, 3, 4, NA, 1, 2, 3, 4), ylim = c(-10, 2000),
cex.axis = 2, cex.lab = 2, ylab = "Effective size", xlab = "lambda",
whisklty = 1, whisklwd = 2, boxlwd = 2, staplelwd = 2, col = co)
abline(v = 5, lwd = 1)
wd = getwd() # Path to the main working directory.
# Load the results from the MC simulation.
c_name = c("pexm", "pois")
s_name = c("s1", "s2", "s3")
n_name = c("n100", "n1000")
nMC = 100
real1 = matrix(rep(c(0.3, 0.6, 0.8, 1.3),nMC), nMC, 4, byrow = TRUE)
real2 = matrix(rep(c(0.7, 0.7, 0.7, 0.7),nMC), nMC, 4, byrow = TRUE)
real3 = matrix(rep(c(1.3, 0.8, 0.6, 0.3),nMC), nMC, 4, byrow = TRUE)
for(i in c_name){
for(j in s_name){
for(k in n_name){
setwd(paste0(wd,"/MCresults_",j,"_",k))
me = read.table(paste0(i,"_mean.txt"))
hpd1 = read.table(paste0(i,"_hpd1.txt"))
hpd2 = read.table(paste0(i,"_hpd2.txt"))
time = read.table(paste0(i,"_time.txt"))
aco = read.table(paste0(i,"_autocor.txt"))
eff = read.table(paste0(i,"_effsize.txt"))
if(j == "s1"){real = real1}
if(j == "s2"){real = real2}
if(j == "s3"){real = real3}
rb = 100 * (me - real) / real
cp = 100 * apply( (hpd1 < real & hpd2 > real), 2, sum ) / nMC
assign(paste0(i,"_rb_",j,"_",k), rb)
assign(paste0(i,"_cp_",j,"_",k), cp)
assign(paste0(i,"_ti_",j,"_",k), time)
assign(paste0(i,"_au_",j,"_",k), aco)
assign(paste0(i,"_ef_",j,"_",k), eff)
}
}
}
setwd(wd) # Path to the main working directory.
