library("CARBayes")
## Loading required package: Rcpp
## Warning: package 'Rcpp' was built under R version 3.4.2
set.seed(20171109)
sessionInfo()
## R version 3.4.1 (2017-06-30)
## Platform: x86_64-apple-darwin15.6.0 (64-bit)
## Running under: OS X El Capitan 10.11.6
##
## Matrix products: default
## BLAS: /System/Library/Frameworks/Accelerate.framework/Versions/A/Frameworks/vecLib.framework/Versions/A/libBLAS.dylib
## LAPACK: /Library/Frameworks/R.framework/Versions/3.4/Resources/lib/libRlapack.dylib
##
## locale:
## [1] en_US.UTF-8/en_US.UTF-8/en_US.UTF-8/C/en_US.UTF-8/en_US.UTF-8
##
## attached base packages:
## [1] stats graphics grDevices utils datasets methods base
##
## other attached packages:
<<<<<<< Updated upstream
## [1] CARBayes_5.0 Rcpp_0.12.13 bindrcpp_0.2 dplyr_0.7.4 xtable_1.8-2 Hmisc_4.0-3 Formula_1.2-2 survival_2.41-3 lattice_0.20-35 MCMCpack_1.4-0
## [11] MASS_7.3-47 coda_0.19-1 dlm_1.1-4 ggplot2_2.2.1.9000 plyr_1.8.4 knitr_1.17
##
## loaded via a namespace (and not attached):
## [1] deldir_0.1-14 gtools_3.5.0 assertthat_0.2.0 digest_0.6.12 truncnorm_1.0-7 R6_2.2.2 backports_1.1.1 acepack_1.4.1 MatrixModels_0.4-1
## [10] evaluate_0.10.1 spam_2.1-1 highr_0.6 rlang_0.1.2 lazyeval_0.2.0 spdep_0.6-15 gdata_2.18.0 data.table_1.10.4 SparseM_1.77
## [19] gmodels_2.16.2 rpart_4.1-11 Matrix_1.2-11 checkmate_1.8.4 labeling_0.3 splines_3.4.1 stringr_1.2.0 foreign_0.8-69 htmlwidgets_0.9
## [28] munsell_0.4.3 compiler_3.4.1 shapefiles_0.7 pkgconfig_2.0.1 base64enc_0.1-3 mcmc_0.9-5 htmltools_0.3.6 nnet_7.3-12 expm_0.999-2
## [37] tibble_1.3.4 gridExtra_2.3 htmlTable_1.9 matrixcalc_1.0-3 grid_3.4.1 nlme_3.1-131 gtable_0.2.0 magrittr_1.5 scales_0.5.0.9000
## [46] stringi_1.1.5 reshape2_1.4.2 LearnBayes_2.15 sp_1.2-5 latticeExtra_0.6-28 boot_1.3-20 CARBayesdata_2.0 RColorBrewer_1.1-2 tools_3.4.1
## [55] glue_1.1.1 colorspace_1.3-2 cluster_2.0.6 dotCall64_0.9-04 bindr_0.1 quantreg_5.33
=======
## [1] knitr_1.17 ggplot2_2.2.1 bindrcpp_0.2 dplyr_0.7.4 CARBayes_5.0 Rcpp_0.12.13 MASS_7.3-47
##
## loaded via a namespace (and not attached):
## [1] gtools_3.5.0 spam_2.1-1 splines_3.4.0 lattice_0.20-35 colorspace_1.3-2 expm_0.999-2 htmltools_0.3.6 yaml_2.1.14 MCMCpack_1.4-0 rlang_0.1.2
## [11] foreign_0.8-69 glue_1.1.1 sp_1.2-5 bindr_0.1 plyr_1.8.4 stringr_1.2.0 MatrixModels_0.4-1 dotCall64_0.9-04 CARBayesdata_2.0 munsell_0.4.3
## [21] gtable_0.2.0 coda_0.19-1 evaluate_0.10.1 labeling_0.3 SparseM_1.77 quantreg_5.33 spdep_0.6-13 highr_0.6 backports_1.1.0 scales_0.4.1
## [31] gdata_2.18.0 truncnorm_1.0-7 deldir_0.1-14 mcmc_0.9-5 digest_0.6.12 stringi_1.1.5 gmodels_2.16.2 grid_3.4.0 rprojroot_1.2 tools_3.4.0
## [41] LearnBayes_2.15 magrittr_1.5 lazyeval_0.2.0 tibble_1.3.4 tidyr_0.6.3 pkgconfig_2.0.1 Matrix_1.2-10 shapefiles_0.7 matrixcalc_1.0-3 assertthat_0.2.0
## [51] rmarkdown_1.6 R6_2.2.2 boot_1.3-20 nlme_3.1-131 compiler_3.4.0
>>>>>>> Stashed changes

Using the data from this post, we will utilize the intrinsic CAR prior to account for spatial association.

load("data/spatial20171108.rda")
head(d)
##   x.easting x.northing Y_normal Y_pois trials Y_binom    x1    x2
## 1 1 1 -1.28 1 10 2 -2.01 0.00
## 2 2 1 1.49 4 10 10 0.55 0.38
## 3 3 1 1.36 3 10 9 0.10 0.79
## 4 4 1 0.55 2 10 7 0.08 -0.14
## 5 5 1 0.89 0 10 6 -0.54 1.13
## 6 6 1 0.02 2 10 3 0.35 -0.84

