R/qc_coordinates_functions.R

In sapfluxnet/sapfluxnetQC1: Package with functions related to sapfluxnet project data

################################################################################
#' Download maps for countries included in the database
#'
#' \code{qc_download_maps} fetch maps from \url{http://www.gadm.org/}.
#'
#' This function fetch maps from \url{http://www.gadm.org/} if the map is not
#' already present in the maps folder (by default, the working directory).
#'
#' @family Quality Check Functions
#'
#' @param data Data frame where the countries ISO codes are. Must contain a
#'   variable called \code{country} where the ISO code resides.
#'
#' @param folder Folder route where the maps are stored or where they will be
#'   stored, by default the working directory. It must be a character object and
#'   it must end \bold{without} \code{/}.
#'
#' @return Maps are downloaded (if needed) and a summary is returned indicating
#'   number of maps downloaded and number of maps present in the map folder.
#'
#' @export

# START
# function declaration

qc_download_maps <- function(data, folder = getwd(), parent_logger = 'test') {

  # Using calling handlers to logging
  withCallingHandlers({

    # STEP 0
    # Argument checks
    #   if data is a data.frame
    if (!is.data.frame(data)) {
      stop('Provided data object is not a data.frame. ',
           'Please check if it is the correct object')
    }
    #   if data contains a country variable
    if (is.null(data$si_country)) {
      stop('There is no country variable in this dataset')
    }
    #   if folder exists and is accesible
    if (!file_test("-d", folder)) {
      stop('Destination folder does not exist. ',
           'Please create destination folder before using this function')
    }

    # STEP 0.a
    # Initialise maps count and download count
    existent_maps <- length(list.files(folder, pattern = '.rds'))
    downloaded_maps <- 0

    # STEP 1
    # Begin for loop, and check if country code is NA, and if it is, don't do
    # anything with that value
    for (code in data$si_country) {
      if (!is.na(code)) {

        # STEP 2
        # Create file name
        file_name <- paste(code, '_adm0.rds', sep = '')

        # STEP 3
        # Check if file exists, and if it exists, don't download the map
        if (!file_name %in% list.files(path = folder, pattern = '.rds')) {

          # STEP 4
          # Create url name
          url_name <- paste('http://biogeo.ucdavis.edu/data/gadm2.8/rds/',
                            file_name,
                            sep = '')

          # STEP 5
          # Dowload file (In case of download error, indicate it and
          # try to skip to the next country)
          possibleError <- tryCatch({
            download.file(url_name,
                          file.path(folder, file_name),
                          cacheOK = FALSE, quiet = TRUE)
            # STEP 5.a
            # Update downloaded maps count
            downloaded_maps <- downloaded_maps + 1
          },
          error = function(e) {
            message('Download for ', file_name,
                    ' failed, check if ISO code are correct and/or if',
                    ' network connection is active. ',
                    'An empty file has been created with the bad iso code.')
          },
          warning = function(e) {
            message('Download for ', file_name,
                    ' failed, check if ISO code are correct and/or if ',
                    'network connection is active. ',
                    'An empty file has been created with the bad iso code.')
          }
            )

          if (inherits(possibleError, "error")) {
            next
          }
        }
    }
    }

    # STEP 6
    # Return a summary of downloaded maps and existent maps
    message(existent_maps, ' maps already downloaded and saved in ', folder)
    message(downloaded_maps, ' new maps downloaded')
    message(length(list.files(folder, pattern = '.rds')) - (existent_maps + downloaded_maps),
            ' empty maps created due to download error')
    message(length(list.files(folder, pattern = '.rds')),
            ' maps now in ', folder)

    # END function
  },

  # handlers
  warning = function(w){logging::logwarn(w$message,
                                         logger = paste(parent_logger, 'qc_download_maps', sep = '.'))},
  error = function(e){logging::logerror(e$message,
                                        logger = paste(parent_logger, 'qc_download_maps', sep = '.'))},
  message = function(m){logging::loginfo(m$message,
                                         logger = paste(parent_logger, 'qc_download_maps', sep = '.'))})

}

################################################################################
#' Site coordinates checking
#'
#' \code{qc_check_coordinates} verifies if provided coordinates are within
#' country declared in metadata form.
#'
#' This function internally download the maps with
#' \code{\link{qc_download_maps}} and it checks if the provided coordinates are
#' within the country limits. It only creates a data frame containing country,
#' site and a logical variable indicating if coordinates are correct.
#'
#' @family Quality Check Functions
#'
#' @param data Data frame with data. At least, longitude, latitude, country and
#'   site name variables must be present in the data object.
#'
#' @param maps_folder Folder route where the maps are stored, by default the
#'   working directory. It must be a character object and it must end
#'   \bold{without} \code{/}.
#'
#' @param plot Logical indicating if plots for coordinate are created and saved
#'   in the working directory. By default, plot are not saved.
#'
#' @param text_report Logical indicating if a text report is showed in the
#'   console after checking coordinates. By default, a report is showed in the
#'   console.
#'
#' @return The data frame used as input with a new variable, is_inside_country,
#'   a logical variable indicating if the site has wrong coordinates
#'
#' @import ggplot2
#'
#' @export


