R/get-ids-fishbase.R

Defines functions get_ids_fishbase get_fcs_fishbase get_info_fishbase split_species

Documented in get_ids_fishbase

#' Extract fishbase IDs using the package "rfishbase" to generate species specific fishbase URLs
#'
#' This function extracts fishbase IDs using the database provided by the \code{rfishbase} package.
#' @inheritParams get_growth_fishbase
#' @return named vector with species names and fishbase IDs.
#'
#' @details The function depends on the package "rfishbase" which creates a local copy of the fishbase database.
#' The IDs are needed to generate URLs to scan www.fishbase.se for detailed informations about fish growth for example.
#' @keywords gen
#' @examples
#' fish <- c("Gadus morhua", "Merlangius merlangus", "Clupea harengus")
#' get_ids_fishbase(fish)
#' @export

get_ids_fishbase <- function(fish){
  pos <- get_info_fishbase(fish = fish)
  res <- atlantistools::fishbase_data$SpecCode[pos]
  names(res) <- names(pos)

  return(res)
}

get_fcs_fishbase <- function(fish){
  pos <- get_info_fishbase(fish = fish)
  res <- atlantistools::fishbase_data$FamCode[pos]
  names(res) <- names(pos)

  return(res)
}

get_info_fishbase <- function(fish) {
  # Check if every fishname is composed of genus and species!
  if (any(vapply(stringr::str_split(fish, pattern = " "), length, FUN.VALUE = integer(1)) < 2)) stop("Fishnames not complete.")

  ge_sp <- split_species(fish)

  # get fishbase ids
  pos <- purrr::map2(.x = ge_sp$ge, .y = ge_sp$sp, ~atlantistools::fishbase_data$Genus == .x & atlantistools::fishbase_data$Species == .y)

  # report species not found in database
  missing <- purrr::map_int(pos, sum) == 0
  if (sum(missing >= 1)) {
    warning(paste("The following species are not part of the fishbase dataframe", paste(fish[missing], collapse = ", ")))
    fish <- fish[!missing]
    pos <- pos[!missing]
  }

  pos <- purrr::map_int(pos, which)
  names(pos) <- fish

  return(pos)
}

split_species <- function(fish) {
  result <- stringr::str_split_fixed(fish, pattern = " ", n = 2)
  result <- list(ge = result[, 1], sp = result[, 2])
  return(result)
}

Try the atlantistools package in your browser

Any scripts or data that you put into this service are public.

atlantistools documentation built on Aug. 16, 2017, 9:05 a.m.