climateWithObs

Adding this parameter to restrict the climate space to where calibration data are available

DESCRIPTION

@@ -21,6 +21,7 @@ RoxygenNote: 7.2.3
 Imports:
     clipr,
     DBI,
+    data.table,
     methods,
     openxlsx,
     plot3D,

R/crest.get_modern_data.R

@@ -37,6 +37,7 @@ crest.get_modern_data <- function( pse, taxaType, climate,
                                    basins = NA, sectors = NA,
                                    realms = NA, biomes = NA, ecoregions = NA,
                                    minGridCells = 20,
+                                   climateWithObs = FALSE,
                                    elev_min = NA, elev_max = NA, elev_range = NA,
                                    year_min = 1900, year_max = 2021, nodate = TRUE,
                                    type_of_obs = c(1, 2, 3, 8, 9),
@@ -363,6 +364,7 @@ crest.get_modern_data <- function( pse, taxaType, climate,
         year_min=year_min, year_max=year_max, nodate=nodate,
         type_of_obs=type_of_obs,
         selectedTaxa = selectedTaxa,
+        climateWithObs=climateWithObs,
         dbname=dbname
     )
     crest$misc[['taxa_notes']] <- taxa_notes
@@ -615,10 +617,22 @@ crest.get_modern_data <- function( pse, taxaType, climate,
         }
 
         crest$modelling$climate_space <- crest$modelling$climate_space[order(crest$modelling$climate_space$longitude, crest$modelling$climate_space$latitude), ]
-        crest$modelling$crest <- crest$modelling$biome_space[order(crest$modelling$biome_space$longitude, crest$modelling$biome_space$latitude), ]
+        crest$modelling$biome_space <- crest$modelling$biome_space[order(crest$modelling$biome_space$longitude, crest$modelling$biome_space$latitude), ]
 
     }
 
+    if(climateWithObs) {
+        df <- lapply(crest$modelling$distributions, function(x) return(unique(x[, c('longitude', 'latitude')])))
+        df <- as.data.frame(unique(data.table::rbindlist(df)))
+        df <- paste(df[, 'longitude'], df[, 'latitude'], sep='_')
+
+        cs_idx <- paste(crest$modelling$climate_space[, 'longitude'], crest$modelling$climate_space[, 'latitude'], sep='_')
+        crest$modelling$climate_space <- crest$modelling$climate_space[cs_idx %in% df, ]
+
+        cs_idx <- paste(crest$modelling$biome_space[, 'longitude'], crest$modelling$biome_space[, 'latitude'], sep='_')
+        crest$modelling$biome_space <- crest$modelling$biome_space[cs_idx %in% df, ]
+    }
+
     if (ai.sqrt & 'ai' %in% crest$parameters$climate) {
         crest$modelling$climate_space[, "ai"] <- sqrt(crest$modelling$climate_space[, "ai"])
         for (tax in crest$inputs$taxa.name) {

R/crestObj.init.R

@@ -66,6 +66,10 @@
 #' @param climateSpaceWeighting.type A correction factor for the clame space
 #'        weighting correction to limit the edge effects. Either 'linear'
 #'        (default), 'sqrt' or 'log'.
+#' @param climateWithObs A boolean to indicate whether all climate values from
+#'        the calibration dataset be included (\code{FALSE}, default) or only the
+#'        climate values that corresponds to proxy observations (\code{TRUE}).
+#'        Only useful in if the climate space weighting is activated.
 #' @param presenceThreshold All values above that threshold will be used in the
 #'        reconstruction (e.g. if set at 1, all percentages below 1 will be set
 #'        to 0 and the associated presences discarded). Default is 0.
@@ -96,6 +100,7 @@ crestObj <- function(taxa.name, taxaType, climate,
                      geoWeighting = TRUE,
                      climateSpaceWeighting = TRUE,
                      climateSpaceWeighting.type = 'linear',
+                     climateWithObs = FALSE,
                      selectedTaxa = NA,
                      distributions = NA,
                      presenceThreshold = 0,
@@ -154,6 +159,7 @@ crestObj <- function(taxa.name, taxaType, climate,
         geoWeighting = geoWeighting,
         climateSpaceWeighting = climateSpaceWeighting,
         climateSpaceWeighting.type = climateSpaceWeighting.type,
+        climateWithObs = climateWithObs,
         presenceThreshold = presenceThreshold,
         uncertainties = uncertainties
     )

R/crestObj.print.R

@@ -69,6 +69,9 @@ print.crestObj <- function(x, as=x$misc$stage, ...) {
                 cat(paste0('*   x Weighting of the climate space ........... ',x$parameters$climateSpaceWeighting, '\n'))
                 cat(paste0("*       Using a ",x$parameters$climateSpaceWeighting.type," correction\n"))
             }
+            if(!is.na(x$parameters$climateSpaceWeighting)) {
+                cat(paste0('*   x Restriction to climate with observations . ',x$parameters$climateWithObs, '\n'))
+            }
             cat(paste0('*   x Shape of the PDFs ........................ ',x$parameters$climate[1], ': ', x$parameters$shape[x$parameters$climate[1], 1], '\n'))
             for(clim in x$parameters$climate[-1]) {
                 cat(paste0('*     ', paste(rep('_', nchar('Shape of the PDFs ........................')), collapse=''), ' ',clim, ': ', x$parameters$shape[clim, 1], '\n'))

R/export.R

@@ -167,8 +167,9 @@ export <- function( x, dataname = x$misc$site_info$site_name,
             df <- rbind(df, c(NA, paste0('Climate Space Weighting: ', ifelse(x$parameters$climateSpaceWeighting, 'Yes', 'No')), NA, NA, NA))
             if (x$parameters$climateSpaceWeighting) df <- rbind(df, c(NA, paste0('     - Using correction: ', x$parameters$climateSpaceWeighting.type), NA, NA, NA))
             if (x$parameters$climateSpaceWeighting) df <- rbind(df, c(NA, paste0('     - Bin width: ', x$parameters$bin_width[clim, ]), NA, NA, NA))
+            df <- rbind(df, c(NA, paste0('Restricting climate space to grid cells with observation: ', ifelse(x$parameters$climateWithObs, 'Yes', 'No')), NA, NA, NA))
             df <- rbind(df, c(NA, paste0('Species weighted by abundance: ', ifelse(x$parameters$geoWeighting, 'Yes', 'No')), NA, NA, NA))
-            df <- rbind(df, c(NA, paste0('Shape of the spcies pdfs: ', x$parameters$shape[clim, ]), NA, NA, NA))
+            df <- rbind(df, c(NA, paste0('Shape of the species pdfs: ', x$parameters$shape[clim, ]), NA, NA, NA))
             df <- rbind(df, c(NA, paste0('Number of points: ', x$parameters$npoints), NA, NA, NA))
             df <- rbind(df, rep(NA, 5))
             df <- rbind(df, rep(NA, 5))