Build a neighborhood structure based on 4 nearest neighbors, i.e. cardinal directions.

n <- nrow(d)
distance <- as.matrix(dist(d[,c("x.easting","x.northing")]))

# Proximity matrix
W <- matrix(0, nrow = n, ncol = n)
W[distance==1] <- 1
image(W)

center

Normal model

system.time(
mn <- S.CARleroux(formula = Y_normal ~ x1 + x2,
family = "gaussian",
data = d,
W = W,
fix.rho = TRUE, rho = 1, # intrinsic CAR
burnin = 20000,
n.sample = 100000,
verbose = FALSE)
)
##    user  system elapsed 
<<<<<<< Updated upstream
## 44.141 3.975 49.694
=======
## 29.587 0.025 29.599
>>>>>>> Stashed changes
mn
## 
## #################
## #### Model fitted
## #################
## Likelihood model - Gaussian (identity link function)
## Random effects model - Leroux CAR
## Regression equation - Y_normal ~ x1 + x2
## Number of missing observations - 0
##
## ############
## #### Results
## ############
## Posterior quantities and DIC
##
## Median 2.5% 97.5% n.sample % accept n.effective Geweke.diag
## (Intercept) 0.6248 0.5968 0.6522 80000 100 75134.2 -0.6
## x1 0.9836 0.9447 1.0236 80000 100 14171.7 1.1
## x2 0.9859 0.9429 1.0288 80000 100 15026.4 -1.1
## nu2 0.0171 0.0037 0.0398 80000 100 1724.8 -1.0
## tau2 0.0848 0.0323 0.1532 80000 100 1896.8 1.1
## rho 1.0000 1.0000 1.0000 NA NA NA NA
##
## DIC = -55.9519 p.d = 65.39269 Percent deviance explained = 99.67

Spatial surface

d$mean = apply(mn$samples$phi, 2, mean)
d$sd = apply(mn$samples$phi, 2, sd)

ggplot(d, aes(x.easting, x.northing)) +
geom_raster(aes(fill = mean)) +
theme_bw()

center

Binomial model

system.time(
mb <- S.CARleroux(formula = Y_binom ~ x1 + x2,
family = "binomial",
data = d,
trials = d$trials,
W = W,
fix.rho = TRUE, rho = 1, # intrinsic CAR
burnin = 20000,
n.sample = 100000,
verbose = FALSE)
)
##    user  system elapsed 
<<<<<<< Updated upstream
## 38.574 3.925 47.830
=======
## 40.272 0.105 40.327
>>>>>>> Stashed changes
mb
## 
## #################
## #### Model fitted
## #################
## Likelihood model - Binomial (logit link function)
## Random effects model - Leroux CAR
## Regression equation - Y_binom ~ x1 + x2
## Number of missing observations - 0
##
## ############
## #### Results
## ############
## Posterior quantities and DIC
##
## Median 2.5% 97.5% n.sample % accept n.effective Geweke.diag
## (Intercept) 0.7655 0.6074 0.9242 80000 46.5 26245.6 -1.8
## x1 1.1657 0.9771 1.3665 80000 46.5 15932.2 -1.1
## x2 1.0543 0.8567 1.2662 80000 46.5 17006.5 -1.2
## tau2 0.0134 0.0026 0.1437 80000 100.0 304.1 0.1
## rho 1.0000 1.0000 1.0000 NA NA NA NA
##
## DIC = 313.3336 p.d = 3.998382 Percent deviance explained = 48.75

Poisson model

system.time(
mp <- S.CARleroux(formula = Y_pois ~ x1 + x2,
family = "poisson",
data = d,
W = W,
fix.rho = TRUE, rho = 1, # intrinsic CAR
burnin = 20000,
n.sample = 100000,
verbose = FALSE)
)
##    user  system elapsed 
<<<<<<< Updated upstream
## 32.139 3.258 37.832
=======
## 31.409 0.000 31.342
>>>>>>> Stashed changes
mp
## 
## #################
## #### Model fitted
## #################
## Likelihood model - Poisson (log link function)
## Random effects model - Leroux CAR
## Regression equation - Y_pois ~ x1 + x2
## Number of missing observations - 0
##
## ############
## #### Results
## ############
## Posterior quantities and DIC
##
## Median 2.5% 97.5% n.sample % accept n.effective Geweke.diag
## (Intercept) 0.7115 0.5425 0.8745 80000 46 2063.7 -2.3
## x1 0.9905 0.8651 1.1047 80000 46 1571.7 2.5
## x2 0.8755 0.7375 1.0117 80000 46 2495.8 1.2
## tau2 0.0600 0.0065 0.2742 80000 100 103.6 -0.4
## rho 1.0000 1.0000 1.0000 NA NA NA NA
##
## DIC = 382.3014 p.d = 12.18594 Percent deviance explained = 70.27


blog comments powered by Disqus

Published

09 November 2017

Tags