Merge pull request #19 from finnlindgren/main

fmesher/inlabru compatibility updates
PhilipMostert · Nov 22, 2024 · 53a56bf · 53a56bf
2 parents ea42ed2 + 788a885
commit 53a56bf
Show file tree

Hide file tree

Showing 45 changed files with 517 additions and 183 deletions.
diff --git a/.github/workflows/R-CMD-check.yaml b/.github/workflows/R-CMD-check.yaml
@@ -18,7 +18,7 @@ jobs:
       fail-fast: false
       matrix:
         config:
-          - {os: macOS-12, r: 'release'}
+          - {os: macOS-latest, r: 'release'}
           - {os: windows-latest, r: 'release'}
           - {os: ubuntu-latest, r: 'devel', http-user-agent: 'release'}
           - {os: ubuntu-latest, r: 'release'}

diff --git a/DESCRIPTION b/DESCRIPTION
@@ -1,7 +1,7 @@
 Package: PointedSDMs
 Type: Package
 Title: Fit Models Derived from Point Processes to Species Distributions using 'inlabru'
-Version: 2.1.2
+Version: 2.1.2.9000
 Authors@R: c(
   person(given = "Philip", family = "Mostert", email = "philip.s.mostert@ntnu.no",
           role = c("aut", "cre")),
@@ -19,12 +19,13 @@ Depends:
     R (>= 4.1),  
     stats,
     sf,
-    inlabru (>= 2.8.0),
+    inlabru (>= 2.12.0),
     R6 (>= 2.5),
     methods,
 Imports:
     terra,
     ggplot2,
+    fmesher,
     raster,
     sp (>= 1.4-5),
     R.devices,
@@ -36,7 +37,6 @@ Suggests:
     INLA (>= 21.08.31),
     rasterVis,
     ggmap,
-    ggpolypath,
     RColorBrewer,
     cowplot,
     knitr,
@@ -45,7 +45,7 @@ Suggests:
     spocc,
     covr
 Additional_repositories: https://inla.r-inla-download.org/R/testing
-RoxygenNote: 7.3.1
+RoxygenNote: 7.3.2
 License: GPL (>= 3)
 VignetteBuilder: knitr
 Config/testthat/edition: 3

diff --git a/R/blockedCV.R b/R/blockedCV.R
@@ -53,7 +53,7 @@ blockedCV <- function(data, options = list(),
 
   if (!inherits(data, 'dataSDM') && !inherits(data, 'specifySpecies') && !inherits(data, 'specifyISDM')) stop('data needs to be a dataSDM object.')
 
-  if (is.null(data$.__enclos_env__$private$INLAmesh)) stop('An inla.mesh object is required before any model is run.')
+  if (is.null(data$.__enclos_env__$private$INLAmesh)) stop('An fm_mesh_2d object is required before any model is run.')
 
   if (!data$.__enclos_env__$private$blockedCV) stop('Please use ".$spatialBlock" before using this function.')
 
@@ -226,12 +226,12 @@ blockedCV <- function(data, options = list(),
 
         if (!is.null(data$.__enclos_env__$private$speciesSpatial)) {
 
-        if (data$.__enclos_env__$private$speciesSpatial == 'replicate') ips <- fm_cprod(ips, data.frame(speciesSpatialGroup = 1:max(data$.__enclos_env__$private$speciesTable$index)))
+        if (data$.__enclos_env__$private$speciesSpatial == 'replicate') ips <- fmesher::fm_cprod(ips, data.frame(speciesSpatialGroup = 1:max(data$.__enclos_env__$private$speciesTable$index)))
 
         }
         if (!is.null(data$.__enclos_env__$private$Intercepts)) {
 
-          if (data$.__enclos_env__$private$speciesIntercepts) ips <- fm_cprod(ips, data.frame(specIntTermRem = 1:max(data$.__enclos_env__$private$speciesTable$index)))
+          if (data$.__enclos_env__$private$speciesIntercepts) ips <- fmesher::fm_cprod(ips, data.frame(specIntTermRem = 1:max(data$.__enclos_env__$private$speciesTable$index)))
           names(ips)[names(ips) == 'specIntTermRem'] <- data$.__enclos_env__$private$speciesName
         }
       } 

diff --git a/R/bruSDM_predict.R b/R/bruSDM_predict.R
@@ -11,7 +11,7 @@ setClass('bruSDM_predict')
 #' @param object A \code{bru_sdm} objects.
 #' @param data Data containing points of the map with which to predict on. May be \code{NULL} if one of \code{mesh} or \code{mask} is \code{NULL}.
 #' @param formula Formula to predict. May be \code{NULL} if other arguments: \code{covariates}, \code{spatial}, \code{intercepts} are not \code{NULL}.
-#' @param mesh An \code{inla.mesh} object.
+#' @param mesh An \code{fm_mesh_2d} object.
 #' @param mask A mask of the study background. Defaults to \code{NULL}.
 #' @param covariates Name of covariates to predict.
 #' @param temporal Make predictions for the temporal component of the model.
@@ -65,7 +65,7 @@ predict.bruSDM <- function(object, data = NULL, formula = NULL, mesh = NULL,
                            marks = NULL, biasfield = FALSE, biasnames = NULL, predictor = FALSE,
                            fun = 'linear', format = 'sf', ...) {
 
-  if (is.null(data) & is.null(mesh)) stop("Either data covering the entire study region or an inla.mesh object is required.")
+  if (is.null(data) & is.null(mesh)) stop("Either data covering the entire study region or an fm_mesh_2d object is required.")
 
   ## if datasets !is.null but at least one not in model stop
   # else datasets <- all datasets in the model.
@@ -142,24 +142,24 @@ predict.bruSDM <- function(object, data = NULL, formula = NULL, mesh = NULL,
 
     if (!is.null(mask)) {
 
-      data <- inlabru::fm_pixels(mesh, mask = mask, format = format)
+      data <- fmesher::fm_pixels(mesh, mask = mask, format = format)
 
     }   
-    else data <- inlabru::fm_int(mesh, format = format)
+    else data <- fmesher::fm_int(mesh, format = format)
   }
 
   if (speciespreds) {
 
   if (object[['species']][['speciesEffects']][['Intercepts']]) {
 
-    data <- fm_cprod(data, data.frame(speciesIndexREMOVE = 1:length(unique(unlist(object$species$speciesIn)))))
+    data <- fmesher::fm_cprod(data, data.frame(speciesIndexREMOVE = 1:length(unique(unlist(object$species$speciesIn)))))
     names(data)[names(data) == 'speciesIndexREMOVE'] <- object[['species']][['speciesVar']]
 
   }
 
   if (object$spatial$species == 'replicate') {
 
-  if (!object[['species']][['speciesVar']] %in% names(data)) data <- fm_cprod(data, data.frame(speciesSpatialGroup = 1:length(unique(unlist(object$species$speciesIn)))))
+  if (!object[['species']][['speciesVar']] %in% names(data)) data <- fmesher::fm_cprod(data, data.frame(speciesSpatialGroup = 1:length(unique(unlist(object$species$speciesIn)))))
   else data$speciesSpatialGroup <- data[[object[['species']][['speciesVar']]]]
 
   }
@@ -213,7 +213,7 @@ predict.bruSDM <- function(object, data = NULL, formula = NULL, mesh = NULL,
       time_data <- data.frame(seq_len(max(numeric_time)))
       names(time_data) <- time_variable
 
-      timeData <- inlabru::fm_cprod(data, data.frame(time_data))
+      timeData <- fmesher::fm_cprod(data, data.frame(time_data))
       names(timeData)[!names(timeData) %in% c('geometry', '.block')] <- c(time_variable, 'weight')  
 
       #bias

diff --git a/R/dataOrganize.R b/R/dataOrganize.R
@@ -896,7 +896,7 @@ dataOrganize$set('public', 'makeComponents', function(spatial, intercepts,
 })
 
 #' @description Function to make the datasets into likelihoods.
-#' @param mesh An inla.mesh object.
+#' @param mesh An \code{fm_mesh_2d} object.
 #' @param ips Integration points used.
 #' @param paresp The response variable name for the presence absence datasets.
 #' @param ntrialsvar The trials variable name for the presence absence datasets.
@@ -968,19 +968,22 @@ dataOrganize$set('public', 'makeLhoods', function(mesh, ips,
         }
         else IPS <- ips
         ##rm formulas for now
+
+        # bru_like_list will use the like-tag, not the list names.
+        if (is.null(names(self$Data[[dataset]])[species])) nameGive <- names(self$Data)[[dataset]]
+        else nameGive <- names(self$Data[[dataset]])[species]
+
+        like_name <- paste0(nameGive, '_', as.character(self$Formulas[[dataset]][[species]][[process]][['LHS']])[2])
 
         Likelihoods[[Likindex]] <- inlabru::like(formula = self$Formulas[[dataset]][[species]][[process]][['LHS']],
                                                  include = self$Formulas[[dataset]][[species]][[process]][['RHS']],
                                                  data = self$Data[[dataset]][[species]], 
                                                  Ntrials = Ntrials,
-                                                 mesh = mesh,
                                                  ips = IPS,
-                                                 family = self$Family[[dataset]][process])
-
-        if (is.null(names(self$Data[[dataset]])[species])) nameGive <- names(self$Data)[[dataset]]
-        else nameGive <- names(self$Data[[dataset]])[species]
+                                                 family = self$Family[[dataset]][process],
+                                                 tag = like_name)
 
-        names(Likelihoods)[[Likindex]] <- paste0(nameGive, '_', as.character(self$Formulas[[dataset]][[species]][[process]][['LHS']])[2])
+        names(Likelihoods)[[Likindex]] <- like_name
 
       }
 

diff --git a/R/datasetOut.R b/R/datasetOut.R
@@ -125,14 +125,8 @@ datasetOut <- function(model, dataset,
 
     }
 
-
-    reduced_terms <- unique(unlist(lapply(model$bru_info$lhoods[index], function(x) {
-
-      if (!identical(unlist(x$used), character(0))) unlist(x$used)
-      else labels(terms(x$formula))
-
-    })))
-
+    reduced_terms <- unlist(inlabru::bru_used(model$bru_info$lhoods[index]))
+
     reduced_components <- reduceComps(componentsOld = model$componentsJoint,
                           pointsCopy = ifelse(model$spatial$points == 'copy', 
                                       TRUE, FALSE),
@@ -178,6 +172,10 @@ datasetOut <- function(model, dataset,
 
     if (predictions) {
 
+      # Seems you require names, but haven't used tags, so they're all NA
+      if (all(is.na(names(model$bru_info$lhoods)))) {
+        names(model$bru_info$lhoods) <- model[["source"]]
+      }
       reduced_lik <- model$bru_info$lhoods
 
       for (data in names(model$bru_info$lhoods)[!index]) { 

diff --git a/R/fitISDM.R b/R/fitISDM.R
@@ -44,7 +44,7 @@ fitISDM <- function(data, options = list()) {
   if (!inherits(data, 'dataSDM') && !inherits(data, 'specifySpecies') && !inherits(data, 'specifyISDM') &&
       !inherits(data, 'specifyMarks')) stop('data needs to be either a specifySpecies, specifyISDM or specifyMarks object.')
 
-  if (is.null(data$.__enclos_env__$private$INLAmesh)) stop('An inla.mesh object is required before any model is run.')
+  if (is.null(data$.__enclos_env__$private$INLAmesh)) stop('An fm_mesh_2d object is required before any model is run.')
 
   data2ENV(data = data, env = environment())
 
@@ -135,8 +135,8 @@ fitISDM <- function(data, options = list()) {
                                                               samplers = data$.__enclos_env__$private$biasData[[bias]],
                                                               ips = data$.__enclos_env__$private$IPS,
                                                               domain = list(coordinates = data$.__enclos_env__$private$INLAmesh),
-                                                              include = c(paste0(bias, '_samplers_field'), paste0(bias,'_samplers'), data$.__enclos_env__$private$spatcovsNames))
-
+                                                              include = c(paste0(bias, '_samplers_field'), paste0(bias,'_samplers'), data$.__enclos_env__$private$spatcovsNames),
+                                                              tag = paste0(bias, '_samplers'))
 
     }
 

diff --git a/R/intModel.R b/R/intModel.R
@@ -6,8 +6,8 @@
 #' @param spatialCovariates The spatial covariates used in the model. These covariates must be measured at every location (pixel) in the study area, and must be a \code{Raster*}, \code{SpatialPixelsDataFrame} or \code{SpatialRaster} object. Can be either \code{numeric}, \code{factor} or \code{character} data.
 #' @param Coordinates A vector of length 2 containing the names (class \code{character}) of the coordinate variables used in the model.
 #' @param Projection The coordinate reference system used by both the spatial points and spatial covariates. Must be of class \code{character}.
-#' @param Mesh An \code{inla.mesh} object required for the spatial random fields and the integration points in the model (see \code{\link[INLA]{inla.mesh.2d}} from the \pkg{INLA} package for more details). 
-#' @param IPS The integration points to be used in the model (that is, the points on the map where the intensity of the model is calculated). See \code{\link[inlabru]{fm_int}} from the \pkg{inlabru} package for more details regarding these points; however defaults to \code{NULL} which will create integration points from the \code{Mesh} object.
+#' @param Mesh An \code{fm_mesh_2d} object required for the spatial random fields and the integration points in the model (see \code{\link[fmesher]{fm_mesh_2d_inla}} from the \pkg{fmesher} package for more details). 
+#' @param IPS The integration points to be used in the model (that is, the points on the map where the intensity of the model is calculated). See \code{\link[fmesher]{fm_int}} from the \pkg{fmesher} package for more details regarding these points; however defaults to \code{NULL} which will create integration points from the \code{Mesh} object.
 #' @param Boundary A \code{sf} object of the study area. If not missing, this object is used to help create the integration points.
 #' @param speciesSpatial Argument to specify if each species should have their own spatial effect with different hyperparameters to be estimated using \pkg{INLA}'s "replicate" feature, of if a the field's should be estimated per species copied across datasets using \pkg{INLA}'s "copy" feature. Possible values include: \code{'replicate'}, \code{'copy'}, \code{'shared'} or \code{NULL} if no species-specific spatial effects should be estimated.
 #' @param speciesIndependent Logical argument: Should species effects be made independent of one another. Defaults to \code{FALSE} which creates effects for each species independently.

diff --git a/R/makeLhoods.R b/R/makeLhoods.R
@@ -3,7 +3,7 @@
 #' @param data A list of sf objects containing the datasets for which likelihoods need to be constructed.
 #' @param formula A list of formulas to add to the likelihoods.
 #' @param family A list of vectors containing the families within each dataset.
-#' @param mesh An inla.mesh object.
+#' @param mesh An \code{fm_mesh_2d} object.
 #' @param ips Integration points used.
 #' @param paresp The response variable name for the presence absence datasets.
 #' @param ntrialsvar The trials variable name for the presence absence datasets.
@@ -99,21 +99,24 @@ makeLhoods <- function(data, formula, family, mesh, ips,
 
         }
         }
-
+
+        # bru_like_list will use the like-tag for list names; inlabru >= 2.12.0
+        if (is.null(names(data[[dataset]])[species])) nameGive <- names(data)[[dataset]]
+        else nameGive <- names(data[[dataset]])[species]
+
+        like_name <- paste0(nameGive, '_', sub(' .*', '', as.character(formula[[dataset]][[species]][[process]][['LHS']])[2]))
+
         Likelihoods[[Likindex]] <- inlabru::like(formula = formula[[dataset]][[species]][[process]][['LHS']], ## but obs change these in function call
                                                  include = formula[[dataset]][[species]][[process]][['RHS']],
                                                  data = data[[dataset]][[species]], 
                                                  Ntrials = Ntrials,
-                                                 mesh = mesh,
                                                  ips = IPS,
                                                  domain = list(geometry = mesh),
                                                  samplers = samplers[[names(data)[[dataset]]]],
-                                                 family = family[[dataset]][process])
-
-        if (is.null(names(data[[dataset]])[species])) nameGive <- names(data)[[dataset]]
-        else nameGive <- names(data[[dataset]])[species]
+                                                 family = family[[dataset]][process],
+                                                 tag = like_name)
 
-        names(Likelihoods)[[Likindex]] <- paste0(nameGive, '_', sub(' .*', '', as.character(formula[[dataset]][[species]][[process]][['LHS']])[2]))
+        names(Likelihoods)[[Likindex]] <- like_name
 
       } 
 

diff --git a/R/modISDM_predict.R b/R/modISDM_predict.R
@@ -10,7 +10,7 @@ setClass('modISDM_predict')
 #' @param object A \code{modISDM} object.
 #' @param data Data containing points of the map with which to predict on. May be \code{NULL} if one of \code{mesh} or \code{mask} is \code{NULL}.
 #' @param formula Formula to predict. May be \code{NULL} if other arguments: \code{covariates}, \code{spatial}, \code{intercepts} are not \code{NULL}.
-#' @param mesh An \code{inla.mesh} object.
+#' @param mesh An \code{fm_mesh_2d} object.
 #' @param mask A mask of the study background. Defaults to \code{NULL}.
 #' @param covariates Name of covariates to predict.
 #' @param spatial Logical: include spatial effects in prediction. Defaults to \code{FALSE}.
@@ -65,7 +65,7 @@ predict.modISDM <- function(object, data = NULL, formula = NULL, mesh = NULL,
 
   ##If pointsSpatial == correlate, then need to chose a dataset for which to use as the spatial effect. Could use either the first PA dataset or specify using dataset
 
-  if (is.null(data) & is.null(mesh)) stop("Either data covering the entire study region or an inla.mesh object is required.")
+  if (is.null(data) & is.null(mesh)) stop("Either data covering the entire study region or an fm_mesh_2d object is required.")
 
   #Why can't you do both here?
   if (bias && spatial) stop('Please choose one of bias and spatial.')
@@ -110,10 +110,10 @@ predict.modISDM <- function(object, data = NULL, formula = NULL, mesh = NULL,
 
     if (!is.null(mask)) {
 
-      data <- inlabru::fm_pixels(mesh, mask = mask)
+      data <- fmesher::fm_pixels(mesh, mask = mask)
 
     }   
-    else data <- inlabru::fm_int(mesh)
+    else data <- fmesher::fm_int(mesh)
   }
 
   if (!is.null(object$temporal$temporalVar)) temporal <- TRUE
@@ -164,7 +164,7 @@ predict.modISDM <- function(object, data = NULL, formula = NULL, mesh = NULL,
       time_data <- data.frame(seq_len(max(numeric_time)))
       names(time_data) <- time_variable
 
-      data <- inlabru::fm_cprod(data, data.frame(time_data))
+      data <- fmesher::fm_cprod(data, data.frame(time_data))
       data$.__plot__index__ <- data[[time_variable]]
 
     }

diff --git a/R/modMarks_predict.R b/R/modMarks_predict.R
@@ -11,7 +11,7 @@ setClass('modMarks_predict')
 #' @param object A \code{modMarks} object.
 #' @param data Data containing points of the map with which to predict on. May be \code{NULL} if one of \code{mesh} or \code{mask} is \code{NULL}.
 #' @param formula Formula to predict. May be \code{NULL} if other arguments: \code{covariates}, \code{spatial}, \code{intercepts} are not \code{NULL}.
-#' @param mesh An \code{inla.mesh} object.
+#' @param mesh An \code{fm_mesh_2d} object.
 #' @param mask A mask of the study background. Defaults to \code{NULL}.
 #' @param covariates Name of covariates to predict.
 #' @param spatial Logical: include spatial effects in prediction. Defaults to \code{FALSE}.
@@ -65,7 +65,7 @@ predict.modMarks <- function(object, data = NULL, formula = NULL, mesh = NULL,
                              marks = NULL, bias = FALSE, biasnames = NULL, predictor = FALSE,
                              fun = 'linear', ...) {
 
-  if (is.null(data) & is.null(mesh)) stop("Either data covering the entire study region or an inla.mesh object is required.")
+  if (is.null(data) & is.null(mesh)) stop("Either data covering the entire study region or an fm_mesh_2d object is required.")
 
   ## if non-null biasfields ## if no bias fields in stop: if biasnames not in biasfields stop
   if (bias && spatial) stop('Please choose one of bias and spatial.')
@@ -140,10 +140,10 @@ predict.modMarks <- function(object, data = NULL, formula = NULL, mesh = NULL,
 
     if (!is.null(mask)) {
 
-      data <- inlabru::fm_pixels(mesh, mask = mask)
+      data <- fmesher::fm_pixels(mesh, mask = mask)
 
     }   
-    else data <- inlabru::fm_int(mesh)
+    else data <- fmesher::fm_int(mesh)
   }
 
   if (!any(names(data) %in% object$spatCovs$name)) {
@@ -193,7 +193,7 @@ predict.modMarks <- function(object, data = NULL, formula = NULL, mesh = NULL,
       time_data <- data.frame(seq_len(max(numeric_time)))
       names(time_data) <- time_variable
 
-      data <- inlabru::fm_cprod(data, data.frame(time_data))
+      data <- fmesher::fm_cprod(data, data.frame(time_data))
       data$.__plot__index__ <- data[[time_variable]]
 
     }
@@ -428,4 +428,4 @@ plot.modMarks_predict <- function(x,
   }
 
 
-}
+}