# START
# Function declaration

qc_check_coordinates <- function(data, maps_folder = getwd(),
                                 plot = FALSE, text_report = TRUE,
                                 parent_logger = 'test'){

  # Using calling handlers to logging
  withCallingHandlers({

    # STEP 0
    # Argument checks
    #   if data is a data.frame
    if (!is.data.frame(data)) {
      stop('Provided data object is not a data.frame.',
           ' Please verify if it is the correct object')
    }
    #   if data contains a longitude variable
    if (is.null(data$si_long)) {
      stop('There is no longitude variable in this dataset. ',
           'Please verify if it is the correct data')
    }
    #   if data contains a latitude variable
    if (is.null(data$si_lat)) {
      stop('There is no latitude variable in this dataset. ',
           'Please verify if it is the correct data')
    }
    #   if data contains a country variable
    if (is.null(data$si_country)) {
      stop('There is no country variable in this dataset.',
           ' Please verify if it is the correct data\n')
    }
    #   if data contains a site_name variable
    if (is.null(data$si_name)) {
      stop('There is no site_name variable in this dataset. ',
           'Please verify if it is the correct data')
    }
    #   if folder exists and is accesible
    if (!file_test("-d", maps_folder)) {
      stop('Maps folder does not exist, please verify the folder provided')
    }

    # STEP 1
    # Downlaod maps, if already not downloaded
    qc_download_maps(data = data, folder = maps_folder,
                     parent_logger = parent_logger)

    # STEP 2
    # Initialise results object
    results <- vector()

    # STEP 3
    # Begin the for loop and read the map file
    for (i in 1:length(data[,1])) {

      file_name <- paste(data$si_country[i], '_adm0.rds', sep = '')
      map_data <- readRDS(file.path(maps_folder, file_name))

      # 2.1 message to indicate status of loop, to avoid confussion if it takes
      #     a long time
      message('Checking ', data$si_country[i], '-', data$si_name[i])


      # STEP 3
      # Get coordinates and transform them in SpatialPoints object
      sp_points <- sp::SpatialPoints(
        data[i, c('si_long', 'si_lat')],
        proj4string = sp::CRS(sp::proj4string(map_data))
      )

      # STEP 4
      # Update results object, including the output of rgeos::gContains
      res_tmp <- rgeos::gContains(map_data, sp_points)

      results <- c(results, res_tmp)

      # STEP 5
      # Create and saving the plot if plot = TRUE and is_inside_country = FALSE

      if (plot && !res_tmp) {
        # 5.1 map data in adequate format to be able to plot
        plot_data <- broom::tidy(map_data)
        # 5.2 ggplot2 object
        plot_map <- ggplot(plot_data, aes(x = long, y = lat)) +
          geom_polygon(aes(group = group)) +
          geom_point(aes(x = si_long, y = si_lat),
                     data = data[i,], size = 2, color = 'red', alpha = 0.7) +
          coord_map() +
          labs(title = paste(data[i, c('si_country')],
                             data[i, c('si_name')], sep = ' - '))
        # 5.3 see plot
        print(plot_map)
        # 5.4 save plot in working directory
        ggsave(filename = paste(data[i, c('si_country')], '_',
                                data[i, c('si_name')], '.pdf', sep = ''),
               plot = plot_map, width = 6, height = 4, units = 'cm')
      }
    }

    # STEP 6
    # Create a console report with message if text_report is TRUE

    if (text_report) {

      # 6.1 Sum of wrong, correct and total coordinates checked
      wrong_coordinates <- sum(!results, na.rm = TRUE)
      correct_coordinates <- sum(results, na.rm = TRUE)
      total_coordinates <- wrong_coordinates + correct_coordinates

      # 6.2 messages
      message(wrong_coordinates, ' wrong coordinates in data')
      message(correct_coordinates, ' correct coordinates in data')
      message(total_coordinates, ' coordinates checked')
    }

    # STEP 7
    # Create a new variable in data with the results of the checks
    data$is_inside_country <- results

    # 7.1 Return data with the new variable
    return(data)

    # END FUNCTION
  },

  # handlers
  warning = function(w){logging::logwarn(w$message,
                                         logger = paste(parent_logger, 'qc_check_coordinates', sep = '.'))},
  error = function(e){logging::logerror(e$message,
                                        logger = paste(parent_logger, 'qc_check_coordinates', sep = '.'))},
  message = function(m){logging::loginfo(m$message,
                                         logger = paste(parent_logger, 'qc_check_coordinates', sep = '.'))})

}

