join_all.R

#' @title Join study details into main `traits` dataset
#' @description Function to append all study information (method, location, taxonomic, context) variables into trait database
#' @param austraits dataframe generated by austraits build
#' @param ... arguments passed to `vars` to subset the columns
#' @return austraits list object, but with additional variables appended to `traits` dataframe
#' @rdname join_all

#' @examples
#' \dontrun{
#' austraits$traits
#' 
#' #Append locations data
#' (austraits %>% join_locations)$traits
#'
#' #Append contexts
#' (austraits %>% join_contexts)$traits
#' 
#' # Append methods
#' (austraits %>% join_methods(vars = c("method_id")))$traits
#' 
#' #Append taxonomic details
#' (austraits %>% join_taxonomy)$traits
#' 
#' #Append all information
#' (austraits %>% join_all)$traits
#' }
#' @author Daniel Falster - daniel.falster@unsw.edu.au
#' @export


join_all <- function(austraits) {
  austraits %>% 
    join_locations() %>% 
    join_taxonomy() %>% 
    join_methods()
}

#' @title Joining taxonomic information to traits table
#' @export

#' @rdname join_all

join_taxonomy <- function(austraits, ...) {
  # Switch for different versions
  version <- what_version(austraits)
  
  if(what_version(austraits) %in% c("4-series", "5-series")){
    version <- "new" 
  } else
    version <- "old"
  
  switch (version,
          'new' = join_taxonomy2(austraits, ...),
          'old' = join_taxonomy1(austraits, ...),
  )
}

#' @title  Joining taxonomic info for AusTraits versions <= 3.0.2
#' @noRd
#' @keywords internal

join_taxonomy1 <- function(austraits, vars =  c("family", "genus", "taxonRank", "acceptedNameUsageID")) {
  austraits$traits <- austraits$traits %>%
    dplyr::left_join(by="taxon_name", austraits$taxa %>% dplyr::select("taxon_name", tidyselect::any_of(vars)))
  
  austraits
}

#' @title Joining taxonomic info for AusTraits versions > 3.0.2
#' @noRd
#' @keywords internal

join_taxonomy2 <- function(austraits, vars =  c("family", "genus", "taxon_rank", "establishment_means")) {
  austraits$traits <- austraits$traits %>%
    dplyr::left_join(by="taxon_name", austraits$taxa %>% dplyr::select("taxon_name", tidyselect::any_of(vars)))
  
  austraits
}

#' @title Joining methodological information to traits table

#' @export
#' @rdname join_all

join_methods <- function(austraits, ...) {
  
  # Switch for different versions
  version <- what_version(austraits)
  
  if(what_version(austraits) == "5-series"){
    version <- "new" 
  } else
    version <- "old"
  
  switch (version,
          'new' = join_methods2(austraits, ...),
          'old' = join_methods1(austraits, ...),
  )
}

#' @title Joining methods info for AusTraits versions > 3.0.2
#' @noRd
#' @keywords internal
join_methods2 <- function(austraits, vars =  c("methods", "year_collected_start", "year_collected_end", "collection_type")) {
  austraits$methods %>% 
    dplyr::select(c("dataset_id", "trait_name", "method_id"), tidyselect::any_of(vars)) %>% 
    dplyr::distinct() -> methods
  
  austraits$traits <- austraits$traits %>%
    dplyr::left_join(by=c("dataset_id", "trait_name", "method_id"),
                     methods, relationship = "many-to-many")
  
  austraits
}

#' @title Joining methods info for AusTraits versions<== 3.0.2
#' @noRd
#' @keywords internal
join_methods1 <- function(austraits, vars =  c("methods", "year_collected_start", "year_collected_end", "collection_type")) {
  austraits$methods %>% 
    dplyr::select(c("dataset_id", "trait_name"), tidyselect::any_of(vars)) %>% 
    dplyr::distinct() -> methods
  
  austraits$traits <- austraits$traits %>%
    dplyr::left_join(by=c("dataset_id", "trait_name"),
                     methods, relationship = "many-to-many")
  
  austraits
}
#' @title Joining location information to traits table
#' @export

#' @rdname join_all

join_locations <- function(austraits, ...) {
  # Switch for different versions
  version <- what_version(austraits)
  
  if(what_version(austraits) %in% c("4-series", "5-series")){
    version <- "new" 
  } else
    version <- "old"
  
  switch (version,
          'new' = join_locations2(austraits, ...),
          'old' = join_locations1(austraits, ...),
  )
}


