├── .Rbuildignore ├── .gitignore ├── DESCRIPTION ├── NAMESPACE ├── R ├── ContinuousSpaceDiscreteTimeModel.R ├── ContinuousSpaceModel.R ├── ContinuousSpaceTimeModel.R ├── Mesh.R ├── NonConvexHullMesh.R ├── ReplicatedContinuousSpaceModel.R ├── SpaceModel.R ├── SpaceTimeRaster.R ├── SpatialMesh.R └── utilities.R ├── README.md ├── README.pdf ├── SpaceTimeModels.Rproj ├── inst └── tests │ └── tests1.R └── man ├── ContinuousSpaceDiscreteTimeModel.Rd ├── ContinuousSpaceModel.Rd ├── NonConvexHullMesh.Rd ├── SpaceTimeRaster.Rd └── SpatialMesh.Rd /.Rbuildignore: -------------------------------------------------------------------------------- 1 | ^.*\.Rproj$ 2 | ^\.Rproj\.user$ 3 | -------------------------------------------------------------------------------- /.gitignore: -------------------------------------------------------------------------------- 1 | # History files 2 | .Rhistory 3 | .Rapp.history 4 | 5 | # Example code in package build process 6 | *-Ex.R 7 | 8 | # RStudio files 9 | .Rproj.user/ 10 | 11 | # produced vignettes 12 | vignettes/*.html 13 | vignettes/*.pdf 14 | .Rproj.user 15 | -------------------------------------------------------------------------------- /DESCRIPTION: -------------------------------------------------------------------------------- 1 | Package: SpaceTimeModels 2 | Type: Package 3 | Title: An interface for fitting parametric spatial and spatio-temporal models 4 | with INLA 5 | Version: 0.1.5 6 | Date: 2017-05-20 7 | Author: Jussi Jousimo 8 | Maintainer: Jussi Jousimo 9 | Description: An interface for fitting parametric spatial and spatio-temporal 10 | models with INLA 11 | License: BSD_2_clause + file LICENSE 12 | Depends: 13 | R (>= 3.0.0), 14 | INLA (>= 0.0-1428997066), 15 | R6 (>= 2.1.0), 16 | sp, 17 | spacetime, 18 | raster, 19 | plyr, 20 | reshape2, 21 | tidyverse, 22 | rasterVis 23 | URL: https://github.com/statguy/SpaceTimeModels 24 | LazyLoad: yes 25 | Collate: 26 | 'utilities.R' 27 | 'Mesh.R' 28 | 'SpatialMesh.R' 29 | 'NonConvexHullMesh.R' 30 | 'SpaceModel.R' 31 | 'ContinuousSpaceModel.R' 32 | 'ContinuousSpaceTimeModel.R' 33 | 'ContinuousSpaceDiscreteTimeModel.R' 34 | 'ReplicatedContinuousSpaceModel.R' 35 | 'SpaceTimeRaster.R' 36 | RoxygenNote: 5.0.1 37 | -------------------------------------------------------------------------------- /NAMESPACE: -------------------------------------------------------------------------------- 1 | # Generated by roxygen2: do not edit by hand 2 | 3 | export(ContinuousSpaceDiscreteTimeModel) 4 | export(ContinuousSpaceModel) 5 | export(ContinuousSpaceTimeModel) 6 | export(Mesh) 7 | export(NonConvexHullMesh) 8 | export(ReplicatedContinuousSpaceModel) 9 | export(SpaceModel) 10 | export(SpaceTimeRaster) 11 | export(SpatialMesh) 12 | export(assertCompleteCovariates) 13 | export(findScale) 14 | export(getCovariateNames) 15 | export(getINLAModelMatrix) 16 | export(local.inla.spde2.matern.default) 17 | export(local.inla.spde2.matern.new) 18 | export(nullScale) 19 | export(summaryINLAParameter) 20 | export(theme_raster) 21 | exportClasses(ContinousSpaceTimeModel) 22 | exportClasses(ContinuousSpaceDiscreteTimeModel) 23 | exportClasses(ContinuousSpaceModel) 24 | exportClasses(Mesh) 25 | exportClasses(NonConvexHullMesh) 26 | exportClasses(ReplicatedContinuousSpaceModel) 27 | exportClasses(SpaceModel) 28 | exportClasses(SpaceTimeRaster) 29 | exportClasses(SpatialMesh) 30 | import(R6) 31 | -------------------------------------------------------------------------------- /R/ContinuousSpaceDiscreteTimeModel.R: -------------------------------------------------------------------------------- 1 | #' @title Continuous space, discrete time model 2 | #' @description Continuous space and discrete time model. 3 | #' @references Lindgren, F. & Rue, H. (2015). Bayesian Spatial Modelling with R-INLA. Journal of Statistical Software, 63(19). 4 | #' @usage NULL 5 | #' @format NULL 6 | #' @import R6 7 | #' @author Jussi Jousimo <\email{jvj@@iki.fi}> 8 | #' @exportClass ContinuousSpaceDiscreteTimeModel 9 | #' @export ContinuousSpaceDiscreteTimeModel 10 | ContinuousSpaceDiscreteTimeModel <- R6::R6Class( 11 | "ContinuousSpaceDiscreteTimeModel", 12 | lock_objects = FALSE, 13 | inherit = SpaceTimeModels::ContinuousSpaceTimeModel, 14 | public = list( 15 | initialize = function() { 16 | self$temporalModel <- "ar1" 17 | }, 18 | 19 | getRandomEffectTerm = function() { 20 | model <- if (is.null(self$temporalPrior)) 21 | "f(spatial, model=spde, group=spatial.group, control.group=c(list(model=self$temporalModel)" 22 | else 23 | "f(spatial, model=spde, group=spatial.group, control.group=c(list(model=self$temporalModel, hyper=self$temporalPrior)" 24 | if (!is.null(self$temporalParams)) model <- paste0(model, ", self$temporalParams") 25 | model <- paste0(model, "))") 26 | return(model) 27 | }, 28 | 29 | addObservationStack = function(sp, response = NA, covariates, offset, tag = "obs") { 30 | if (missing(sp)) 31 | stop("Required argument 'sp' missing.") 32 | if (!inherits(sp, "STI")) 33 | stop("Argument 'sp' must be of class 'STI'.") 34 | 35 | if (is.null(self$getSpatialMesh())) 36 | stop("Mesh must be defined first.") 37 | if (is.null(self$getSPDE())) 38 | stop("Spatial prior must be defined first.") 39 | if (is.null(self$covariatesModel)) 40 | stop("Covariates model must be defined first.") 41 | #if (missing(coordinates)) coordinates <- model$getSpatialMesh()$getKnots() 42 | 43 | dataList <- list(response = response) 44 | if (!missing(offset)) dataList$E <- offset / self$getOffsetScale() 45 | if (!is.null(self$getLinkFunction())) dataList$link <- self$getLinkFunction() 46 | 47 | coordinates <- self$scaleCoordinates(sp::coordinates(sp)) 48 | if (!missing(covariates)) SpaceTimeModels::assertCompleteCovariates(self$covariatesModel, covariates) 49 | if (length(SpaceTimeModels::getCovariateNames(self$covariatesModel)) > 0 && missing(covariates)) 50 | stop("Covariates specified in the model but argument 'covariates' missing.") 51 | modelMatrix <- SpaceTimeModels::getINLAModelMatrix(self$covariatesModel, covariates) 52 | 53 | time <- time(sp) 54 | timeIndex <- time - min(time) + 1 55 | nTime <- length(unique(timeIndex)) 56 | 57 | fieldIndex <- INLA::inla.spde.make.index("spatial", n.spde = self$getSPDE()$n.spde, n.group = nTime) 58 | A <- INLA::inla.spde.make.A(self$getSpatialMesh()$getINLAMesh(), loc = coordinates, group = timeIndex, n.group = nTime) 59 | 60 | effects <- if (self$hasIntercept()) list(c(fieldIndex, list(intercept = 1))) else list(fieldIndex) 61 | AList <- if (!is.null(modelMatrix)) { 62 | effects[[2]] <- modelMatrix 63 | list(A, 1) 64 | } 65 | else list(A) 66 | 67 | self$addStack(data = dataList, A = AList, effects = effects, tag = tag) 68 | 69 | return(invisible(self)) 70 | }, 71 | 72 | addPredictionStack = function(sp, tag = "pred") { 73 | if (missing(sp)) 74 | stop("Required argument 'sp' missing.") 75 | if (!inherits(sp, "STI")) 76 | stop("Argument 'sp' must be of class 'STI'.") 77 | 78 | dataList <- list(response = NA) 79 | if (!is.null(self$getLinkFunction())) dataList$link <- self$getLinkFunction() 80 | 81 | coordinates <- self$scaleCoordinates(sp::coordinates(sp)) 82 | nTime <- length(unique(time(sp))) 83 | fieldIndex <- inla.spde.make.index("spatial", n.spde = self$getSPDE()$n.spde, n.group = nTime) 84 | effects <- if (self$hasIntercept()) list(c(fieldIndex, list(intercept = 1))) else list(c(fieldIndex)) 85 | AList <- list(1) 86 | 87 | self$addStack(data = dataList, A = AList, effects = effects, tag = tag) 88 | 89 | return(invisible(self)) 90 | }, 91 | 92 | addValidationStack = function(sp, index, covariates, offset, tag = "val") { 93 | self$addObservationStack(sp = sp, index = index, response = NA, covariates = covariates, offset = offset, tag = tag) 94 | }, 95 | 96 | summary = function() { 97 | if (is.null(self$result)) 98 | stop("The model has not been estimated.") 99 | summary(self$result) 100 | }, 101 | 102 | summaryTemporalVariation = function(variable = "mean", timeIndex, summariseFun = sum, tag = "obs", ...) { 103 | observed <- self$getObserved(tag = tag) 104 | fitted <- self$getFittedResponse(variable = variable, withOffset = TRUE, tag = tag) 105 | 106 | timeIndex <- if (missing(timeIndex)) { 107 | index <- self$getIndex(tag = tag) 108 | INLA::inla.stack.RHS(self$getFullStack())$spatial.group[index] 109 | } 110 | else timeIndex 111 | 112 | offset <- self$getOffset(tag) 113 | x <- data.frame(time = timeIndex, observed = observed, fitted = fitted, offset = offset) 114 | df <- x %>% dplyr::group_by(time) %>% 115 | dplyr::summarise(observed = summariseFun(observed, ...), fitted = summariseFun(fitted, ...)) 116 | return(df) 117 | }, 118 | 119 | plotTemporalVariation = function(timeIndex, tag = "obs") { 120 | x <- self$summaryTemporalVariation(timeIndex = timeIndex, tag = tag) 121 | p <- x %>% tidyr::gather(observed, fitted, value = "value", key = "variable") %>% 122 | ggplot2::ggplot(aes(time, value, colour = variable)) + ggplot2::geom_line() 123 | return(p) 124 | }, 125 | 126 | getSpatialVariationRaster = function(variable = "mean", timeIndex, timeLabels, template = self$getSpatialMesh()$getKnots(), height = 100, width = 100, crs = self$getSpatialMesh()$getCRS(), tag = "pred") { 127 | predictedValues <- self$getFittedResponse(variable = variable, tag = tag) 128 | meshNodes <- self$getSpatialMesh()$getINLAMesh()$n 129 | maxTimeIndex <- length(na.omit(unique(INLA::inla.stack.data(self$getFullStack())$spatial.group))) 130 | predictions <- INLA::inla.vector2matrix(predictedValues, nrow = meshNodes, ncol = maxTimeIndex) 131 | if (!missing(timeIndex)) predictions <- predictions[,timeIndex, drop = F] 132 | 133 | r <- SpaceTimeModels::SpaceTimeRaster$new(x = template, height = height, width = width, crs = crs) 134 | r$project(self$getSpatialMesh(), predictions, timeLabels = timeLabels) 135 | return(r) 136 | } 137 | 138 | #plotSpatialVariation = function(variable = "mean", timeIndex, height, width, tag = "pred") { 139 | # str <- self$getSpatialVariationRaster(variable = variable, timeIndex = timeIndex, height = height, width = width, tag = tag) 140 | # p <- rasterVis::gplot(str$getLayer(1)) + ggplot2::geom_raster(aes(fill = value)) 141 | # return(p) 142 | #} 143 | ) 144 | ) 145 | -------------------------------------------------------------------------------- /R/ContinuousSpaceModel.R: -------------------------------------------------------------------------------- 1 | #' @title Continuous space model 2 | #' @description Building and estimating continuous space models. 3 | #' @references Lindgren, F. & Rue, H. (2015). Bayesian Spatial Modelling with R-INLA. Journal of Statistical Software, 63(19). 4 | #' @usage NULL 5 | #' @format NULL 6 | #' @import R6 7 | #' @author Jussi Jousimo \email{jvj@@iki.fi} 8 | #' @exportClass ContinuousSpaceModel 9 | #' @export ContinuousSpaceModel 10 | #' @keywords internal 11 | ContinuousSpaceModel <- R6::R6Class( 12 | "ContinuousSpaceModel", 13 | lock_objects = FALSE, 14 | inherit = SpaceTimeModels::SpaceModel, 15 | public = list( 16 | spaceMesh = NULL, 17 | spde = NULL, 18 | fullStack = NULL, 19 | interceptPrecision = 0.0, 20 | 21 | scaleCoordinates = function(coordinates) { 22 | return(as.matrix(coordinates) / self$getSpatialMesh()$getScale()) 23 | }, 24 | 25 | getRandomEffectTerm = function() { 26 | return("f(spatial, model=spde)") 27 | }, 28 | 29 | hasIntercept = function() { 30 | if (is.null(self$linearModel)) 31 | stop("Linear model must be defined first.") 32 | return("intercept" %in% attr(terms(self$linearModel), "term.labels")) 33 | }, 34 | 35 | addStack = function(data, A, effects, tag) { 36 | obsStack <- inla.stack(data = data, A = A, effects = effects, tag = tag) 37 | self$fullStack <- if (is.null(self$fullStack)) INLA::inla.stack(obsStack) 38 | else { 39 | if (tag %in% names(self$fullStack$data$index)) 40 | stop("Stack with tag '", tag, "' already exists.") 41 | INLA::inla.stack(self$fullStack, obsStack) 42 | } 43 | return(invisible(self)) 44 | }, 45 | 46 | getSpatialMesh = function() return(self$spaceMesh), 47 | getSPDE = function() return(self$spde), 48 | getFullStack = function() return(self$fullStack), 49 | 50 | clearStack = function() { 51 | self$fullStack <- NULL 52 | return(invisible(self)) 53 | }, 54 | 55 | setSpatialMesh = function(mesh) { 56 | if (missing(mesh)) 57 | stop("Argument 'mesh' must be specified.") 58 | if (!inherits(mesh, "Mesh")) 59 | stop("Argument 'mesh' must be of class 'SpaceTimeModels::Mesh' or descedant.") 60 | if (is.null(mesh$getINLAMesh())) 61 | stop("Mesh has not been initialized.") 62 | self$spaceMesh <- mesh 63 | return(invisible(self)) 64 | }, 65 | 66 | setSPDE = function(spde) { 67 | if (missing(spde)) 68 | stop("Argument 'spde' must be specified.") 69 | if (!inherits(spde, "inla.spde2")) 70 | stop("Argument 'spde' must be of class 'INLA::inla.spde'.") 71 | self$spde <- spde 72 | return(invisible(self)) 73 | }, 74 | 75 | setCovariatesModel = function(covariatesModel, covariates) { 76 | if (missing(covariatesModel)) covariatesModel <- ~ 1 77 | else { 78 | if (!inherits(covariatesModel, "formula")) 79 | stop("Argument 'covariatesModel' must be class of 'formula' or descedant.") 80 | } 81 | 82 | x <- if (missing(covariates)) terms(covariatesModel) 83 | else { 84 | if (!inherits(covariates, "data.frame")) 85 | stop("Argument 'covariates' must be class of 'data.frame' or descedant.") 86 | SpaceTimeModels::assertCompleteCovariates(covariatesModel, covariates) 87 | terms(covariatesModel, data = covariates) 88 | } 89 | 90 | if (attr(x, "response") != 0) 91 | stop("The covariates model formula must be right-sided.") 92 | 93 | if (!is.null(self$covariatesModel)) { 94 | warning("Covariates model has been respecified. To enable reuse of the model object, clearStack() method must be called and the data stack needs to be reconstructed.") 95 | } 96 | 97 | self$covariatesModel <- covariatesModel 98 | if (length(SpaceTimeModels::getCovariateNames(self$covariatesModel)) > 0 && missing(covariates)) 99 | stop("Covariates specified in the model but argument 'covariates' missing.") 100 | covariateNames <- colnames(SpaceTimeModels::getINLAModelMatrix(covariatesModel, covariates)) 101 | intercept <- if (attr(x, "intercept")[1] == 0) NULL else "intercept" 102 | randomEffect <- self$getRandomEffectTerm() 103 | self$linearModel <- reformulate(termlabels = c(intercept, covariateNames, randomEffect), response = "response", intercept = FALSE) 104 | 105 | return(invisible(self)) 106 | }, 107 | 108 | setSpatialPrior = function(rho, rho.init = 0.5, sigma = 1, sigma.init = 0.5) { 109 | mesh <- self$getSpatialMesh() 110 | if (is.null(mesh)) 111 | stop("Mesh must be defined first.") 112 | rho <- ifelse(missing(rho), mesh$getSize() / 2, rho / self$getSpatialMesh()$getScale()) 113 | spde <- SpaceTimeModels::local.inla.spde2.matern.new(mesh = mesh$getINLAMesh(), prior.pc.rho = c(rho, rho.init), prior.pc.sig = c(sigma, sigma.init)) 114 | self$setSPDE(spde) 115 | return(invisible(self)) 116 | }, 117 | 118 | setSpatialPriorDefault = function(rho, sigma = 1) { 119 | mesh <- self$getSpatialMesh() 120 | if (is.null(mesh)) 121 | stop("Mesh must be defined first.") 122 | rho <- ifelse(missing(rho), mesh$getSize() / 5, rho / self$getSpatialMesh()$getScale()) 123 | spde <- SpaceTimeModels::local.inla.spde2.matern.default(mesh = mesh$getINLAMesh(), range0 = rho, sigma0 = sigma) 124 | self$setSPDE(spde) 125 | return(invisible(self)) 126 | }, 127 | 128 | setInterceptPrecision = function(prec = 0.0) { 129 | self$interceptPrecision <- prec 130 | return(invisible(self)) 131 | }, 132 | 133 | getInterceptPrecision = function() return(self$interceptPrecision), 134 | 135 | addObservationStack = function(sp, response, covariates, offset, tag = "obs") { 136 | # TODO: allow defining link function 137 | 138 | if (is.null(self$getSpatialMesh())) 139 | stop("Mesh must be defined first.") 140 | if (is.null(self$spde)) 141 | stop("Spatial prior must be defined first.") 142 | if (is.null(self$covariatesModel)) 143 | stop("Covariates model must be defined first.") 144 | #if (missing(coordinates)) coordinates <- model$getSpatialMesh()$getKnots() 145 | if (missing(sp)) 146 | stop("Required argument 'sp' must be given.") 147 | if (!inherits(sp, "SpatialPoints")) 148 | stop("Argument 'sp' must be of class 'sp::SpatialPoints'.") 149 | if (missing(response)) 150 | stop("Required argument 'response' must be given.") 151 | 152 | dataList <- list(response=response) 153 | if (!missing(offset)) dataList$E <- offset / self$getOffsetScale() 154 | if (!is.null(self$getLinkFunction())) dataList$link <- self$getLinkFunction() 155 | 156 | coordinates <- self$scaleCoordinates(sp::coordinates(sp)) 157 | if (!missing(covariates)) SpaceTimeModels::assertCompleteCovariates(self$covariatesModel, covariates) 158 | if (length(SpaceTimeModels::getCovariateNames(self$covariatesModel)) > 0 && missing(covariates)) 159 | stop("Covariates specified in the model but argument 'covariates' missing.") 160 | modelMatrix <- SpaceTimeModels::getINLAModelMatrix(self$covariatesModel, covariates) 161 | fieldIndex <- INLA::inla.spde.make.index("spatial", n.spde = self$getSPDE()$n.spde) 162 | A <- INLA::inla.spde.make.A(self$getSpatialMesh()$getINLAMesh(), loc = coordinates) 163 | 164 | effects <- if (self$hasIntercept()) list(c(fieldIndex, list(intercept = 1))) else list(fieldIndex) 165 | AList <- if (!is.null(modelMatrix)) { 166 | effects[[2]] <- modelMatrix 167 | list(A, 1) 168 | } else list(A) 169 | 170 | self$addStack(data = dataList, A = AList, effects = effects, tag = tag) 171 | 172 | return(invisible(self)) 173 | }, 174 | 175 | addValidationStack = function(sp, covariates, offset, tag = "val") { 176 | self$addObservationStack(sp = sp, response = NA, covariates = covariates, offset = offset, tag = tag) 177 | }, 178 | 179 | addPredictionStack = function(sp, tag = "pred") { 180 | if (missing(sp)) 181 | stop("Required argument 'sp' must be given.") 182 | if (!inherits(sp, "SpatialPoints")) 183 | stop("Argument 'sp' must be of class 'sp::SpatialPoints'.") 184 | 185 | dataList <- list(response = NA) 186 | if (!is.null(self$getLinkFunction())) dataList$link <- self$getLinkFunction() 187 | 188 | coordinates <- self$scaleCoordinates(sp::coordinates(sp)) 189 | fieldIndex <- INLA::inla.spde.make.index("spatial", n.spde = self$getSPDE()$n.spde) 190 | 191 | effects <- if (self$hasIntercept()) list(c(fieldIndex, list(intercept = 1))) else list(c(fieldIndex)) 192 | AList <- list(1) 193 | 194 | self$addStack(data = dataList, A = AList, effects = effects, tag = tag) 195 | 196 | return(invisible(self)) 197 | }, 198 | 199 | estimate = function(waic = TRUE, dic = FALSE, cpo = FALSE, verbose = FALSE) { 200 | if (is.null(self$getFullStack())) 201 | stop("Data stack must be specified first.") 202 | 203 | dataStack <- inla.stack.data(self$getFullStack(), spde = self$getSPDE()) 204 | self$result <- try( 205 | INLA::inla(self$getLinearModel(), family = self$getLikelihood(), data = dataStack, E = dataStack$E, 206 | control.predictor = list(A = INLA::inla.stack.A(self$getFullStack()), link = 1, compute = TRUE), 207 | control.fixed = list(prec.intercept = self$getInterceptPrecision()), 208 | control.compute = list(waic = waic, dic = dic, cpo = cpo, config = TRUE), 209 | control.inla = list(reordering = "metis"), 210 | verbose = verbose) 211 | ) 212 | 213 | if (inherits(self$result, "try-error") || self$result$ok == FALSE) 214 | stop("Estimation failed. Use verbose=TRUE to find the possible cause.") 215 | 216 | return(invisible(self)) 217 | }, 218 | 219 | getIndex = function(tag = "obs") { 220 | if (is.null(self$getFullStack())) 221 | stop("No index has been specified.") 222 | 223 | index <- INLA::inla.stack.index(self$getFullStack(), tag)$data 224 | if (is.null(index)) 225 | stop(paste("No index found with tag", obs)) 226 | return(index) 227 | }, 228 | 229 | getOffset = function(tag = "obs") { 230 | index <- self$getIndex(tag) 231 | offset <- INLA::inla.stack.LHS(self$getFullStack())$E[index] 232 | if (is.null(offset) || all(is.na(offset))) offset <- 1 233 | offset 234 | }, 235 | 236 | getObserved = function(tag = "obs") { 237 | index <- self$getIndex(tag) 238 | INLA::inla.stack.LHS(self$getFullStack())$response[index] 239 | }, 240 | 241 | getFittedResponse = function(variable = "mean", withOffset = FALSE, tag = "obs") { 242 | index <- self$getIndex(tag) 243 | offset <- ifelse(withOffset, self$getOffset(tag), 1) 244 | return(self$getResult()$summary.fitted.values[index, variable] * offset) 245 | }, 246 | 247 | getFittedLinearPredictor = function(variable = "mean", tag = "obs") { 248 | index <- self$getIndex(tag) 249 | return(self$getResult()$summary.linear.predictor[index, variable]) 250 | }, 251 | 252 | getFittedSpatialEffect = function(variable = "mean") { 253 | return(self$getResult()$summary.random$spatial[variable]) 254 | }, 255 | 256 | getFittedFixedEffects = function() { 257 | return(self$getResult()$summary.fixed) 258 | }, 259 | 260 | getFittedHyperparameters = function() { 261 | return(self$getResult()$summary.hyperpar) 262 | }, 263 | 264 | getDIC = function() { 265 | return(self$getResult()$dic) 266 | }, 267 | 268 | getWAIC = function() { 269 | return(self$getResult()$waic) 270 | }, 271 | 272 | getCPO = function() { 273 | return(self$getResult()$cpo) 274 | }, 275 | 276 | getSPDEResult = function() { 277 | if (is.null(self$result) || is.null(self$spde)) 278 | stop("The model has not been estimated.") 279 | return(INLA::inla.spde2.result(self$result, "spatial", self$spde)) 280 | }, 281 | 282 | summarySpatialParameters = function() { 283 | spdeResult <- self$getSPDEResult() 284 | range <- SpaceTimeModels::summaryINLAParameter(spdeResult$marginals.range.nominal[[1]], coordinatesScale = self$getSpatialMesh()$getScale()) 285 | variance <- SpaceTimeModels::summaryINLAParameter(spdeResult$marginals.variance.nominal[[1]]) 286 | kappa <- SpaceTimeModels::summaryINLAParameter(spdeResult$marginals.kappa[[1]], coordinatesScale = 1 / self$getSpatialMesh()$getScale()) 287 | tau <- SpaceTimeModels::summaryINLAParameter(spdeResult$marginals.tau[[1]]) 288 | x <- rbind(kappa = kappa, tau = tau, range = range, variance = variance) 289 | colnames(x) <- c("mean", "sd", "0.025quant", "0.5quant", "0.975quant", "mode") 290 | x 291 | } 292 | ) 293 | ) 294 | -------------------------------------------------------------------------------- /R/ContinuousSpaceTimeModel.R: -------------------------------------------------------------------------------- 1 | #' @import R6 2 | #' @author Jussi Jousimo \email{jvj@@iki.fi} 3 | #' @exportClass ContinousSpaceTimeModel 4 | #' @export ContinuousSpaceTimeModel 5 | #' @keywords internal 6 | ContinuousSpaceTimeModel <- R6::R6Class( 7 | "ContinuousSpaceTimeModel", 8 | lock_objects = FALSE, 9 | inherit = SpaceTimeModels::ContinuousSpaceModel, 10 | public = list( 11 | temporalModel = NULL, 12 | temporalPrior = NULL, 13 | temporalParams = NULL, 14 | 15 | setTemporalPrior = function(model, prior, ...) { 16 | if (missing(model) && missing(prior)) 17 | stop("Required arguments 'model' and/or 'prior' missing.") 18 | if (!missing(model)) self$temporalModel <- model 19 | if (!missing(prior)) self$temporalPrior <- prior 20 | if (!missing(...)) self$temporalParams <- list(...) 21 | return(invisible(self)) 22 | } 23 | ) 24 | ) 25 | -------------------------------------------------------------------------------- /R/Mesh.R: -------------------------------------------------------------------------------- 1 | #' @import R6 2 | #' @author Jussi Jousimo \email{jvj@@iki.fi} 3 | #' @exportClass Mesh 4 | #' @export Mesh 5 | #' @keywords internal 6 | Mesh <- R6::R6Class( 7 | "Mesh", 8 | lock_objects = FALSE, 9 | public = list( 10 | knotsScale = NULL, 11 | knots = NULL, 12 | mesh = NULL, 13 | crs = NULL, 14 | 15 | #getMeshKnots = function() return(unique(self$knots) / self$getScale()), 16 | getMeshKnots = function() return(unique(self$knots)), 17 | 18 | initialize = function(knots, knotsScale = 1) { 19 | if (missing(knots)) 20 | stop("Required argument 'knots' missing.") 21 | if (!inherits(knots, c("SpatialPoints", "ST"))) 22 | stop("Argument 'knots' must be of class 'SpatialPoints' or 'ST'.") 23 | self$knotsScale <- knotsScale 24 | self$knots <- sp::coordinates(knots) / knotsScale 25 | self$crs <- sp::CRS(sp::proj4string(knots)) 26 | }, 27 | 28 | getScale = function() return(self$knotsScale), 29 | 30 | getKnots = function() return(sp::SpatialPoints(self$knots * self$getScale(), proj4string = self$getCRS())), 31 | #getScaledKnots = function() return(sp::SpatialPoints(self$knots / self$getScale(), proj4string = self$getCRS())), 32 | getScaledKnots = function() return(sp::SpatialPoints(self$knots, proj4string = self$getCRS())), 33 | getMeshNodes = function() return(sp::SpatialPoints(self$getINLAMesh()$loc[,1:2] * self$getScale())), 34 | getScaledMeshNodes = function() return(sp::SpatialPoints(self$getINLAMesh()$loc[,1:2])), 35 | 36 | getINLAMesh = function() return(self$mesh), 37 | getCRS = function() return(self$crs), 38 | getNumNodes = function() return(self$getINLAMesh()$n), 39 | 40 | getRange = function() { 41 | nodes <- coordinates(self$getScaledMeshNodes()) 42 | return(c(diff(base::range(nodes[,1])), diff(base::range(nodes[,2])))) 43 | }, 44 | 45 | getSize = function() return(min(self$getRange())), 46 | 47 | plot = function() { 48 | if (is.null(self$mesh)) 49 | stop("Mesh must be constructed first.") 50 | plot(self$getINLAMesh()) 51 | points(self$getMeshKnots(), pch = '*', col = 'red') 52 | return(invisible(self)) 53 | } 54 | ) 55 | ) 56 | -------------------------------------------------------------------------------- /R/NonConvexHullMesh.R: -------------------------------------------------------------------------------- 1 | #' @title Non-convex hull mesh 2 | #' @description Constructs non-convex hull mesh. 3 | #' @references Lindgren, F. & Rue, H. (2015). Bayesian Spatial Modelling with R-INLA. Journal of Statistical Software, 63(19). 4 | #' @usage NULL 5 | #' @format NULL 6 | #' @import R6 7 | #' @author Jussi Jousimo \email{jvj@@iki.fi} 8 | #' @exportClass NonConvexHullMesh 9 | #' @export NonConvexHullMesh 10 | NonConvexHullMesh <- R6::R6Class( 11 | "NonConvexHullMesh", 12 | lock_objects = FALSE, 13 | inherit = SpaceTimeModels::Mesh, 14 | public = list( 15 | construct = function(cutoff = NULL, maxEdge = NULL, offset = NULL, minAngle = NULL, innerConvex = -0.15, outerConvex) { 16 | if (missing(cutoff)) 17 | stop("Required argument 'cutoff' missing.") 18 | if (missing(maxEdge)) 19 | stop("Required argument 'maxEdge' missing.") 20 | 21 | meshCoordinates <- self$getMeshKnots() 22 | boundary1 <- INLA::inla.nonconvex.hull(points = meshCoordinates, convex = innerConvex) 23 | boundary <- if (!missing(outerConvex)) { 24 | boundary2 <- INLA::inla.nonconvex.hull(points = meshCoordinates, convex = outerConvex) 25 | list(boundary1, boundary2) 26 | } 27 | else boundary1 28 | self$mesh <- INLA::inla.mesh.2d(boundary = boundary, 29 | cutoff = SpaceTimeModels::nullScale(cutoff, self$getScale()), 30 | max.edge = SpaceTimeModels::nullScale(maxEdge, self$getScale()), 31 | offset = SpaceTimeModels::nullScale(offset, self$getScale()), 32 | min.angle = minAngle) 33 | }, 34 | 35 | initialize = function(..., cutoff = NULL, maxEdge = NULL, offset = NULL, minAngle = NULL, innerConvex, outerConvex) { 36 | super$initialize(...) 37 | self$construct(cutoff = cutoff, maxEdge = maxEdge, offset = offset, minAngle = minAngle, innerConvex = innerConvex, outerConvex = outerConvex) 38 | } 39 | ) 40 | ) 41 | -------------------------------------------------------------------------------- /R/ReplicatedContinuousSpaceModel.R: -------------------------------------------------------------------------------- 1 | #' @title Replicated continuous space model 2 | #' @description Continuous space model for multiple inpedendent observations at the same location. 3 | #' @references Lindgren, F. & Rue, H. (2015). Bayesian Spatial Modelling with R-INLA. Journal of Statistical Software, 63(19). 4 | #' @usage NULL 5 | #' @format NULL 6 | #' @import R6 7 | #' @author Jussi Jousimo <\email{jvj@@iki.fi}> 8 | #' @exportClass ReplicatedContinuousSpaceModel 9 | #' @export ReplicatedContinuousSpaceModel 10 | ReplicatedContinuousSpaceModel <- R6::R6Class( 11 | "ContinuousSpaceDiscreteTimeModel", 12 | lock_objects = FALSE, 13 | inherit = SpaceTimeModels::ContinuousSpaceTimeModel, 14 | public = list( 15 | initialize = function() { 16 | }, 17 | 18 | getRandomEffectTerm = function() { 19 | return("f(spatial, model=spde, replicate=spatial.repl)") 20 | }, 21 | 22 | addObservationStack = function(sp, index = as.numeric(sp@data$id), response = NA, covariates, offset, tag = "obs") { 23 | if (missing(sp)) 24 | stop("Required argument 'sp' missing.") 25 | if (!inherits(sp, "STI")) 26 | stop("Argument 'sp' must be of class 'STI'.") 27 | 28 | if (is.null(self$getSpatialMesh())) 29 | stop("Mesh must be defined first.") 30 | if (is.null(self$getSPDE())) 31 | stop("Spatial prior must be defined first.") 32 | if (is.null(self$covariatesModel)) 33 | stop("Covariates model must be defined first.") 34 | #if (missing(coordinates)) coordinates <- model$getSpatialMesh()$getKnots() 35 | 36 | dataList <- list(response = response) 37 | if (!missing(offset)) dataList$E <- offset / self$getOffsetScale() 38 | if (!is.null(self$getLinkFunction())) dataList$link <- self$getLinkFunction() 39 | 40 | coordinates <- self$scaleCoordinates(sp::coordinates(sp)) 41 | if (!missing(covariates)) SpaceTimeModels::assertCompleteCovariates(self$covariatesModel, covariates) 42 | if (length(SpaceTimeModels::getCovariateNames(self$covariatesModel)) > 0 && missing(covariates)) 43 | stop("Covariates specified in the model but argument 'covariates' missing.") 44 | modelMatrix <- SpaceTimeModels::getINLAModelMatrix(self$covariatesModel, covariates) 45 | 46 | time <- time(sp) 47 | timeIndex <- time - min(time) + 1 48 | nTime <- length(unique(timeIndex)) 49 | 50 | n <- self$getSpatialMesh()$getNumNodes() 51 | fieldIndex <- INLA::inla.spde.make.index("spatial", n.spde = self$getSPDE()$n.spde, n.repl = nTime) 52 | A <- INLA::inla.spde.make.A(self$getSpatialMesh()$getINLAMesh(), loc = coordinates, index = index, repl = timeIndex) 53 | 54 | effects <- if (self$hasIntercept()) list(c(fieldIndex, list(intercept = 1))) else list(fieldIndex) 55 | AList <- if (!is.null(modelMatrix)) { 56 | effects[[2]] <- modelMatrix 57 | list(A, 1) 58 | } 59 | else list(A) 60 | 61 | self$addStack(data = dataList, A = AList, effects = effects, tag = tag) 62 | 63 | return(invisible(self)) 64 | }, 65 | 66 | addPredictionStack = function(sp, tag = "pred") { 67 | if (missing(sp)) 68 | stop("Required argument 'sp' missing.") 69 | if (!inherits(sp, "STI")) 70 | stop("Argument 'sp' must be of class 'STI'.") 71 | 72 | dataList <- list(response = NA) 73 | if (!is.null(self$getLinkFunction())) dataList$link <- self$getLinkFunction() 74 | 75 | coordinates <- self$scaleCoordinates(sp::coordinates(sp)) 76 | nTime <- length(unique(time(sp))) 77 | fieldIndex <- INLA::inla.spde.make.index("spatial", n.spde = self$getSPDE()$n.spde, n.repl = nTime) 78 | effects <- if (self$hasIntercept()) list(c(fieldIndex, list(intercept = 1))) else list(c(fieldIndex)) 79 | AList <- list(1) 80 | 81 | self$addStack(data = dataList, A = AList, effects = effects, tag = tag) 82 | 83 | return(invisible(self)) 84 | }, 85 | 86 | summary = function() { 87 | if (is.null(self$result)) 88 | stop("The model has not been estimated.") 89 | summary(self$result) 90 | } 91 | 92 | ) 93 | ) -------------------------------------------------------------------------------- /R/SpaceModel.R: -------------------------------------------------------------------------------- 1 | #' @import R6 2 | #' @author Jussi Jousimo \email{jvj@@iki.fi} 3 | #' @exportClass SpaceModel 4 | #' @export SpaceModel 5 | #' @keywords internal 6 | SpaceModel <- R6::R6Class( 7 | "SpaceModel", 8 | lock_objects = FALSE, 9 | public = list( 10 | offsetScale = 1, 11 | covariatesModel = NULL, 12 | linearModel = NULL, 13 | likelihood = "gaussian", 14 | link = NULL, 15 | result = NULL, 16 | 17 | getRandomEffectTerm = function() { 18 | stop("Unimplemented abstract method 'getRandomEffect'.") 19 | }, 20 | 21 | initialize = function(offsetScale = 1, ...) { 22 | self$offsetScale <- offsetScale 23 | }, 24 | 25 | getDistanceUnit = function() return(distanceUnit), 26 | getOffsetScale = function() return(self$offsetScale), 27 | getLikelihood = function() return(self$likelihood), 28 | getLinkFunction = function() return(self$link), 29 | getLinearModel = function() return(self$linearModel), 30 | getResult = function() return(self$result), 31 | 32 | setCovariatesModel = function(covariatesModel, covariates) { 33 | stop("Unimplemented abstract method 'setCovariatesModel'.") 34 | }, 35 | 36 | setSmoothingModel = function() { 37 | return(self$setCovariatesModel(~ 1)) 38 | }, 39 | 40 | setLikelihood = function(likelihood) { 41 | if (missing(likelihood)) 42 | stop("Required argument 'likelihood' missing.") 43 | if (!inherits(likelihood, "character")) 44 | stop("Argument 'likelihood' must be of type 'character.") 45 | self$likelihood <- likelihood 46 | return(invisible(self)) 47 | }, 48 | 49 | setLinkFunction = function(link) { 50 | if (missing(link)) 51 | stop("Required argument 'link' missing.") 52 | if (!inherits(link, "character")) 53 | stop("Argument 'link' must be of type 'character.") 54 | self$link <- link 55 | return(invisible(self)) 56 | }, 57 | 58 | estimate = function(verbose = T) { 59 | stop("Unimplemented abstract method 'estimate'.") 60 | }, 61 | 62 | save = function(fileName) { 63 | save(self, file = fileName) 64 | return(invisible(self)) 65 | }, 66 | 67 | load = function(fileName) { 68 | load(fileName, env = self) 69 | return(invisible(self)) 70 | #tempEnv <- new.env() 71 | #load(fileName, env = tempEnv) 72 | #return(invisible(tempEnv$self)) 73 | }, 74 | 75 | summary = function() { 76 | print(summary(self$getResult())) 77 | return(invisible(self)) 78 | }, 79 | 80 | getObserved = function(tag = "obs") { 81 | stop("Unimplemented abstract method 'getFittedObserved'.") 82 | }, 83 | 84 | getFittedResponse = function(tag = "obs") { 85 | stop("Unimplemented abstract method 'getFittedResponse'.") 86 | }, 87 | 88 | getFittedLinearPredictor = function(tag = "obs") { 89 | stop("Unimplemented abstract method 'getFittedLinearPredictor'.") 90 | }, 91 | 92 | getFittedSpatialEffect = function() { 93 | data <- list() 94 | data$spatialMean <- self$getResult()$summary.random$spatial$mean 95 | data$spatialSd <- self$getResult()$summary.random$spatial$sd 96 | return(as.data.frame(data)) 97 | }, 98 | 99 | getSpatialVariationRaster = function(variable = "mean", template = self$getSpatialMesh()$getKnots(), height = 100, width = 100, crs = self$getSpatialMesh()$getCRS(), tag = "pred") { 100 | predictions <- as.matrix(self$getFittedResponse(variable = variable, tag = tag)) 101 | r <- SpaceTimeModels::SpaceTimeRaster$new(x = template, height = height, width = width, crs = crs) 102 | r$project(self$getSpatialMesh(), predictions) 103 | return(r) 104 | }, 105 | 106 | plotSpatialVariation = function(variable = "mean", xlim, ylim, dims, tag = "pred") { 107 | str <- self$getSpatialVariationRaster(variable = variable, tag = tag) 108 | p <- rasterVis::gplot(str$getLayer(1)) + ggplot2::geom_raster(aes(fill = value)) 109 | return(p) 110 | } 111 | ) 112 | ) 113 | -------------------------------------------------------------------------------- /R/SpaceTimeRaster.R: -------------------------------------------------------------------------------- 1 | #' @title Space-time raster 2 | #' @description Class to hold space time rasters. 3 | #' @usage NULL 4 | #' @format NULL 5 | #' @import R6 6 | #' @author Jussi Jousimo \email{jvj@@iki.fi} 7 | #' @exportClass SpaceTimeRaster 8 | #' @export SpaceTimeRaster 9 | SpaceTimeRaster <- R6::R6Class( 10 | "SpaceTimeRaster", 11 | lock_objects = FALSE, 12 | public = list( 13 | template = raster::raster(), 14 | layers = raster::stack(), 15 | 16 | initialize = function(x, height = 180, width = 360, crs) { 17 | if (!missing(x)) { 18 | self$template <- if (inherits(x, "Extent")) raster::raster(x, nrows = height, ncols = width, crs = crs) 19 | else if (inherits(x, "Spatial")) raster::raster(raster::extent(x), nrows = height, ncols = width, crs = x@proj4string) 20 | else if (inherits(x, "RasterLayer")) x 21 | else stop("Parameter 'extent' must be of class 'raster::Raster', 'raster::Extent', 'sp::Spatial' or descedant.") 22 | } 23 | }, 24 | 25 | setLayers = function(layers) { 26 | self$layers <- layers 27 | invisible(self) 28 | }, 29 | 30 | addLayer = function(layer) { 31 | self$layers <- raster::addLayer(self$layers, layer) 32 | invisible(self) 33 | }, 34 | 35 | getLayer = function(index) { 36 | if (index < 1 || index > raster::nlayers(self$layers)) 37 | stop("Parameter 'index' is out of range.") 38 | return(self$layers[[index]]) 39 | }, 40 | 41 | getLayers = function() return(self$layers), 42 | getCellArea = function() return(prod(raster::res(self$layers))), 43 | 44 | scaleCells = function(w) { 45 | self$setLayers(self$getLayers() * w) 46 | return(invisible(self)) 47 | }, 48 | 49 | project = function(mesh, predictions, timeLabels, scale = 1) { 50 | if (missing(mesh)) stop("Required parameter 'mesh' missing.") 51 | if (missing(predictions)) stop("Required parameter 'predictions' missing.") 52 | 53 | inlaMesh <- if (inherits(mesh, "Mesh")) mesh$getINLAMesh() 54 | #else stop("Parameter 'mesh' must be of type 'SpaceTimeModels::Mesh'.") 55 | else if (inherits(mesh, "inla.mesh")) mesh 56 | else stop("Parameter 'mesh' must be of type 'SpaceTimeModels::Mesh' or 'INLA::inla.mesh'.") 57 | 58 | scale <- ifelse(inherits(mesh, "Mesh"), 1 / mesh$getScale(), scale) 59 | #scale <- 1 / mesh$getScale() 60 | projector <- INLA::inla.mesh.projector(inlaMesh, 61 | dims = c(raster::ncol(self$template), raster::nrow(self$template)), 62 | xlim = c(raster::xmin(self$template), raster::xmax(self$template)) * scale, 63 | ylim = c(raster::ymin(self$template), raster::ymax(self$template)) * scale) 64 | 65 | if (!inherits(predictions, "matrix")) stop("Parameter 'predictions' must be of type 'matrix'.") 66 | 67 | timeLabels <- if (missing(timeLabels)) paste0("t", 1:ncol(predictions)) else timeLabels 68 | 69 | for (i in 1:ncol(predictions)) { 70 | projection <- INLA::inla.mesh.project(projector, predictions[,i]) 71 | raster::values(self$template) <- t(projection[,ncol(projection):1]) 72 | names(self$template) <- timeLabels[i] 73 | self$addLayer(self$template) 74 | } 75 | 76 | invisible(self) 77 | }, 78 | 79 | getColorBreaks = function(n = 6) { 80 | vmin <- min(raster::minValue(self$layers), na.rm = TRUE) 81 | vmax <- max(raster::maxValue(self$layers), na.rm = TRUE) 82 | return(seq(vmin, vmax, length.out = n)) 83 | } 84 | ) 85 | ) 86 | -------------------------------------------------------------------------------- /R/SpatialMesh.R: -------------------------------------------------------------------------------- 1 | #' @title 2D mesh 2 | #' @description Constructs 2D mesh. 3 | #' @references Lindgren, F. & Rue, H. (2015). Bayesian Spatial Modelling with R-INLA. Journal of Statistical Software, 63(19). 4 | #' @usage NULL 5 | #' @format NULL 6 | #' @import R6 7 | #' @author Jussi Jousimo \email{jvj@@iki.fi} 8 | #' @exportClass SpatialMesh 9 | #' @export SpatialMesh 10 | SpatialMesh <- R6::R6Class( 11 | "SpatialMesh", 12 | lock_objects = FALSE, 13 | inherit = SpaceTimeModels::Mesh, 14 | public = list( 15 | construct = function(cutoff = NULL, maxEdge = NULL, offset = NULL, minAngle = NULL, locDomain = NULL) { 16 | if (missing(cutoff)) 17 | stop("Required argument 'cutoff' missing.") 18 | if (missing(maxEdge)) 19 | stop("Required argument 'maxEdge' missing.") 20 | if (!is.null(locDomain) && !inherits(locDomain, "SpatialPoints")) 21 | stop("Argument 'locDomain' must be of class SpatialPoints.") 22 | 23 | meshCoordinates <- self$getMeshKnots() 24 | locDomain <- if (!is.null(locDomain)) SpaceTimeModels::nullScale(sp::coordinates(locDomain), self$getScale()) else NULL 25 | self$mesh <- INLA::inla.mesh.2d(loc = meshCoordinates, 26 | loc.domain = locDomain, 27 | cutoff = SpaceTimeModels::nullScale(cutoff, self$getScale()), 28 | max.edge = SpaceTimeModels::nullScale(maxEdge, self$getScale()), 29 | offset = SpaceTimeModels::nullScale(offset, self$getScale()), 30 | min.angle = minAngle) 31 | }, 32 | 33 | initialize = function(..., cutoff = NULL, maxEdge = NULL, offset = NULL, minAngle = NULL, locDomain = NULL) { 34 | super$initialize(...) 35 | self$construct(cutoff = cutoff, maxEdge = maxEdge, offset = offset, minAngle = minAngle, locDomain = locDomain) 36 | } 37 | ) 38 | ) 39 | -------------------------------------------------------------------------------- /R/utilities.R: -------------------------------------------------------------------------------- 1 | #' @export findScale 2 | #' @keywords internal 3 | findScale <- function(x) max(10^floor(log10(abs(x))), 1) 4 | 5 | #' @export nullScale 6 | #' @keywords internal 7 | nullScale <- function(x, y) { 8 | if (is.null(x)) return(NULL) 9 | return(x / y) 10 | } 11 | 12 | #' @export getCovariateNames 13 | #' @keywords internal 14 | getCovariateNames = function(covariatesModel, covariates) { 15 | x <- if (missing(covariates) || is.null(covariates)) terms(covariatesModel) 16 | else terms(covariatesModel, data = covariates) 17 | y <- attr(x, "term.labels") 18 | if (any(stringr::str_detect(y, "`"))) 19 | stop("Covariate names with backticks unsupported.") 20 | return(y) 21 | } 22 | 23 | #' @export getINLAModelMatrix 24 | #' @keywords internal 25 | getINLAModelMatrix = function(covariatesModel, covariates) { 26 | if (missing(covariatesModel) || is.null(covariatesModel)) 27 | stop("Required argument 'covariatesModel' missing.") 28 | 29 | covariateNames <- SpaceTimeModels::getCovariateNames(covariatesModel, covariates) 30 | if (length(covariateNames) > 0) { 31 | if (missing(covariates) || is.null(covariates)) 32 | stop("Covariates data do not match with covariates model.") 33 | 34 | modelMatrix <- as.data.frame(model.matrix(covariatesModel, data = covariates)) 35 | termNames <- colnames(modelMatrix) 36 | interceptIndex <- termNames %in% "(Intercept)" 37 | if (any(interceptIndex)) { 38 | termNames <- termNames[!interceptIndex] 39 | modelMatrix <- modelMatrix[,!interceptIndex, drop = F] 40 | } 41 | 42 | if (any(is.na(modelMatrix))) 43 | stop("Covariates contain missing values which are not allowed.") 44 | 45 | return(modelMatrix) 46 | } 47 | else return(NULL) 48 | } 49 | 50 | #' @export summaryINLAParameter 51 | #' @keywords internal 52 | summaryINLAParameter <- function(marginal, fun = identity, coordinatesScale = 1) { 53 | m <- inla.tmarginal(function(x) fun(x) * coordinatesScale, marginal) 54 | e <- inla.emarginal(function(x) x, m) 55 | e2 <- inla.emarginal(function(x) x^2, m) 56 | sd <- sqrt(e2 - e^2) 57 | q <- inla.qmarginal(c(0.025, 0.5, 0.975), m) 58 | mode <- inla.mmarginal(m) 59 | x <- data.frame(e = e, sd = sd, q1 = q[1], q2 = q[2], q3 = q[3], mode = mode) 60 | colnames(x) <- c("mean", "sd", "0.025quant","0.5quant","0.975quant", "mode") 61 | return(x) 62 | } 63 | 64 | #' @export assertCompleteCovariates 65 | #' @keywords internal 66 | assertCompleteCovariates <- function(covariatesModel, covariates) { 67 | #if (inherits(covariates, "STIDF") == FALSE) 68 | # stop("Covariates must be of class STIDF or a subclass.") 69 | x <- terms(covariatesModel, data = covariates) 70 | #complete <- complete.cases(covariates@data[,attr(x, "term.labels"), drop = F]) 71 | #complete <- complete.cases(covariates[,attr(x, "term.labels"), drop = F]) 72 | complete <- complete.cases(covariates[,SpaceTimeModels::getCovariateNames(x), drop = F]) 73 | if (any(complete == FALSE)) 74 | stop("Covariates cannot contain missing data.") 75 | } 76 | 77 | #' @export theme_raster 78 | theme_raster <- function(base_size = 12, base_family = "", ...) { 79 | theme_minimal(base_size = base_size, base_family = base_family) %+replace% 80 | theme( 81 | panel.background = element_rect(fill = "transparent", colour = NA), 82 | panel.grid.minor = element_blank(), 83 | panel.grid.major = element_blank(), 84 | plot.background = element_rect(fill = "transparent", colour = NA), 85 | panel.border = element_blank(), 86 | panel.margin = unit(0, "lines"), 87 | axis.line = element_blank(), 88 | axis.text.x = element_blank(), 89 | axis.text.y = element_blank(), 90 | axis.title.x = element_blank(), 91 | axis.title.y = element_blank(), 92 | axis.ticks = element_blank(), 93 | strip.background = element_blank(), 94 | #plot.margin = unit(c(0, 0, -1, -1), "lines"), 95 | #plot.margin = unit(c(0, 0, -.5, -.5), "lines"), 96 | plot.margin = unit(c(0, 0, 0, 0), "lines"), 97 | #axis.ticks.length = unit(0, "lines"), axis.ticks.margin = unit(0, "lines"), 98 | #plot.margin = rep(unit(0, "null"), 4), panel.margin = unit(0, "null"), axis.ticks.length = unit(0, "null"), axis.ticks.margin = unit(0, "null"), 99 | legend.position = "none", 100 | ... 101 | ) 102 | } 103 | 104 | # Taken from http://www.math.ntnu.no/inla/r-inla.org/papers/jss/lindgren.pdf 105 | #' @export local.inla.spde2.matern.default 106 | #' @keywords internal 107 | local.inla.spde2.matern.default <- function(mesh, sigma0, range0) { 108 | #sigma0 = 1 109 | #if (missing(range0)) { 110 | # size = min(c(diff(range(mesh$loc[, 1])), diff(range(mesh$loc[, 2])))) 111 | # range0 = size / 5 112 | #} 113 | kappa0 = sqrt(8) / range0 114 | tau0 = 1 / (sqrt(4 * pi) * kappa0 * sigma0) 115 | spde = inla.spde2.matern(mesh, 116 | B.tau = cbind(log(tau0), -1, +1), 117 | B.kappa = cbind(log(kappa0), 0, -1), 118 | theta.prior.mean = c(0, 0), 119 | theta.prior.prec = c(0.1, 1) ) 120 | return(invisible(spde)) 121 | } 122 | 123 | # Taken from https://groups.google.com/forum/#!topic/r-inla-discussion-group/cPU0iJA2UqY 124 | #' @export local.inla.spde2.matern.new 125 | #' @keywords internal 126 | # - YOU MUST SET rho0 , e.g. to half the length/width of your space 127 | # - You may reduce sig0 to have less spatial effect 128 | # - You may increase rho0 additionally, to make the spatial effect smoother 129 | local.inla.spde2.matern.new <- function(mesh, alpha=2, prior.pc.rho, prior.pc.sig) { 130 | # Call inla.spde2.matern with range and standard deviation parametrization 131 | d = INLA:::inla.ifelse(inherits(mesh, "inla.mesh"), 2, 1) 132 | nu = alpha-d/2 133 | kappa0 = log(8*nu)/2 134 | tau0 = 0.5*(lgamma(nu)-lgamma(nu+d/2)-d/2*log(4*pi))-nu*kappa0 135 | spde = inla.spde2.matern(mesh = mesh, 136 | B.tau = cbind(tau0, nu, -1), 137 | B.kappa = cbind(kappa0, -1, 0)) 138 | 139 | # Change prior information 140 | param = c(prior.pc.rho, prior.pc.sig) 141 | spde$f$hyper.default$theta1$prior = "pcspdega" 142 | spde$f$hyper.default$theta1$param = param 143 | spde$f$hyper.default$theta1$initial = log(prior.pc.rho[1])+1 144 | spde$f$hyper.default$theta2$initial = log(prior.pc.sig[1])-1 145 | 146 | # End and return 147 | return(invisible(spde)) 148 | } 149 | -------------------------------------------------------------------------------- /README.md: -------------------------------------------------------------------------------- 1 | --- 2 | output: pdf_document 3 | --- 4 | [PDF](https://github.com/statguy/SpaceTimeModels/blob/master/README.pdf) (Please view the PDF to see 5 | the equations properly.) 6 | 7 | # SpaceTimeModels - An R package for fitting parametric spatial and spatio-temporal models with INLA 8 | 9 | ## Introduction 10 | 11 | The `SpaceTimeModels` [R](http://www.r-project.org/) package provides a simplified interface for parametrizing 12 | a few "standard" spatial and spatio-temporal models with [R-INLA](http://www.r-inla.org/). The models enable 13 | parametric (ie. the unknown parameters are estimated from the data) smoothing over space and time and 14 | quantifying effect of covariates on response. 15 | 16 | ### Autocorrelation 17 | 18 | Things close in space and time often resemble each other. We can observe this e.g. in nature where 19 | large scale processes such as climate and geomorphic processes shape biological processes. For example, 20 | coniferous trees have been adapted to cool climate and found more than deciduous that are more 21 | prevalent in warm climate conditions. 22 | Due to dependencies in the underlying processes, measurements obtained close to each other tend to 23 | predict each other better than distant ones. This degree of similarity is known as autocorrelation, 24 | i.e. the correlation within a process itself. 25 | 26 | From the statistical modelling point of view, dependency in data can cause estimates obtained 27 | from a model with assumed indepedence to be biased, e.g. the model provides too small p-values. 28 | Several approaches for spatial and spatio-temporal data have been developed to take autocorrelation 29 | properly into account. 30 | 31 | Since there often are no repeated measurements available that would allow estimating autocorrelation 32 | structure directly, several assumptions are made. These often include specifying a neighborhood 33 | structure (e.g. the observations depend on each other as a function of distance), stationarity 34 | (variance is constant across space/time) and isotropy (independence of direction in space). 35 | 36 | ### Discrete and continuous data 37 | 38 | Data in space and time can be indexed in several ways. Discrete data is defined in a subset of 39 | specific values such as time in years indexed $t=1, 2, \dots, T$ or areas $s=1, 2, \dots, S$ 40 | separated by boundaries. Continous data is index by any values within a range such as $t\in[1,T]$, 41 | where there are infinitely many time points within this range. Similarly, continuous space has 42 | infinitely many locations enclosed by some boundary (like a study area) $\Omega$, i.e. 43 | $s\in\Omega$. The package provides model classes for combinations of discrete and continuous data 44 | for space and time. 45 | 46 | ### Models 47 | 48 | The following model classes are currently implemented in the package: 49 | 50 | * `DiscreteSpaceModel` for discrete spatial data 51 | * `ContinuousSpaceModel` for continuous spatial data 52 | * `ContinuousSpaceDiscreteTimeModel` for continuous spatial and discrete temporal data 53 | * `ContinuousSpaceContinuousTimeModel` for continuous spatial and continuous temporal data 54 | 55 | ### Continuous models 56 | 57 | Specifying continuous models require specifying an estimation mesh. Estimates are provided at 58 | the mesh nodes and estimates at the observation or prediction locations are interpolated from 59 | the node estimates. A higher number of nodes improves the estimation results, but increases 60 | computational time. 61 | 62 | The following mesh classes are currently implemented in the package: 63 | 64 | * `TemporalMesh` for temporal data 65 | * `SpatialMesh` for spatial data 66 | * `NonConvexHullMesh` for spatial data for creating a non-convex hull around the observations 67 | 68 | The continuous spatial models assume that dependencies between the mesh nodes are specified as 69 | a function of distance with unknown scale and variance parameters to be estimated from the data. 70 | The function is of Matérn class, described in more detail in 71 | [the reference](http://www.math.ntnu.no/inla/r-inla.org/papers/jss/lindgren.pdf). 72 | 73 | ### Discrete models 74 | 75 | Discrete models are specified with a neighborhood structure. For time, it is often assumed 76 | that the current time point $t$ depends on the previous time point $t-1$ in some fashion. 77 | For example, the autoregressive model is of the form $y_t = \phi y_{t-1} + \epsilon$, 78 | where $\phi$ is the degree of dependency between subsequent observations and $\epsilon$ 79 | is the zero-centered Gaussian error term. 80 | 81 | Regions are typically considered neighbors if they share the same border or are within 82 | certain radius from the centre points. 83 | 84 | Please refer to the R-INLA [documentation](http://www.r-inla.org/models/latent-models) for more 85 | details of the autoregressive and the Besag models. 86 | 87 | ## Installation 88 | 89 | Test version of R-INLA is required to be installed first, see [here](http://www.r-inla.org/download) for 90 | the installation instructions. The `SpaceTimeModels` package is installed with the `devtools` package using 91 | the commands 92 | ``` 93 | library(devtools) 94 | devtools::install_github("statguy/SpaceTimeModels") 95 | ``` 96 | Additional packages are installed automatically from CRAN if needed. The package will be ready to use with 97 | the command `library(SpaceTimeModels)`. 98 | 99 | ## Usage 100 | 101 | The assembly line for constructing the models is the following: 102 | 103 | 1. Create model object. 104 | 2. Specify mesh for continuous spatial models / Specify the neighborhood structure for discrete spatial models. 105 | 3. Specify priors for space and time components. If omitted, default priors are used. 106 | 4. Specify covariates or intercept only (smoothing-only model). 107 | 5. Add 108 | + Add observation locations, time points, observed responses and covariates 109 | + Add validation locations, time points and covariates 110 | + Add prediction locations, time points and covariates 111 | 6. Specify likelihood. If omitted, Gaussian likelihood is used as default. 112 | 113 | Once the model is specified, the unknown parameters are ready to be estimated. Once the model is estimated, 114 | the results can be extract from the model object. 115 | 116 | ### Continuous models 117 | 118 | #### Model object 119 | 120 | Objects are created with the `new()` method (constructor), for example, the model object 121 | ``` 122 | model <- SpaceTimeModels::ContinuousSpaceDiscreteTimeModel$new() 123 | ``` 124 | 125 | #### Coordinates 126 | 127 | Due to numerical accuracy, spatial coordinates may need to be scaled down. For example, if the coordinates 128 | are such that $x=6100000$ and $y=50000$, $1000000$ should be added to $y$ to "match" with $x$. Furthermore, 129 | the coordinates should be scaled, e.g., by dividing by $1000000$ and thus obtaining $x=6.1$ and $y=1.05$, 130 | which INLA handles better. 131 | 132 | #### Spatial mesh creation 133 | 134 | Spatial mesh object is obtained, for example, with 135 | ``` 136 | mesh <- SpaceTimeModels::SpatialMesh$new(knots=knots, locDomain=borders, offset=c(10, 140), maxEdge=c(50, 1000), minAngle=c(26, 21), cutoff=0) 137 | ``` 138 | where `knots` provides coordinates for constructing the mesh. The `knots` object must be class of `SpatialPoints` 139 | from the `sp` package. Rest of the arguments specify topology of the mesh and are specific to type of the mesh. 140 | The arguments affect, for example, number of the nodes in the mesh. 141 | The mesh is found by a triangulation over the study area and the process should be completed rather quickly. 142 | However, the triangulation gets stuck sometimes and the INLA triangulation process or R has to be 143 | force-terminated (killed). 144 | A set of suitable mesh parameters is often found through iteration. It is adviced to run the models 145 | with a small number of mesh nodes first, especially with the spatio-temporal models, which may take 146 | relatively long time to estimate with large meshes. 147 | 148 | The mesh parameters are listed in the help (which is obtained with R command `?x` 149 | where `x` is the class name, e.g. `?NonConvexHullMesh`) and explained in more detail in 150 | [the reference](http://www.math.ntnu.no/inla/r-inla.org/papers/jss/lindgren.pdf), which the reader 151 | is adviced to go through. 152 | 153 | The command `mesh$plot()` plots the mesh with the observation locations. 154 | Once created, the mesh is supplied for the model object with 155 | ``` 156 | model$setSpatialMesh(mesh) 157 | ``` 158 | 159 | #### Smoothing and covariate models 160 | 161 | Smoothing or intercept-only model can be specified with the `setSmoothingModel()` method, 162 | which includes only an intercept and a spatial or spatio-temporal random effect in the model. 163 | Such models provide smoothed observations filtered from noise occuring in space (and time). 164 | Smoothing can be accomplised with e.g. kernel estimators as well. However, spatial scale 165 | is usually left to be specified by hand for the unparametric methods. 166 | 167 | To estimate the effect of covariates, the models provide the `setCovariatesModel` method, 168 | which takes the following arguments: 169 | 170 | * `covariatesModel` specifying right-sided equation of the covariates to be included in the model. 171 | * `covariates` specifying the covariates data frame. 172 | 173 | For example 174 | ``` 175 | model$setCovariatesModel(covariatesModel = ~ a + b, covariates = covariates) 176 | ``` 177 | 178 | To view the full specification of the linear part of the model, use the `getLinearModel()` method. 179 | This will also print the random effect term as supplied to R-INLA. 180 | The part for the covariates differs from the specified for the categorial variables (factors) 181 | as they are replaced by corresponding dummy variables. The dummy variables appear also in the 182 | results. 183 | 184 | #### Data stacks 185 | 186 | Observation, validation and prediction data is supplied in chunks that are tagged and stacked. 187 | Such design allows indexing the data so that the chunks can be later referenced by the tags. 188 | The chunks consist of coordinates, time indices (for spatio-temporal models), covariates (optional) 189 | and the observations for the observation chunk. The observations consist of responses and optionally 190 | offsets for count data. The following methods specify the data: 191 | 192 | - `addObservationStack` 193 | - `addValidationStack` 194 | - `addPredictionStack` 195 | 196 | For spatio-temporal data, each of the methods take in the `sp` argument, which must be of class 197 | `STI` or `STIDF` from the `spacetime` package. For spatial data, the `sp` argument must be provided 198 | with an object of class `SpatialPoints` or `SpatialPointsDataFrame` from the `sp` package. 199 | 200 | For example 201 | ``` 202 | model$addObservationStack(sp=obs, response=obs@data$response, offset=obs@data$offset, covariates=obs@data, tag="obs") 203 | model$addValidationStack(sp=val, covariates=val@data, tag="val") 204 | model$addPredictionStack(sp=pred, covariates=pred@data, tag="pred") 205 | ``` 206 | 207 | TODO 208 | 209 | #### Priors 210 | 211 | TODO 212 | 213 | ### Discrete models 214 | 215 | TODO 216 | 217 | #### Priors 218 | 219 | TODO 220 | 221 | ### Likelihood 222 | 223 | The models support various types of response data such as continuous (Gaussian), binary (binomial) and count (Poisson). 224 | The response data type is specified with 225 | ``` 226 | model$setLikelihood("x") 227 | ``` 228 | where `x` is the selected likelihood. Please refer to the [R-INLA documentation](http://www.r-inla.org/models/likelihoods) 229 | for all supported likelihoods. 230 | When using count data likelihoods such as binomial and Poisson, the offset term is supplied 231 | for the stack methods method via the `offset` argument. Otherwise the offset is assumed 232 | to equal to 1. See the section Data stacks. 233 | 234 | TODO: offset argument for discrete models etc. 235 | 236 | ### Estimation 237 | 238 | Once the data and the model are specified, estimation is started with the `estimate()` method. 239 | Argument `verbose=TRUE` is recommended to be supplied to follow progress of the estimation. 240 | Note that the spatio-temporal models may take considerable amount of time and memory to 241 | be estimated. 242 | 243 | ### Extracting results 244 | 245 | The following methods provide basic summaries of the estimated models 246 | 247 | * `summary()` for overall summary of the model. 248 | * `summarySpatialParameters()` for summary of the spatial parameters. 249 | 250 | To access the R-INLA result object directly, `getResult()` method is provided. 251 | 252 | ### Model selection 253 | 254 | Model selection can be performed with the same model object by respecifying the covariate model. However, 255 | for the continuous models the data stack needs to be reconstructed by first issuing the `clearStack()` 256 | method and then repeating the `add*Stack()` methods before estimation. The `summary()` method provides the 257 | [WAIC](http://www.stat.columbia.edu/~gelman/research/published/waic_understand3.pdf) measure for the model selection. 258 | 259 | ### Saving and restoring model object 260 | 261 | Model object can be saved using the standard `save(model, file = fileName)` command to a file pointed by 262 | `fileName`. Previously saved state can be restored from a file using the `load(fileName)` command. 263 | Note that if you have updated the `SpaceTimeModels` package in between, the restored object has the 264 | properties of the old one. 265 | 266 | ## Examples 267 | 268 | * [Cameletti et al. (2012)](http://www.r-inla.org/examples/case-studies/cameletti-et-al) reproduced with 269 | the `SpaceTimeModels` package, [link](https://github.com/statguy/SpaceTimeModels/blob/master/inst/tests/tests1.R). 270 | 271 | ## References and other supporting material 272 | 273 | * [Lindgren, F., Rue, H. (2015). Bayesian Spatial Modelling with R-INLA. Journal of Statistical Software.](http://www.math.ntnu.no/inla/r-inla.org/papers/jss/lindgren.pdf) 274 | * [Cameletti, M., Lindgren, F., Simpson, D., Rue, H. (2012). Spatio-temporal modeling of particulate matter concentration through the SPDE approach. AStA Advances in Statistical Analysis.](http://www.math.ntnu.no/~daniesi/Cameletti_et_al_submitted.pdf) 275 | * [Krainski, E.T., Lindgren, F., Simpson, D., Rue, H. The R-INLA tutorial on SPDE models.](http://www.math.ntnu.no/inla/r-inla.org/tutorials/spde/spde-tutorial.pdf) 276 | * [Gelman, A., Hwang, J., Vehtari, A. (2013). Understanding predictive information criteria for Bayesian models. Statistics and Computing.](http://www.stat.columbia.edu/~gelman/research/published/waic_understand3.pdf) 277 | 278 | ## Contact 279 | 280 | Jussi Jousimo, 281 | -------------------------------------------------------------------------------- /README.pdf: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/statguy/SpaceTimeModels/875d7c726b7e09946f4cdb9cb27cd71dc8c0aa90/README.pdf -------------------------------------------------------------------------------- /SpaceTimeModels.Rproj: -------------------------------------------------------------------------------- 1 | Version: 1.0 2 | 3 | RestoreWorkspace: Default 4 | SaveWorkspace: Default 5 | AlwaysSaveHistory: Default 6 | 7 | EnableCodeIndexing: Yes 8 | UseSpacesForTab: Yes 9 | NumSpacesForTab: 2 10 | Encoding: UTF-8 11 | 12 | RnwWeave: Sweave 13 | LaTeX: pdfLaTeX 14 | 15 | BuildType: Package 16 | PackageUseDevtools: Yes 17 | PackageInstallArgs: --no-multiarch --with-keep.source 18 | PackageRoxygenize: rd,collate,namespace 19 | -------------------------------------------------------------------------------- /inst/tests/tests1.R: -------------------------------------------------------------------------------- 1 | # Test the ContinuousSpaceDiscreteTimeModel class with Cameletti et al. (2012) data and model 2 | 3 | library(SpaceTimeModels) 4 | 5 | # Download data 6 | Piemonte_data <- read.csv("http://www.math.ntnu.no/inla/r-inla.org/case-studies/Cameletti2012/Piemonte_data_byday.csv", header = TRUE, sep = ",") 7 | coordinates <- read.csv("http://www.math.ntnu.no/inla/r-inla.org/case-studies/Cameletti2012/coordinates.csv", header = TRUE, sep = ",") 8 | borders <- read.table("http://www.math.ntnu.no/inla/r-inla.org/case-studies/Cameletti2012/Piemonte_borders.csv", header = TRUE, sep = ",") 9 | Piemonte_data_validation <- read.table("http://www.math.ntnu.no/inla/r-inla.org/case-studies/Cameletti2012/Piemonte_data_byday_validation.csv", header = TRUE, sep = ",") 10 | coordinates_validation <- read.table("http://www.math.ntnu.no/inla/r-inla.org/case-studies/Cameletti2012/coordinates_validation.csv", header = TRUE, sep = ",") 11 | rownames(coordinates) <- coordinates[,"Station.ID"] 12 | rownames(coordinates_validation) <- coordinates_validation[,"Station.ID"] 13 | 14 | # Prepare data 15 | n_stations <- length(coordinates$Station.ID) 16 | n_stations_val <- length(coordinates_validation$Station.ID) 17 | n_data <- length(Piemonte_data$Station.ID) 18 | n_days <- as.integer(n_data/n_stations) 19 | Piemonte_data$logPM10 <- log(Piemonte_data$PM10) 20 | Piemonte_data$time <- rep(1:n_days, each = n_stations) 21 | Piemonte_data_validation$logPM10 <- log(Piemonte_data_validation$PM10) 22 | Piemonte_data_validation$time <- rep(1:n_days,each=n_stations_val) 23 | 24 | mean_covariates <- apply(Piemonte_data[,3:10], 2, mean) 25 | sd_covariates <- apply(Piemonte_data[,3:10], 2, sd) 26 | Piemonte_data[,3:10] <- scale(Piemonte_data[,3:10], mean_covariates, sd_covariates) 27 | Piemonte_data_validation[,3:10] <- scale(Piemonte_data_validation[,3:10], mean_covariates, sd_covariates) 28 | 29 | # Put observations and validation points to a spatio-temporal data frame 30 | obs <- spacetime::STIDF(sp::SpatialPoints(coordinates[Piemonte_data$Station.ID, c("UTMX","UTMY")]), as.Date(Piemonte_data$Date, "%d/%m/%y"), Piemonte_data) 31 | val <- spacetime::STIDF(sp::SpatialPoints(coordinates_validation[Piemonte_data_validation$Station.ID, c("UTMX","UTMY")]), as.Date(Piemonte_data_validation$Date, "%d/%m/%y"), Piemonte_data_validation) 32 | 33 | if (F) { 34 | # Take a subset of the data for quick testing 35 | obs <- obs[,obs@time["/2005-10-05"]] 36 | val <- val[,val@time["/2005-10-05"]] 37 | nrow(obs) 38 | nrow(val) 39 | } 40 | 41 | # Build estimation mesh 42 | mesh <- SpaceTimeModels::SpatialMesh$new(knots = obs, locDomain = sp::SpatialPoints(borders), offset = c(10, 140), maxEdge = c(50, 1000), minAngle = c(26, 21), cutoff = 0) 43 | mesh$plot() 44 | 45 | # Build model 46 | formula <- ~ A + UTMX + UTMY + WS + TEMP + HMIX + PREC + EMI 47 | model <- SpaceTimeModels::ContinuousSpaceDiscreteTimeModel$new() 48 | model$setSpatialMesh(mesh) 49 | model$setSpatialPrior() 50 | #model$setSpatialPriorDefault(sigma = 1, rho = 30) 51 | #model$setTemporalPrior(model = "rw2", cyclic = TRUE) 52 | model$setTemporalPrior(model = "ar1") 53 | #model$setSmoothingModel() 54 | model$setCovariatesModel(formula, obs@data) 55 | model$setLikelihood("gaussian") 56 | model$setLinkFunction(gaussian()$link) 57 | model$addObservationStack(sp = obs, response = obs@data$logPM10, covariates = obs@data) 58 | model$addValidationStack(sp = val, covariates = val@data) 59 | model$addPredictionStack(sp = obs) 60 | 61 | # Print the linear model specification 62 | model$getLinearModel() 63 | 64 | # Estimate the model 65 | model$estimate(verbose = T) 66 | 67 | # Get a summary of the estimated parameters 68 | model$summary() 69 | model$summarySpatialParameters() 70 | 71 | # Print the observed and fitted values in time 72 | fitted.time <- model$summaryTemporalVariation(timeIndex = time(obs)) %>% 73 | tidyr::gather(variable, value, -time, observed, fitted) 74 | fitted.time %>% ggplot2::ggplot() + geom_line(aes(time, value, group = variable, colour = variable)) + theme_bw() + xlab("Time") 75 | 76 | # Plot the temporal variation 77 | model$plotTemporalVariation(timeIndex = time(obs)) 78 | 79 | # Polt the temporal variation more neatly 80 | model$summaryTemporalVariation(timeIndex = time(obs)) 81 | 82 | 83 | # Quick plot the estimates on a map 84 | model$plotSpatialVariation(timeIndex = 1) 85 | model$plotSpatialVariation(timeIndex = 2) 86 | 87 | # Plot the estimates on a map more neatly 88 | rasters <- model$getSpatialVariationRaster(template = raster::extend(raster::extent(as.matrix(borders)), 10), width = 200, height = 200) 89 | rasterVis::gplot(rasters$getLayer(1)) + ggplot2::geom_raster(aes(fill = value)) + 90 | ggplot2::geom_path(data = borders, aes(UTM_X, UTM_Y)) + 91 | ggplot2::geom_point(data = data.frame(obs@sp), aes(UTMX, UTMY)) + 92 | ggplot2::scale_fill_gradientn(colours = terrain.colors(40), guide = guide_legend(title = expression(PM[10]))) + 93 | ggplot2::coord_equal() + 94 | SpaceTimeModels::theme_raster() + 95 | ggplot2::theme(legend.position = "right", legend.title = element_text(size = 10), legend.text = element_text(size = 10)) 96 | 97 | # Validate the model 98 | validation0 <- list(p = rep(NA, length(obs$logPM10))) 99 | etaMean <- model$getFittedLinearPredictor() 100 | etaSd <- model$getFittedLinearPredictor(variable = "sd") 101 | validation0$res <- obs$logPM10 - etaMean 102 | validation0$res.std <- validation0$res / sqrt(etaSd^2 + 1 / model$getFittedHyperparameters()[1, "mean"]) 103 | validation0$p <- pnorm(validation0$res.std) 104 | 105 | validation <- list() 106 | etaMean <- model$getFittedLinearPredictor(tag = "val") 107 | etaSd <- model$getFittedLinearPredictor(variable = "sd", tag = "val") 108 | validation$res <- val$logPM10 - etaMean 109 | validation$res.std <- validation$res / sqrt(etaSd^2 + 1 / model$getFittedHyperparameters()[1, "mean"]) 110 | validation$p <- pnorm(validation$res.std) 111 | 112 | validation$rmse <- sqrt(mean(validation$res^2, na.rm = TRUE)) 113 | validation$cor <- cor(val$logPM10, etaMean, use = "pairwise.complete.obs", method = "pearson") 114 | validation$cover <- mean((validation$p > 0.025) & (validation$p < 0.975), na.rm = TRUE) 115 | 116 | validation0 117 | validation 118 | -------------------------------------------------------------------------------- /man/ContinuousSpaceDiscreteTimeModel.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/ContinuousSpaceDiscreteTimeModel.R 3 | \docType{data} 4 | \name{ContinuousSpaceDiscreteTimeModel} 5 | \alias{ContinuousSpaceDiscreteTimeModel} 6 | \title{Continuous space, discrete time model} 7 | \description{ 8 | Building and estimating discrete time, continuous space models. 9 | } 10 | \author{ 11 | Jussi Jousimo <\email{jvj@iki.fi}> 12 | } 13 | \references{ 14 | Lindgren, F. & Rue, H. (2015). Bayesian Spatial Modelling with R-INLA. Journal of Statistical Software, 63(19). 15 | } 16 | \keyword{datasets} 17 | 18 | -------------------------------------------------------------------------------- /man/ContinuousSpaceModel.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/ContinuousSpaceModel.R 3 | \docType{data} 4 | \name{ContinuousSpaceModel} 5 | \alias{ContinuousSpaceModel} 6 | \title{Continuous space model} 7 | \description{ 8 | Building and estimating continuous space models. 9 | } 10 | \author{ 11 | Jussi Jousimo \email{jvj@iki.fi} 12 | } 13 | \references{ 14 | Lindgren, F. & Rue, H. (2015). Bayesian Spatial Modelling with R-INLA. Journal of Statistical Software, 63(19). 15 | } 16 | \keyword{internal} 17 | 18 | -------------------------------------------------------------------------------- /man/NonConvexHullMesh.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/NonConvexHullMesh.R 3 | \docType{data} 4 | \name{NonConvexHullMesh} 5 | \alias{NonConvexHullMesh} 6 | \title{Non-convex hull mesh} 7 | \description{ 8 | Constructs non-convex hull mesh. 9 | } 10 | \author{ 11 | Jussi Jousimo \email{jvj@iki.fi} 12 | } 13 | \references{ 14 | Lindgren, F. & Rue, H. (2015). Bayesian Spatial Modelling with R-INLA. Journal of Statistical Software, 63(19). 15 | } 16 | \keyword{datasets} 17 | 18 | -------------------------------------------------------------------------------- /man/SpaceTimeRaster.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/SpaceTimeRaster.R 3 | \docType{data} 4 | \name{SpaceTimeRaster} 5 | \alias{SpaceTimeRaster} 6 | \title{Space-time raster} 7 | \description{ 8 | Class to hold space time rasters. 9 | } 10 | \author{ 11 | Jussi Jousimo \email{jvj@iki.fi} 12 | } 13 | \keyword{datasets} 14 | 15 | -------------------------------------------------------------------------------- /man/SpatialMesh.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/SpatialMesh.R 3 | \docType{data} 4 | \name{SpatialMesh} 5 | \alias{SpatialMesh} 6 | \title{2D mesh} 7 | \description{ 8 | Constructs 2D mesh. 9 | } 10 | \author{ 11 | Jussi Jousimo \email{jvj@iki.fi} 12 | } 13 | \references{ 14 | Lindgren, F. & Rue, H. (2015). Bayesian Spatial Modelling with R-INLA. Journal of Statistical Software, 63(19). 15 | } 16 | \keyword{datasets} 17 | 18 | --------------------------------------------------------------------------------