################################################################################
#' Coordinates sign test
#'
#' \code{qc_coord_sign_test} is an internal function to test if site coordinates
#' signs are interchanged. It's needed by \code{\link{qc_fix_latlong_errors}}
#' function.
#'
#' Country coordinates sign is established by this function and testing if
#' provided site coordinates are correct is made.
#'
#' @section Special countries:
#' There are special countries where border coordinates for longitude, latitude
#' or both have negative and positive values. In this case, the normal approach
#' of \code{qc_coord_sign_test} is not appropriate, and several tests involving
#' the internal use of \code{\link{qc_check_coordinates}} must be made. If
#' \code{special_countries = TRUE} is specified, then tests are made trying to
#' dilucidate if only a change in the sign of one, latitude or longitude, is
#' needed or, in the contrary, changing both of them is needed. There is one
#' case that can not be covered by this approach: when changing sign of one of
#' the coordinates \bold{AND} changing both coordinates seem to fix the issue,
#' as the correct option can not be assured.
#'
#' @family Quality Check Functions
#'
#' @param data Data frame with data coming from \code{\link{qc_check_coordinates}}
#'   (with latitude, longitude, country and is_inside_country variables).
#'
#' @param maps_folder Folder route where the maps are stored, by default the
#'   working directory. It must be a character object and it must end
#'   \bold{without} \code{/}.
#'
#' @param special_countries Logical indicating if the special approach to
#'   countries having positive and negative coordinates must be used. See
#'   \emph{Special countries} section for details.
#'
#' @return Same data frame provided, with a two new columns, \code{lat_changed}
#'   and \code{long_changed}, two logicals indicating if the coordinates are
#'   sign exchanged
#'
#' @export

# START
# Function declaration

