#' Translate factors into their meanings
#'
#' @param df Data frame
#' @param eml eml metadata
#' @param keep Whether to keep the columns with codes. If FALSE, the meanings replace the factors previous codes.
#' @param which_table for which table to retrieve the factors, if there are several tables (entityName)
#'
#' @return A data.frame with translated factors
#' @export
#'
#' @examples
#' data("animals_eml")
#' data("animals_data")
#' eml_translate_factors(df = animals_data, eml = animals_eml, keep = FALSE)
#' eml_translate_factors(df = animals_data, eml = animals_eml, keep = TRUE)
#'
eml_translate_factors <- function(df, eml, keep = FALSE,
which_table = NULL){
if(is.null(which_table)){
df_factor <- as.data.frame(EML::eml_get(eml, "attributeList")$factors)
}else{
dt <- EML::eml_get(eml, "dataTable")
names <- vapply(dt, get_name, "")
which_table <- which(names == which_table)
attrs <- EML::eml_get(dt[[which_table]], "attributeList")
df_factor <- as.data.frame(attrs$factors)
}
names_factors <- unique(df_factor$attributeName)
names_factors <- names_factors[names_factors %in% names(df)]
names_factors <- as.character(names_factors)
for(name in names_factors){
df <- eml_translate_one_factor(name, df = df,
df_factor = df_factor,
keep = keep)
}
return(df)
}
eml_translate_one_factor <- function(name, df, df_factor, keep){
df_factor <- dplyr::filter_(df_factor, lazyeval::interp(~ attributeName == name))
df_factor <- dplyr::select_(df_factor, quote(- attributeName))
if(keep){
df[[name]] <- as.character(df[[name]])
df_factor <- dplyr::rename_(df_factor, .dots=setNames("definition", paste0(name, "_meaning")))
df <- suppressWarnings(dplyr::left_join(df, df_factor, by = setNames("code", name)))
}else{
df_factor <- dplyr::rename_(df_factor, .dots=setNames("definition", name))
df <- dplyr::rename_(df, .dots=setNames(name, "code"))
df <- dplyr::mutate_(df, code = lazyeval::interp(~ as.character(code)))
df <- suppressWarnings(dplyr::left_join(df, df_factor, by = setNames("code", "code")))
df <- dplyr::select_(df, quote(- code))
}
return(df)
}
get_name <- function(table){
EML::eml_get(table, "entityName")
}
Add the following code to your website.
For more information on customizing the embed code, read Embedding Snippets.