Extracting geopolitical and biographical information from crest.get_m…

…odern_data.

NEWS.md

@@ -9,6 +9,7 @@
     * `loo()` can be run on a subset of the available variables to make the process faster.
     * `getTaxonomy()` can be used with a `crestObj()` to refine the search to a specific study area.
     * INCLUDING A NEW PARAMETER TO `crest.calibrate()`: `climateSpaceWeighting.type`. This parameter is useful to reduce the edge effects to the climate space calibration, as the range of weights could easily cover several ranges of amplitude. This can be toned down using 'sqrt' or 'log', instead of the default 'linear'.
+    * `crest.get_modern_data()` now extract geopolitcal and biogeophical information from the _gbif4crest_ database.
 * Plotting:
     * The results can be plotted as anomalies.
     * Enabling to select samples by age in `plot.speciesCharacteristics()`

R/crest.get_modern_data.R

@@ -597,8 +597,23 @@ crest.get_modern_data <- function( pse, taxaType, climate,
         stop(paste0("No climate values available in the defined study area N: ", crest$parameters$ymx," S: ", crest$parameters$ymn, " W: ",crest$parameters$xmn, " E: ",crest$parameters$xmx, ".\n\n"))
     }
 
-    colnames(climate_space)[-c(1, 2)] <- crest$parameters$climate
-    crest$modelling$climate_space <- climate_space
+    if(.ifExampleDB(dbname)) {
+        colnames(climate_space)[-c(1, 2)] <- crest$parameters$climate
+        crest$modelling$climate_space <- climate_space
+    } else {
+        crest$modelling$climate_space <- climate_space[, c('longitude', 'latitude', crest$parameters$climate)]
+        crest$modelling$biome_space <- climate_space[, 1:(ncol(climate_space) - length(crest$parameters$climate))]
+        if('countryid' %in% colnames(crest$modelling$biome_space)) {
+            crest$modelling$biome_space <- merge(crest$modelling$biome_space, .geopoid2names(crest$modelling$biome_space[, 'countryid'], 1, dbname), by.x='countryid', by.y='geopoid')
+            crest$modelling$biome_space <- merge(crest$modelling$biome_space, .ecoid2names(crest$modelling$biome_space[, 'terr_ecoid'], 1, dbname), by.x='terr_ecoid', by.y='ecoid')
+            crest$modelling$biome_space <- crest$modelling$biome_space[, !colnames(crest$modelling$biome_space) %in% c('countryid', 'terr_ecoid')]
+        }
+        if('oceanid' %in% colnames(crest$modelling$biome_space)) {
+            crest$modelling$biome_space <- merge(crest$modelling$biome_space, .geopoid2names(crest$modelling$biome_space[, 'oceanid'], 2, dbname), by.x='oceanid', by.y='geopoid')
+            crest$modelling$biome_space <- merge(crest$modelling$biome_space, .ecoid2names(crest$modelling$biome_space[, 'mari_ecoid'], 2, dbname), by.x='mari_ecoid', by.y='ecoid')
+            crest$modelling$biome_space <- crest$modelling$biome_space[, !colnames(crest$modelling$biome_space) %in% c('oceanid', 'mari_ecoid')]
+        }
+    }
 
     if (ai.sqrt & 'ai' %in% crest$parameters$climate) {
         crest$modelling$climate_space[, "ai"] <- sqrt(crest$modelling$climate_space[, "ai"])

R/crestObj.init.R

@@ -158,7 +158,7 @@ crestObj <- function(taxa.name, taxaType, climate,
         uncertainties = uncertainties
     )
 
-    modelling <- list(taxonID2proxy = NA, climate_space = NA, pdfs = NA, weights = NA, xrange = NA, distributions = distributions)
+    modelling <- list(taxonID2proxy = NA, climate_space = NA, biome_space = NA, pdfs = NA, weights = NA, xrange = NA, distributions = distributions)
 
     reconstructions <- list()
 

R/dbFixedNames.R

@@ -272,3 +272,50 @@ accRealmNames <- function(realm=NA, ecoregion = TRUE) {
     }
     res
 }