qc_coord_sign_test <- function(data, maps_folder = getwd(),
                            special_countries = FALSE,
                            parent_logger = 'test') {

  # Using calling handlers to logging
  withCallingHandlers({

    # STEP 0
    # Arguments check
    #   if data is a data.frame
    if (!is.data.frame(data)) {
      stop('Provided data object is not a data.frame. ',
           'Please verify if it is the correct object')
    }
    #   if data contains a longitude variable
    if (is.null(data$si_long)) {
      stop('There is no longitude variable in this dataset. ',
           'Please verify if it is the correct data')
    }
    #   if data contains a latitude variable
    if (is.null(data$si_lat)) {
      stop('There is no latitude variable in this dataset. ',
           'Please verify if it is the correct data')
    }
    #   if data contains a country variable
    if (is.null(data$si_country)) {
      stop('There is no country variable in this dataset. ',
           'Please verify if it is the correct data')
    }
    #   if data contains a is_inside_country variable
    if (is.null(data$is_inside_country)) {
      stop('There is no is_inside_country variable in this dataset. ',
           ' Please verify if it is the correct data')
    }

    # STEP 1
    # Initialise result vectors, and start for loop
    lat_changed <- logical()
    long_changed <- logical()

    for (i in 1:length(data[,1])) {

      # STEP 2
      # Check if is_inside_country is FALSE, and if it is, read the map data
      if (!data$is_inside_country[i]) {
        file_name <- paste(data$si_country[i], '_adm0.rds', sep = '')

        # 2.1 map data is read and transformed to tidy format, to easy check signs
        country_map <- broom::tidy(readRDS(file.path(maps_folder, file_name)))

        # STEP 3
        # Establish the main sign of country latitude and longitude

        # 3.1 latitude
        if (all(country_map$lat < 0)) {
          country_lat <- 'negative'
        } else {
          if (all(country_map$lat >= 0)) {
            country_lat <- 'positive'
          } else {
            country_lat <- 'mixed'
          }
        }

        # 3.2 longitude
        if (all(country_map$long < 0)) {
          country_long <- 'negative'
        } else {
          if (all(country_map$long >= 0)) {
            country_long <- 'positive'
          } else {
            country_long <- 'mixed'
          }
        }

        # STEP 4
        # Testing if provided coordinates are sign exchanged

        # 4.1 latitude
        if ( data$si_lat[i] < 0) {
          if (country_lat == 'positive') {
            lat_changed <- c(lat_changed, TRUE)
          }
          if (country_lat == 'negative') {
            lat_changed <- c(lat_changed, FALSE)
          }
          if (country_lat == 'mixed') {
            lat_changed <- c(lat_changed, NA)
          }
        } else {
          if (country_lat == 'positive') {
            lat_changed <- c(lat_changed, FALSE)
          }
          if (country_lat == 'negative') {
            lat_changed <- c(lat_changed, TRUE)
          }
          if (country_lat == 'mixed') {
            lat_changed <- c(lat_changed, NA)
          }
        }

        # 4.2 longitude
        if ( data$si_long[i] < 0) {
          if (country_long == 'positive') {
            long_changed <- c(long_changed, TRUE)
          }
          if (country_long == 'negative') {
            long_changed <- c(long_changed, FALSE)
          }
          if (country_long == 'mixed') {
            long_changed <- c(long_changed, NA)
          }
        } else {
          if (country_long == 'positive') {
            long_changed <- c(long_changed, FALSE)
          }
          if (country_long == 'negative') {
            long_changed <- c(long_changed, TRUE)
          }
          if (country_long == 'mixed') {
            long_changed <- c(long_changed, NA)
          }
        }
      } else {

        # STEP 5
        # If is_inside_country is not FALSE, coordinates are ok
        lat_changed <- c(lat_changed, FALSE)
        long_changed <- c(long_changed, FALSE)
      }
    }

    # STEP 6
    # Create the returned data frame
    res_data <- cbind(data, lat_changed, long_changed)

    # STEP 7
    # Special countries approach
    if (special_countries) {

      # 7.1 Start for loop and check if lat_changed and/or long_changed is NA
      for (j in 1:length(res_data[,1])) {

        lat_na <- is.na(res_data$lat_changed[j])
        long_na <- is.na(res_data$long_changed[j])

        # 7.2 CASE 1 only one changed
        # 7.2.1 data frame
        if (lat_na && !long_na) {

          if (res_data$long_changed[j]) {
            check_data_lat <- data.frame(
              si_long = res_data$si_long[j] * -1,
              si_lat = res_data$si_lat[j] * -1,
              si_country = res_data$si_country[j],
              si_name = res_data$si_name[j],
              stringsAsFactors = FALSE
            )
          } else {
            check_data_lat <- data.frame(
              si_long = res_data$si_long[j],
              si_lat = res_data$si_lat[j] * -1,
              si_country = res_data$si_country[j],
              si_name = res_data$si_name[j],
              stringsAsFactors = FALSE
            )
          }

          # 7.2.2 check
          res_data$lat_changed[j] <- qc_check_coordinates(
            check_data_lat, maps_folder,
            plot = FALSE,
            text_report = FALSE)$is_inside_country[1]
        }

        if (!lat_na && long_na) {

          # 7.2.3 data frame
          if (res_data$lat_changed[j]) {
            check_data_long <- data.frame(
              si_long = res_data$si_long[j] * -1,
              si_lat = res_data$si_lat[j] * -1,
              si_country = res_data$si_country[j],
              si_name = res_data$si_name[j],
              stringsAsFactors = FALSE
            )
          } else {
            check_data_long <- data.frame(
              si_long = res_data$si_long[j] * -1,
              si_lat = res_data$si_lat[j],
              si_country = res_data$si_country[j],
              si_name = res_data$si_name[j],
              stringsAsFactors = FALSE
            )
          }

          # 7.2.4 check
          res_data$long_changed[j] <- qc_check_coordinates(
            check_data_long, maps_folder,
            plot = FALSE,
            text_report = FALSE)$is_inside_country[1]
        }

        # 7.3 CASE 2 Both border coordinates with positive and negative values

        if (lat_na && long_na) {

          # 7.3.1 data frames
          check_data_lat <- data.frame(
            si_long = res_data$si_long[j],
            si_lat = res_data$si_lat[j] * -1,
            si_country = res_data$si_country[j],
            si_name = res_data$si_name[j],
            stringsAsFactors = FALSE
          )

          check_data_long <- data.frame(
            si_long = res_data$si_long[j] * -1,
            si_lat = res_data$si_lat[j],
            si_country = res_data$si_country[j],
            si_name = res_data$si_name[j],
            stringsAsFactors = FALSE
          )

          check_data_both <- data.frame(
            si_long = res_data$si_long[j] * -1,
            si_lat = res_data$si_lat[j] * -1,
            si_country = res_data$si_country[j],
            si_name = res_data$si_name[j],
            stringsAsFactors = FALSE
          )

          # 7.3.2 checks
          lat_check <- qc_check_coordinates(
            check_data_lat, maps_folder,
            plot = FALSE,
            text_report = FALSE)$is_inside_country[1]

          long_check <- qc_check_coordinates(
            check_data_long, maps_folder,
            plot = FALSE,
            text_report = FALSE)$is_inside_country[1]

          both_check <- qc_check_coordinates(
            check_data_both, maps_folder,
            plot = FALSE,
            text_report = FALSE)$is_inside_country[1]

          # 7.3.3 Changing both fix the problem
          if (both_check && (!lat_check && !long_check)) {
            res_data$lat_changed[j] <- TRUE
            res_data$long_changed[j] <- TRUE
          }

          # 7.3.4 Changing only latitude fix the problem
          if (lat_check && (!both_check && !long_check)) {
            res_data$lat_changed[j] <- TRUE
            res_data$long_changed[j] <- FALSE
          }

          # 7.3.5 Changing only longitude fix the problem
          if (long_check && (!both_check && !lat_check)) {
            res_data$lat_changed[j] <- FALSE
            res_data$long_changed[j] <- TRUE
          }

          # 7.3.6 Special case, when changing both coordinates fix, but also
          #       changing only latitude and/or longitude separately fix the
          #       issue. In this case, there is no solution as there is no
          #       certainty about the correct solution
          if ((both_check && (lat_check || long_check)) &&
              (both_check && (lat_check && long_check))) {
            message('No certainty about correct solution in ',
                    res_data$si_country[j], '-', res_data$si_name[j])
          }
        }
      }
    }

    # STEP 8
    # Return the results
    return(res_data)

    # END FUNCTION
  },

  # handlers
  warning = function(w){logging::logwarn(w$message,
                                         logger = paste(parent_logger, 'qc_coord_sign_test', sep = '.'))},
  error = function(e){logging::logerror(e$message,
                                        logger = paste(parent_logger, 'qc_coord_sign_test', sep = '.'))},
  message = function(m){logging::loginfo(m$message,
                                         logger = paste(parent_logger, 'qc_coord_sign_test', sep = '.'))})

}

