Nothing
#' Transform fieldbooks based in a dictionary
#'
#' Transform entire fieldbook according to data a dictionary
#'
#' @param fieldbook Data frame with the original information.
#' @param dictionary Data frame with new names and categories. See details.
#' @param from Column of the dictionary with the original names.
#' @param to Column of the dictionary with the new names.
#' @param index Column of the dictionary with the type and level of the
#' variables.
#' @param colnames Character vector with the name of the columns.
#'
#' @details
#'
#' The function require at least three columns.
#'
#' 1. Original names (\code{from}).
#'
#' 2. New names (\code{to}).
#'
#' 3. Variable type (\code{index}).
#'
#' @return List with two objects. 1. New data frame. 2. Dictionary.
#'
#' @importFrom dplyr mutate_all starts_with sym vars filter rename_at mutate_at
#' @importFrom purrr as_vector
#' @importFrom tidyr drop_na
#' @importFrom tibble as_tibble
#' @importFrom graphics hist
#' @importFrom stats qqline qqnorm resid sd vcov
#'
#' @export
#'
metamorphosis <- function(fieldbook
, dictionary
, from
, to
, index
, colnames
){
# Import dictionary -------------------------------------------------
dictionary_used <- dictionary %>%
tidyr::drop_na(from) %>%
dplyr::mutate_all(as.character)
# column names ------------------------------------------------------------
rename_colums <- function(fieldbook, dictionary, from, to, index, colnames) {
cln <- dictionary %>%
dplyr::filter(!!sym(index) %in% colnames) %>%
dplyr::select(from, to) %>%
tidyr::drop_na(from)
old_names <- cln %>%
dplyr::select(from) %>%
purrr::as_vector()
new_names <- cln %>%
dplyr::select(to) %>%
purrr::as_vector()
fbr <- fieldbook %>%
dplyr::rename_at(vars(old_names), ~ new_names)
fbr
}
fb_renamed <- rename_colums(fieldbook, dictionary_used, from, to, index, colnames)
# Recode the variable levels ----------------------------------------------
rename_levels <- function(fb_renamed, dictionary, from, to, index, colnames, variable){
# variable levels
vrl <- dictionary %>%
dplyr::filter(!(!!sym(index)) %in% colnames)
# Check if variable exist
colums_to_recode <- dictionary %>%
dplyr::filter(!(!!sym(index)) %in% colnames) %>%
dplyr::select(index) %>%
base::unique() %>%
purrr::as_vector()
if(is.element(variable, colums_to_recode) == FALSE){
rnf <- fb_renamed %>%
dplyr::select(variable)
rnf
} else {
# Old variable names
old_v <- vrl %>%
dplyr::filter(!!sym(index) == variable) %>%
dplyr::select(from) %>%
purrr::as_vector()
# New variable names
new_v <- vrl %>%
dplyr::filter(!!sym(index) == variable) %>%
dplyr::select(to) %>%
purrr::as_vector()
# Lista variables to recode
rnm <- structure(as.character(new_v),
names = as.character(old_v))
# Recode one variable
rnf <- fb_renamed %>%
dplyr::mutate_at(variable, list(~recode(., !!!rnm))) %>%
dplyr::select(variable)
rnf
}
}
# Recode all the variables in the data frame
fb_recoded <- lapply(1:ncol(fb_renamed), function(x) {
fb_renamed %>%
rename_levels(., dictionary_used, from, to, index, colnames, variable = colnames(.)[x])
})
# Unite the lists ---------------------------------------------------------
fb_recoded <- do.call(cbind, fb_recoded) %>%
tibble::as_tibble()
# Extract used dictionary -------------------------------------------------
vrl <- dictionary %>%
tidyr::drop_na(from) %>%
dplyr::filter(!!sym(index) %in% colnames) %>%
dplyr::select(to) %>%
base::unique() %>%
unlist() %>%
purrr::as_vector()
dictionary_all <- dictionary %>%
dplyr::mutate_all(as.character) %>%
dplyr::filter(!!sym(to) %in% vrl | !!sym(index) %in% vrl)
# Result ------------------------------------------------------------------
list(
dictionary = dictionary_all,
fieldbook = fb_recoded
)
}
Any scripts or data that you put into this service are public.
Add the following code to your website.
For more information on customizing the embed code, read Embedding Snippets.