R/kelp.R

Defines functions list2df kelp_metadata kelp_datasets kelp_citation process_kelp print.kelp is_kelp_meta is_kelp_data kelp_GET kelp

Documented in kelp kelp_datasets kelp_metadata

#' Get Kelp forest community data.
#'
#' @export
#' @param dataset A dataset code name, see \code{\link{kelp_datasets}}
#' @param path A path to store the files, Default: \code{~/.ots/kelp}
#' @param overwrite (logical) To overwrite the path to store files in or not, Default: TRUE.
#' @param name Metadata table name
#' @details After one download o the dataset, you won't have to download the data again.
#'
#' The \code{kelp} function is to get datasets, e.g., benthic cover data. The output of each call
#' to \code{kelp} includes the data, and both the headers and variables metadata tables for that
#' dataset. In addition, the citation to the data is included. See examples below for how to index
#' to each of those.
#'
#' The \code{kelp_datasets} function simply lists the datasets available. You can pass the code
#' to \code{kelp}.
#'
#' The \code{kelp_metadata} function is to both list the metadata tables available, and to retrieve
#' those metadata tables, including: sites, data_updates, metadata_updates, history, and species.
#' @references \url{http://esapubs.org/archive/ecol/E094/245/metadata.php}
#' @examples \dontrun{
#' # list of datasets
#' kelp_datasets()
#'
#' # read in various metadata files
#' ## list metadata tables
#' kelp_metadata()
#' ## get a table
#' head( kelp_metadata("sites") )
#' head( kelp_metadata("data_updates") )
#' head( kelp_metadata("metadata_updates") )
#' head( kelp_metadata("history") )
#' head( kelp_metadata("species") )
#'
#' # get data
#' (res <- kelp("benthic_cover"))
#' head(res$headers)
#' head(res$vars)
#' res$citation
#'
#' (res <- kelp("benthic_density"))
#' (res <- kelp("fish_density"))
#' (res <- kelp("fish_size"))
#' (res <- kelp("invert_size"))
#' head(res$headers)
#' (res <- kelp("subtidal"))
#' (res <- kelp("rdfc"))
#' (res <- kelp("kelp_size"))
#' (res <- kelp("kelp_supp_dens"))
#' (res <- kelp("art_recruit"))
#' }

kelp <- function(dataset='benthic_cover', path = "~/.ots/kelp", overwrite = TRUE)
{
  if(!is_kelp_data(path.expand(file.path(path, "data"))) ||
       !is_kelp_meta(path.expand(file.path(path, "metadata")))){
    kelp_GET(path, "data/", dataurl, overwrite) # get data
    kelp_GET(path, "metadata/", metadataurl, overwrite) # get metadata
  }

  out <- process_kelp(x=dataset, base=path)
  structure(out, class="kelp")
}

dataurl <- 'http://esapubs.org/archive/ecol/E094/245/KushnerEtAl2013-KFM-Data.zip'
metadataurl <- 'http://esapubs.org/archive/ecol/E094/245/KushnerEtAl2013-KFM-Metadata.zip'

kelp_GET <- function(bp, wh="data/", url, overwrite){
  dir.create(bp, showWarnings = FALSE, recursive = TRUE)
  fp <- file.path(bp, "kelp.zip")
  res <- GET(url, write_disk(fp, overwrite))
  stop_for_status(res)
  untar(fp, exdir = path.expand(file.path(bp, wh)))
}

is_kelp_data <- function(x){
  if(identical(list.files(x), character(0))){ FALSE } else {
    if(all(list.files(x) %in% unlist(unname(kelp_files)))) TRUE else FALSE
  }
}

is_kelp_meta <- function(x){
  if(identical(list.files(x), character(0))){ FALSE } else {
    if(all(list.files(x) %in% allmetafiles)) TRUE else FALSE
  }
}

#' @export
print.kelp <- function(x, ..., n = 10){
  cat(sprintf("<Kelp data>"), sep = "\n")
  cat("Dataset headers: output$headers", sep = "\n")
  cat("Dataset variables: output$vars\n", sep = "\n")
  trunc_mat(x$data, n = n)
}

process_kelp <- function(x, base){
  dget <- file.path(base, "data", kelp_files[ names(kelp_files) %in% x ][[1]])
  hget <- file.path(base, "metadata", kelp_hfiles[ names(kelp_hfiles) %in% x ][[1]])
  vget <- file.path(base, "metadata", kelp_vfiles[ names(kelp_vfiles) %in% x ][[1]])
  list(citation=kelp_citation(), vars=read_csv(vget), headers=read_csv(hget), data=read_csv(dget))
}