################################################################################
#' Fixing sign errors in coordinates
#'
#' \code{qc_fix_latlong_errors} makes possible to fix known errors in latitude and
#' longitude coordinates, as exchanged signs.
#'
#' This function calls to other internal functions in order to fix different
#' kinds of coordinates errors. At the moment, only exchanged signs in
#' coordinates errors are considered to be fixed.
#'
#' After the fixes are applied, \code{\link{qc_check_coordinates}} is called to
#' update \code{is_inside_country} variable.
#'
#' @section Sign errors:
#' If \code{sign_errors = TRUE} is specified, \code{\link{qc_coord_sign_test}} is
#' called to establish possible sign error and, if any, they are fixed. This fix
#' can be done with or without special countries (see next section)
#'
#' @section Special countries:
#' There are special countries where border coordinates for longitude, latitude
#' or both have negative and positive values. In this case, the normal approach
#' of \code{qc_coord_sign_test} is not appropriate, and several tests involving
#' the internal use of \code{\link{qc_check_coordinates}} must be made. If
#' \code{special_countries = TRUE} is specified, then tests are made trying to
#' dilucidate if only a change in the sign of one, latitude or longitude, is
#' needed or, in the contrary, changing both of them is needed. There is one
#' case that can not be covered by this approach: when changing sign of one of
#' the coordinates \bold{AND} changing both coordinates seem to fix the issue,
#' as the correct option can not be assured.
#'
#' @family Quality Check Functions
#'
#' @param data Data frame with data coming from \code{\link{qc_check_coordinates}}
#'   (with latitude, longitude, country and is_inside_country variables).
#'
#' @param maps_folder Folder route where the maps are stored, by default the
#'   working directory. It must be a character object and it must end
#'   \bold{without} \code{/}.
#'
#' @param sign_errors Logical indicating if sign errors must be checked and
#'   fixed. If TRUE (default), \code{\link{qc_coord_sign_test}} is internally
#'   called.
#'
#' @param special_countries Logical indicating if the special approach to
#'   countries having positive and negative coordinates must be used. See
#'   \emph{Special countries} section for details.
#'
#' @return Same data frame provided, with coordinates tested and fixed
#'
#' @export