+
+
+
+#' Return geopolitical units associated with a geopoID.
+#'
+#' Return geopolitical units associated with a geopoID.
+#'
+#' @param ids A vector of IDs (countryid or oceanid)
+#' @param realm An index that says if the ids are from terrestrial (realm=1;
+#'        default) or from marine (realm=2) settings.
+#' @param dbname The database to use.
+#' @return A list of names.
+.geopoid2names <- function(ids, realm=1, dbname = "gbif4crest_02") {
+    #realm=1 means terrestrial
+    if(realm == 1) {
+        req <- paste0("SELECT geopoid, continent, name FROM geopolitical_units WHERE geopoid IN (",
+                        paste(ids, collapse=', '), " )")
+    } else {
+        req <- paste0("SELECT geopoid, basin, name FROM geopolitical_units WHERE geopoid IN (",
+                        paste(ids, collapse=', '), " )")
+    }
+    res <- dbRequest(req, dbname)
+    res
+}
+
+
+#' Return biogeographical units associated with a ecoID.
+#'
+#' Return biogeographical units associated with a ecoID.
+#'
+#' @param ids A vector of IDs (mari_ecoid or terr_ecoid)
+#' @param realm An index that says if the ids are from terrestrial (realm=1;
+#'        default) or from marine (realm=2) settings.
+#' @param dbname The database to use.
+#' @return A list of names.
+.ecoid2names <- function(ids, realm=1, dbname = "gbif4crest_02") {
+    #realm=1 means terrestrial
+    if(realm == 1) {
+        req <- paste0("SELECT ecoid, realm, biome, ecoregion FROM biogeography WHERE ecoid IN (",
+                        paste(ids, collapse=', '), " )")
+    } else {
+        req <- paste0("SELECT ecoid, realm FROM biogeography WHERE ecoid IN (",
+                        paste(ids, collapse=', '), " )")
+    }
+    res <- dbRequest(req, dbname)
+    res
+}

R/dbGetClimateSpace.R

@@ -94,6 +94,18 @@ getClimateSpace <- function(climate,
         ELEVRANGE <- ifelse(is.na(elev_range), '', paste0('    AND elev_range <= ', elev_range))
     }
 
+    # Extracting the ecological IDs
+    PARAMS <- ''
+    if(.ifExampleDB(dbname)) { # Some parameters are not availble in the example database
+        PARAMS <- ''
+    } else {
+        climvar <- accClimateVariables()
+        climvar <- climvar[climvar[,2] %in% climate, ]
+        if('Terrestrial' %in% climvar[, 4]) PARAMS <- paste0(PARAMS, " countryID, terr_ecoID, ")
+        if('Marine' %in% climvar[, 4]) PARAMS <- paste0(PARAMS, " oceanID, mari_ecoID, ")
+    }
+
+
     # Removing the 'NULL' when using the SQLite3 database
     NULLS <- ""
     if(stringr::str_detect(base::tolower(dbname), '.sqlite3')) {
@@ -104,8 +116,8 @@ getClimateSpace <- function(climate,
 
     # Formatting the request-----------------------------------------------------
     req <- paste0(
-      "  SELECT DISTINCT longitude, latitude, ",
-      "        ", paste(climate, collapse = ", "), " ",
+      "  SELECT DISTINCT longitude, latitude,", PARAMS,
+      "        ", paste(climate, collapse = ", "), " ", 
       "   FROM  data_qdgc ",
       "   WHERE longitude >= ", coords[1], " AND longitude <= ", coords[2], " ",
       "     AND latitude >= ", coords[3], " AND latitude <= ", coords[4], " ",

R/plot.climateSpace.R

@@ -42,7 +42,7 @@ terra::crs#' Plot the studied climate space.
 #'
 plot_climateSpace <- function( x,
                       climate = x$parameters$climate,
-                      bin_width = x$parameters$bin_width,
+                      bin_width = x$parameters$bin_width[x$parameters$climate,],
                       save = FALSE, filename = 'Climate_space.pdf',
                       as.png = FALSE, png.res=300,
                       width=  7.48,
@@ -59,7 +59,6 @@ plot_climateSpace <- function( x,
         #    stop('The crestObj requires the climate space to be calibrated. Run crest.calibrate() on your data.\n')
         #    return(invisible())
         #}
-
         err <- c()
         for(clim in climate) {
             if(! clim %in% x$parameters$climate) err <- c(err, clim)