kelp_citation <- function(){
  structure('David J. Kushner, Andrew Rassweiler, John P. McLaughlin, and Kevin D. Lafferty. 2013.
A multi-decade time series of kelp forest community structure at the California Channel
Islands. Ecology 94:2655. http://dx.doi.org/10.1890/13-0562.1', class="citations")
}

kelp_files <- structure(list(
  "Artifical recruitment module data.csv",
  "Benthic Cover Data.csv",
  "Benthic Density Data.csv",
  "DiverList_1982-2011.csv",
  "Fish Density Data.csv",
  "Fish size frequency data.csv",
  "Giant kelp size frequency.csv",
  "Giant kelp supplementary density data.csv",
  "Invertebrate Size Frequency.csv",
  "RDFC data.csv",
  "Subtidal temperature data.csv"),
  names = c('art_recruit','benthic_cover','benthic_density','diverlist','fish_density','fish_size',
            'kelp_size','kelp_supp_dens','invert_size','rdfc','subtidal')
)

kelp_hfiles <- structure(list(
  'Table10A_RDFC_headers.csv',
  'Table12A_fish_size_frequency_headers.csv',
  'Table13A_invertebrate_size_frequency_headers.csv',
  'Table14A_giant_kelp_size_frequency_headers.csv',
  'Table15A_giant_kelp_supplementary_density_headers.csv',
  'Table16A_artificial_recruitment_module_headers.csv',
  'Table17A_subtidal_temperature_headers.csv',
  'Table4A_benthic_density_headers.csv',
  'Table7A_benthic_cover_headers.csv',
  'Table9A_fish_density_headers.csv'),
  names = c('rdfc','fish_size','invert_size','kelp_size','kelp_supp_dens','art_recruit',
            'subtidal','benthic_density','benthic_cover','fish_density')
)

kelp_vfiles <- structure(list(
  'Table10B_RDFC_variables.csv',
  'Table12B_fish_size_frequency_variables.csv',
  'Table13B_invertebrate_size_frequency_variables.csv',
  'Table14B_giant_kelp_size_frequency_variables.csv',
  'Table15B_giant_kelp_supplementary_density_variables.csv',
  'Table16B_artificial_recruitment_module_variables .csv',
  'Table17B_subtidal_temperature_variables.csv',
  'Table4B_benthic_density_variables.csv',
  'Table7B_benthic_cover_variables.csv',
  'Table9B_fish_density_variables.csv'),
  names = c('rdfc','fish_size','invert_size','kelp_size','kelp_supp_dens','art_recruit',
            'subtidal','benthic_density','benthic_cover','fish_density')
)

kelp_others <- structure(list(
  'Table1_Monitoring_sites.csv',
  'Table18A_data_updates.csv',
  'Table18B_metadata_updates.csv',
  'Table2_History_of_fishing_restrictions.csv',
  'Table3_Species_monitored.csv'),
  names = c('sites','data_updates','metadata_updates','history','species')
)

allmetafiles <- c(
  'Table1_Monitoring_sites.csv',
  'Table10A_RDFC_headers.csv',
  'Table10B_RDFC_variables.csv',
  'Table12A_fish_size_frequency_headers.csv',
  'Table12B_fish_size_frequency_variables.csv',
  'Table13A_invertebrate_size_frequency_headers.csv',
  'Table13B_invertebrate_size_frequency_variables.csv',
  'Table14A_giant_kelp_size_frequency_headers.csv',
  'Table14B_giant_kelp_size_frequency_variables.csv',
  'Table15A_giant_kelp_supplementary_density_headers.csv',
  'Table15B_giant_kelp_supplementary_density_variables.csv',
  'Table16A_artificial_recruitment_module_headers.csv',
  'Table16B_artificial_recruitment_module_variables .csv',
  'Table17A_subtidal_temperature_headers.csv',
  'Table17B_subtidal_temperature_variables.csv',
  'Table18A_data_updates.csv',
  'Table18B_metadata_updates.csv',
  'Table2_History_of_fishing_restrictions.csv',
  'Table3_Species_monitored.csv',
  'Table4A_benthic_density_headers.csv',
  'Table4B_benthic_density_variables.csv',
  'Table7A_benthic_cover_headers.csv',
  'Table7B_benthic_cover_variables.csv',
  'Table9A_fish_density_headers.csv',
  'Table9B_fish_density_variables.csv')

#' @export
#' @rdname kelp
kelp_datasets <- function() list2df(kelp_files)

#' @export
#' @rdname kelp
kelp_metadata <- function(name = NULL, path = "~/.ots/kelp"){
  if(is.null(name)){ list2df(kelp_others) } else {
    pp <- file.path(path, "metadata", kelp_others[ names(kelp_others) %in% name ][[1]])
    read_csv(pp)
  }
}

list2df <- function(x){
  data.frame(code=names(x), file=unname(unlist(x)), stringsAsFactors = FALSE)
}
ropensci/ots documentation built on Sept. 12, 2022, 2:01 p.m.