# START
# Function declaration
qc_fix_latlong_errors <- function(data, maps_folder = getwd(),
                                  sign_errors = TRUE,
                                  special_countries = FALSE,
                                  parent_logger = 'test') {

  # Using calling handlers to logging
  withCallingHandlers({

    # STEP 0
    # Argument checks
    #   if data is a data.frame
    if (!is.data.frame(data)) {
      stop('Provided data object is not a data.frame. ',
           'Please verify if it is the correct object')
    }
    #   if folder exists and is accesible
    if (!file_test("-d", maps_folder)) {
      stop('maps_folder location does not exist or is not accessible. ',
           'Please check provided folder name')
    }
    #   if data contains a longitude variable
    if (is.null(data$si_long)) {
      stop('There is no longitude variable in this dataset. ',
           'Please verify if it is the correct data')
    }
    #   if data contains a latitude variable
    if (is.null(data$si_lat)) {
      stop('There is no latitude variable in this dataset. ',
           'Please verify if it is the correct data')
    }
    #   if data contains a country variable
    if (is.null(data$si_country)) {
      stop('There is no country variable in this dataset. ',
           'Please verify if it is the correct data')
    }
    #   if data contains a is_inside_country variable
    if (is.null(data$is_inside_country)) {
      stop('There is no is_inside_country variable in this dataset. ',
           'Please verify if it is the correct data')
    }

    # STEP 1
    # Initialising results objects
    results <- data

    # STEP 2
    # Fixing sign errors if sign_errors = TRUE
    if(sign_errors) {

      # 2.1 Are signs interchanged?
      sign_test_data <- qc_coord_sign_test(data, maps_folder,
                                           special_countries = special_countries)

      # 2.2 Fix them if they are (multiply by -1)
      # latitude
      results$si_lat[which(sign_test_data$lat_changed == TRUE)] <-
        results$si_lat[which(sign_test_data$lat_changed == TRUE)] * (-1)
      # longitude
      results$si_long[which(sign_test_data$long_changed == TRUE)] <-
        results$si_long[which(sign_test_data$long_changed == TRUE)] * (-1)

      # 2.3 Console output indicating fixes and no-fixes
      message(sum(sign_test_data$lat_changed == TRUE, na.rm = TRUE),
              ' latitude sign errors fixed. ',
              sum(sign_test_data$long_changed == TRUE, na.rm = TRUE),
              ' longitude sign errors fixed. ',
              sum(is.na(sign_test_data$lat_changed)) +
                sum(is.na(sign_test_data$long_changed)),
              ' unable to fix due to country borders sharing positive and negative coordinates.')
    }

    # STEP 3 to STEP n
    # Here will appear other functions to fix other kind of coordinates errors

    # n+1 STEP
    # Returning the results
    return(suppressMessages(
      qc_check_coordinates(results, maps_folder,
                           plot = FALSE, text_report = FALSE))
    )

    # END FUNCTION
  },

  warning = function(w){logging::logwarn(w$message,
                                         logger = paste(parent_logger, 'qc_fix_latlong_errors', sep = '.'))},
  error = function(e){logging::logerror(e$message,
                                        logger = paste(parent_logger, 'qc_fix_latlong_errors', sep = '.'))},
  message = function(m){logging::loginfo(m$message,
                                         logger = paste(parent_logger, 'qc_fix_latlong_errors', sep = '.'))})

}

################################################################################
#' Commodity function to check site coordinates
#'
#' Wrap around \code{\link{qc_check_coordinates}} and \code{\link{qc_fix_latlong_errors}}
#' to process coordinates data in one step
#'
#' @family Quality Checks Functions
#'
#' @param data Data frame with data coming from \code{\link{qc_check_coordinates}}
#'   (with latitude, longitude, country and is_inside_country variables).
#'
#' @param maps_folder Folder route where the maps are stored, by default the
#'   working directory. It must be a character object and it must end
#'   \bold{without} \code{/}.
#'
#' @param plot Logical indicating if plots for coordinate are created and saved
#'   in the working directory. By default, plot are not saved.
#'
#' @param text_report Logical indicating if a text report is showed in the
#'   console after checking coordinates. By default, a report is showed in the
#'   console.
#'
#' @param sign_errors Logical indicating if sign errors must be checked and
#'   fixed. If TRUE (default), \code{\link{qc_coord_sign_test}} is internally
#'   called.
#'
#' @param special_countries Logical indicating if the special approach to
#'   countries having positive and negative coordinates must be used. See
#'   \code{\link{qc_fix_latlong_errors}} for details.
#'
#' @export

# START
# Function declaration
qc_coordinates <- function(data, maps_folder = getwd(), plot = FALSE,
                           text_report = TRUE, sign_errors = TRUE,
                           special_countries = TRUE,
                           parent_logger = 'test') {

  # Using calling handlers to manage errors
  withCallingHandlers({
    # STEP 0
    # Argument checks
    # None, all are done in the internal functions

    # STEP 1
    # Check coordinates
    check_coord_data <- qc_check_coordinates(as.data.frame(data), maps_folder,
                                             parent_logger = parent_logger)

    # 1.1, check if it is correct
    if (check_coord_data$is_inside_country) {

      # if it is, return data with the is_inside_variable added
      message('Coordinates are correct')
      return(check_coord_data)

      # 1.2 if not, try to fixit
    } else {
      fixed_coord_data <- qc_fix_latlong_errors(check_coord_data, maps_folder,
                                                sign_errors, special_countries,
                                                parent_logger)

      # and return the fixed data with the is_inside_country variable
      return(fixed_coord_data)
    }

    # END FUNCTION
  },

  warning = function(w){logging::logwarn(w$message,
                                         logger = paste(parent_logger, 'qc_coordinates', sep = '.'))},
  error = function(e){logging::logerror(e$message,
                                        logger = paste(parent_logger, 'qc_coordinates', sep = '.'))},
  message = function(m){logging::loginfo(m$message,
                                         logger = paste(parent_logger, 'qc_coordinates', sep = '.'))})


}

################################################################################
#' Make a SpatialPolygonsDataFrame object of the biomes
#'
#' Creates a SpatialPolygonsDataFrame object of the Whittaker's biomes
#' modified by Ricklefs (2008) in function of mean annual temperature (MAT)
#' and mean annual precipitation (MAP) (MAT in degree Celsius and MAP in mm).
#'
#' @family Quality Checks Functions
#'
#' @param merge_deserts Logical indicating if desert biomes should be merged
#'    in a single biome. By default, deserts are not merged.
#'
#' @return An object of class SpatialPolygonsDataFrame
#'
#' @export