#' @title  Joining location info for AusTraits versions <= 3.0.2
#' @noRd
#' @keywords internal
join_locations1 <- function(austraits, vars =  c("longitude (deg)","latitude (deg)")) {
  
  sites <- 
    austraits$sites %>% 
    dplyr::filter(site_property %in%  vars) %>% 
    tidyr::pivot_wider(names_from = site_property, values_from = value)
  
  austraits$traits <- austraits$traits %>%
    dplyr::left_join(by=c("dataset_id", "site_name"), sites)
  
  austraits
}

#' @title  Joining location info for AusTraits versions <= 3.0.2
#' @description `r lifecycle::badge('deprecated')`
#' Joining location info for AusTraits versions <= 3.0.2
#' @param austraits austraits object
#' @param vars  variables from site table to join 
#' @export

join_sites <- function(austraits, vars =  c("longitude (deg)","latitude (deg)")) {
  .Deprecated("join_locations")
  
  join_locations1(austraits, vars =  c("longitude (deg)","latitude (deg)"))
}

#' @title  Joining location info for AusTraits versions > 3.0.2
#' @noRd
#' @keywords internal
join_locations2 <- function(austraits, vars =  c("longitude (deg)","latitude (deg)")) {
  sites <- 
    austraits$locations %>% 
    dplyr::filter(location_property %in%  vars) %>% 
    tidyr::pivot_wider(names_from = location_property)
  
  austraits$traits <- austraits$traits %>%
    dplyr::left_join(by=c("dataset_id", "location_id"), sites)
  
  austraits
}


#' @export
#' @rdname join_all

join_contexts <- function(austraits,...){
  # Switch for different versions
  version <- what_version(austraits)
  
  if(what_version(austraits) %in% c("4-series", "5-series")){
    version <- "new" 
  } else
    version <- "old"
  
  switch (version,
          'new' = join_contexts2(austraits, ...),
          'old' = join_contexts1(austraits, ...),
  )
}

#' @title  Joining location info for AusTraits versions > 3.0.2
#' @noRd
#' @keywords internal
join_contexts2 <- function(austraits, collapse_context = FALSE){

  traits2 <- split(austraits$traits, austraits$traits$dataset_id)
  contexts2 <- split(austraits$contexts, austraits$contexts$dataset_id)
  
  traits_vars <- names(austraits$traits)

  problem_studies <- c("Hall_1981")

  for(id in names(traits2)) {
  
    if(!is.null(contexts2[[id]][1]) & ! (id %in% problem_studies)) {
    
      context_ids <- 
        unique(contexts2[[id]]$link_id)
  
      for(v in context_ids[!is.na(context_ids)]) {
        
        context_sub <- 
          contexts2[[id]] %>%
          dplyr::select(-dplyr::any_of(c("category", "description"))) %>%
          dplyr::filter(link_id == v) %>% 
          tidyr::separate_rows(link_vals) %>% 
          tidyr::pivot_wider(values_from = value, names_from = context_property) %>%
          tidyr::pivot_wider(names_from = link_id, values_from = link_vals)
        
        traits2[[id]] <- 
          dplyr::left_join(by = c("dataset_id", v),
                    traits2[[id]],
                    context_sub
          )
      }
      
      if(collapse_context == TRUE){
        context_text <-
          traits2[[id]] %>% 
          dplyr::select(-dplyr::any_of(traits_vars)) %>% collapse_cols()

        traits2[[id]] <- traits2[[id]] %>% 
          dplyr::mutate(context = context_text) %>% 
          dplyr::select(dplyr::any_of(traits_vars), context)
      }
    }
  }

  austraits$traits <- traits2 %>% dplyr::bind_rows()

  austraits
}

#' @title  Joining contexts info for AusTraits versions <= 3.0.2
#' @noRd
#' @keywords internal

join_contexts1 <- function(austraits) {
  
  if(nrow(austraits$contexts) == 0)
    return (austraits)
  
  contexts <- 
    austraits$contexts %>% 
    tidyr::pivot_wider(names_from = context_property, values_from = value)
  
  austraits$traits <- austraits$traits %>%
    dplyr::left_join(by=c("dataset_id", "context_name"), contexts)
  
  austraits
}