# START
# Function declaration
qc_get_biomes_spdf <- function(merge_deserts = FALSE, parent_logger = 'test') {

  # Using calling handlers to logging
  withCallingHandlers({

    # STEP 0
    # Argument checks
    # Is merge_deserts logical?
    if (!(is.logical(merge_deserts))) {
      stop('merge_deserts must be logical')
    }
    # Is merge_deserts NA?
    if (is.na(merge_deserts)) {
      stop('merge_deserts must be either TRUE or FALSE')
    }

    # STEP 1
    # Create the data frame
    biomes_df <- data.frame(
      mat = c(29.339, 13.971, 15.371, 17.510, 24.131, 27.074, 28.915, 29.201, 29.339, 13.971, -9.706, -7.572,  4.491, 17.510,
              15.371, 13.971, 17.510,  4.491, -7.572, -9.706, -6.687, -0.949,  3.098,  7.147, 10.165, 13.918, 18.626, 18.176,
              17.510, 18.626, 13.918, 10.165,  7.147,  3.098, -0.949,  1.039,  1.998,  2.444,  3.118,  4.446,  7.758, 12.614,
              18.720, 18.637, 18.626, -0.949, -6.687, -4.395, -4.098, -1.592,  0.914,  4.155,  3.118,  2.444,  1.998,  1.039,
              -0.949, 18.720, 12.614,  7.758,  4.446,  3.118,  4.155, 15.716, 20.136, 19.392, 18.720, 18.720, 19.392, 20.136,
              22.278, 23.756, 24.199, 24.714, 25.667, 26.105, 27.414, 27.772, 25.709, 21.736, 18.720, 17.510, 18.176, 18.626,
              18.637, 18.720, 21.736, 25.709, 27.772, 28.418, 28.915, 27.074, 24.131, 17.510, -6.687, -8.896, -9.706, -13.382,
              -15.366, -15.217, -8.373, -4.098, -1.592, -4.098, -4.395, -6.687),
      map = c(21.3,  23.0, 174.6, 535.1, 702.9, 847.9, 992.4, 532.1,  21.3,  23.0,  7.3,  87.2, 314.6, 535.1, 174.6,  23.0,
              535.1, 314.6,  87.2,   7.3, 202.6, 391.7, 529.9, 783.1, 956.9,1116.5,1269.3, 794.3, 535.1,1269.3,1116.5, 956.9,
              783.1, 529.9, 391.7, 514.8, 673.4, 968.5,1630.6,1839.7,2028.0,2224.0,2355.7,1837.6,1269.3, 391.7, 202.6, 922.9,
              1074.1,1405.9,1744.9,2012.3,1630.6, 968.5,673.4, 514.8, 391.7,2355.7,2224.0,2028.0,1839.7,1630.6,2012.3,2930.1,
              3377.7,2917.0,2355.7,2355.7,2917.0,3377.7,3896.5,4343.1,4415.2,4429.8,4279.0,4113.7,3344.4,2790.6,2574.0,2414.3,
              2355.7, 535.1, 794.3,1269.3,1837.6,2355.7,2414.3,2574.0,2790.6,1920.3, 992.4, 847.9, 702.9, 535.1, 202.6,  50.8,
              7.3,  34.8,  98.8, 170.8, 533.0,1074.1,1405.9,1074.1, 922.9, 202.6),
      biome = c(rep('Subtropical desert', 9), rep('Temperate grassland desert', 7), rep('Mediterranean', 13),
                rep('Temperate forest', 16), rep('Boreal forest', 12), rep('Temperate rain forest', 10),
                rep('Tropical rain forest', 14), rep('Tropical forest savanna', 13), rep('Tundra', 12))
    )

    # STEP 2
    # Merge deserts if specified
    if (merge_deserts){

      biome <- as.character(biomes_df$biome)

      biome[grepl('desert', biome, fixed = TRUE)] <- 'Desert'

      biomes_df$biome <- as.factor(biome)

    }

    # STEP 3
    # Create SpatialPolygonsDataFrame object
    list_pol <- sapply(as.character(unique(biomes_df$biome)),
                       function(id_biome,df)
                         sp::Polygon(cbind(df$map[df$biome == id_biome],
                                           df$mat[df$biome == id_biome])),
                       df=biomes_df, USE.NAMES = TRUE)

    sp_biomes <- sp::SpatialPolygons(
      lapply(1:length(list_pol),
             function(i, x) {sp::Polygons(list(x[[i]]),
                                          names(x)[i])},
             x = list_pol)
    )

    spdf_biomes <- sp::SpatialPolygonsDataFrame(sp_biomes, data.frame(biome = names(list_pol)),
                                                match.ID = 'biome')

    # STEP 4
    # Return SpatialPolygonsDataFrame object
    return(spdf_biomes)

    # END FUNCTION
  },

  # handlers
  warning = function(w){logging::logwarn(w$message,
                                         logger = paste(parent_logger, 'qc_get_biomes_spdf', sep = '.'))},
  error = function(e){logging::logerror(e$message,
                                        logger = paste(parent_logger, 'qc_get_biomes_spdf', sep = '.'))},
  message = function(m){logging::loginfo(m$message,
                                         logger = paste(parent_logger, 'qc_get_biomes_spdf', sep = '.'))})

}

################################################################################
#' Get the biome, temperature and precipitation of a site
#'
#' This function takes a data frame of site metadata, including latitude (si_lat)
#' and longitude (si_long) columns, gets climatic data from WorldClim 1.4
#' using the GSODR package and
#' returns the same data frame with extra columns of mean annual temperature
#' (si_mat), mean annual precipitation (si_map) and biome (si_biome) according to
#' \code{\link{qc_get_biomes_spdf}}.
#'
#' @family Quality Checks Functions
#'
#' @param data Data frame of site metadata, including latitude (si_lat)
#'    and longitude (si_long) columns that are used to obtain climatic data.
#'
#' @param merge_deserts Logical indicating if desert biomes should be merged
#'    in a single biome. By default, deserts are not merged.
#'
#' @return The same data frame with extra columns of mean annual temperature
#'    (si_mat), mean annual precipitation (si_map) and biome (si_biome)
#'
#' @export

# START
# Function declaration
qc_get_biome <- function(data, merge_deserts = FALSE, parent_logger = 'test') {

  # Using calling handlers to logging
  withCallingHandlers({

    # STEP 0
    # Argument checks
    # Is data a data.frame?
    if (!is.data.frame(data)) {
      stop('Provided data object is not a data frame.',
           ' Please verify if it is the correct object')
    }
    # Does data contains a longitude variable?
    if (is.null(data$si_long)) {
      stop('There is no longitude variable in this dataset. ',
           'Please verify if it is the correct data')
    }
    # Does data contains a latitude variable?
    if (is.null(data$si_lat)) {
      stop('There is no latitude variable in this dataset. ',
           'Please verify if it is the correct data')
    }
    # Is merge_deserts logical?
    if (!(is.logical(merge_deserts))) {
      stop('merge_deserts must be logical')
    }
    # Is merge_deserts NA?
    if (is.na(merge_deserts)) {
      stop('merge_deserts must be either TRUE or FALSE')
    }

    # STEP 1
    # Get the nearest stations from the site coordinates. We look at 50 km radius,
    # if not stations are found, rise the radius to 100 km
    sts <- purrr::map2(data$si_lat, data$si_long,
                       function(x, y) {
                         st_tmp <- GSODR::nearest_stations(x, y, distance = 50)
                         if (length(st_tmp) < 1) {
                           st_tmp <- GSODR::nearest_stations(x, y, distance = 100)
                         }
                         if (length(st_tmp) < 1) {
                           return(NA)
                         } else {
                           return(st_tmp)
                         }

                       })

    # 1.1 If no nearest stations, return the data and a warning
    if (all(is.na(sts))) {
      data$si_mat <- NA
      data$si_map <- NA
      data$si_biome <- 'Unknown'

      warning('No nearest statiosn found to calculate the biome')
      return(data)
    }

    # STEP 2
    # Calculate MAT and MAP values
    data("WorldClim_Bio", package = 'GSODRdata')
    t_site <- purrr::map_dbl(
      sts, ~ round(mean(WorldClim_Bio[WorldClim_Bio$STNID %in% .x, c('bio1')]), 1)
    )
    t_site <- t_site/10

    p_site <- purrr::map_dbl(
      sts, ~ round(mean(WorldClim_Bio[WorldClim_Bio$STNID %in% .x, c('bio12')]), 1)
    )

    # STEP 3
    # Obtain biome
    clim_point <- sp::SpatialPoints(data.frame(x = p_site, y = t_site))
    biome <- sp::over(clim_point, qc_get_biomes_spdf(merge_deserts = merge_deserts))[[1]]

    # STEP 4
    # Append new variables and return the data frame
    # 3.1 Append MAT, MAP and biome to data
    data$si_mat <- t_site
    data$si_map <- p_site
    data$si_biome <- droplevels(biome)

    # 3.2 Return data with the new variable
    return(data)

    # END FUNCTION
  },

  # handlers
  warning = function(w){logging::logwarn(w$message,
                                         logger = paste(parent_logger, 'qc_get_biome', sep = '.'))},
  error = function(e){logging::logerror(e$message,
                                        logger = paste(parent_logger, 'qc_get_biome', sep = '.'))},
  message = function(m){logging::loginfo(m$message,
                                         logger = paste(parent_logger, 'qc_get_biome', sep = '.'))})

}