diff --git a/DESCRIPTION b/DESCRIPTION index 15b9bd3..42d6720 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -1,7 +1,7 @@ Package: transcats Type: Package Title: Translate Categorical Data Using Translation Tables -Version: 0.0.0.9004 +Version: 0.0.0.9005 Authors@R: person( "Carwil", "Bjork-James", diff --git a/NAMESPACE b/NAMESPACE index 0ca4623..d2986bb 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -7,6 +7,7 @@ export(create_blank_translation_table) export(create_blank_translation_tables) export(dest_lang) export(dest_lang_list) +export(get_translation_variables) export(parse_combined_translation_table) export(reactable_lang_en) export(reactable_lang_es) @@ -21,12 +22,14 @@ export(title_lang) export(translated_join) export(translated_join_vars) export(translated_levels) +export(translation_available_for) export(var_lang) export(var_lang_str) export(var_name_language_available) export(variable_name) export(variable_name_from_string) export(variable_names_vector) +export(which_translation_available) importFrom(assertthat,is.string) importFrom(dplyr,all_of) importFrom(dplyr,filter) @@ -36,6 +39,7 @@ importFrom(dplyr,slice) importFrom(fs,path_package) importFrom(lifecycle,deprecated) importFrom(magrittr,"%>%") +importFrom(rlang,.data) importFrom(rlang,as_label) importFrom(rlang,enquo) importFrom(stats,setNames) diff --git a/R/data.R b/R/data.R index 81ada47..2b148b6 100644 --- a/R/data.R +++ b/R/data.R @@ -66,6 +66,18 @@ #' @source Created as part of `transcats` "gss_var_table" +#' Translation table for gss_cat +#' +#' A translation table for the variable gss_cat, a data source from the +#' General Social Survey that is included in the package `forcats` +#' and used for examples in `transcats`. +#' +#' @format ## `gss_translation` +#' A list of tibbles, each with three columns named "en", "es", "fr". +#' Their names correspond to the categorical variables involved: +#' `marital`, `race`, `rincome`, `partyid`, `relig`, `denom`. +"gss_translation" + #' State Responsibility Levels #' #' A vector ordering the levels for the variable `state_responsibility` in diff --git a/R/transcats-package.R b/R/transcats-package.R index e181979..b245454 100644 --- a/R/transcats-package.R +++ b/R/transcats-package.R @@ -10,6 +10,7 @@ #' @importFrom dplyr slice #' @importFrom fs path_package #' @importFrom lifecycle deprecated +#' @importFrom rlang .data #' @importFrom rlang as_label #' @importFrom rlang enquo #' @importFrom stats setNames diff --git a/R/translation-available.R b/R/translation-available.R new file mode 100644 index 0000000..e8fe71d --- /dev/null +++ b/R/translation-available.R @@ -0,0 +1,173 @@ +#' Check whether translations are available for all values in a vector/column +#' +#' @description +#' `translation_available_for` checks if the values in a vector or +#' column to see which have translations available in the +#' translation table. +#' +#' `num_translation_available` returns the number of values +#' that have translations available, from zero to +#' length(unique(vector)). +#' +#' `all_translation_available_for` checks if all values in the vector +#' have translations available in the translation table. +#' +#' `which_translation_unavailable_for` returns a vector with the values +#' that do not have translations available in the translation table. +#' +#' @param dataframe A vector or dataframe to be checked. If a dataframe, +#' it should contain the variable specified in `variable`. +#' @param variable_name The name of the variable to be checked, as a string. +#' @param translation_table A translation table, by default +#' this is the active translation table. +#' @param dest_lang The destination language code, by default +#' this is the current source language, set by set_dest_lang(). +#' @param source_lang The source language code, by default +#' this is the current source language, set by set_source_lang(). +#' @param verbose If TRUE, prints messages about the process. +#' +#' @returns A list of values with available translation +#' +#' @export +translation_available_for <- function(dataframe, variable_name, + translation_table = tcats$translation_table, + dest_lang = tcats$dest_lang, + source_lang = tcats$source_lang, + verbose = FALSE){ + if (!is.character(variable_name) || length(variable_name) != 1) { + stop("The variable name must be a single string.") + } + if (is.data.frame(dataframe)) { + vector <- dataframe[[variable_name]] + } else { + vector <- dataframe + } + if (!(variable_name %in% names(translation_table))) { + if (verbose) message("Variable not found in translation table.") + return(NULL) + } + var_trans_table <- purrr::pluck(translation_table, variable_name) + if (!(source_lang %in% names(var_trans_table))){ + if (verbose) message("Source language not found in translation table.") + return(NULL) + } + if (!(dest_lang %in% names(var_trans_table))){ + if (verbose) message("Destination language not found in translation table.") + return(NULL) + } + # Check if all values in the vector have a translation + if (is.null(vector) || length(vector) == 0) { + warning("No values to check for translation.") + return(NULL) + } + unique_values <- unique(vector) + intersect(unique_values, purrr::pluck(var_trans_table, source_lang)) +} + +#' @rdname translation_available_for +num_translation_available <- function(dataframe, variable_name, + translation_table = tcats$translation_table, + dest_lang = tcats$dest_lang, + source_lang = tcats$source_lang, + verbose = FALSE){ + translation_available_for(dataframe, variable_name, + translation_table = translation_table, + dest_lang = dest_lang, + source_lang = source_lang, + verbose = verbose) %>% + length() +} + +#' @rdname translation_available_for +all_translation_available_for <- function(dataframe, variable_name, + translation_table = tcats$translation_table, + dest_lang = tcats$dest_lang, + source_lang = tcats$source_lang, + verbose = FALSE) { + available_values <- translation_available_for(dataframe, variable_name, + translation_table = translation_table, + dest_lang = dest_lang, + source_lang = source_lang, + verbose = verbose) + unique_values <- unique(dataframe[[variable_name]]) + all(unique_values %in% translation_available_for(dataframe, variable_name, + translation_table = translation_table, + dest_lang = dest_lang, + source_lang = source_lang)) +} + +#' @rdname translation_available_for +which_translation_unavailable_for <- function(dataframe, variable_name, + translation_table = tcats$translation_table, + dest_lang = tcats$dest_lang, + source_lang = tcats$source_lang, + verbose = FALSE) { + unique_values <- unique(dataframe[[variable_name]]) + available_values <- translation_available_for(dataframe, variable_name, + translation_table = translation_table, + dest_lang = dest_lang, + source_lang = source_lang, + verbose = verbose) + unavailable_values <- setdiff(unique_values, available_values) + return(unavailable_values) +} + +#' Show values with available translations +#' +#' @description +#' `which_translation_available` returns the values for which +#' there is an available translation in the translation table. +#' +#' Note that unlike functions like `translation_available_for`, +#' `which_translation_available` does not check the values +#' within a dataframe or vector, but looks directly at the +#' translation table and returns all possible values that +#' can be translated. +#' +#' @param variable_name The name of the variable to be checked, +#' as a string. +#' @param translation_table A translation table, by default +#' this is the active translation table. +#' @param dest_lang The destination language code, by default +#' this is the current source language, set by set_dest_lang(). +#' @param source_lang The source language code, by default +#' this is the current source language, set by set_source_lang(). +#' @param verbose If TRUE, prints messages about the process. +#' +#' @returns A character vector with the values that have translations +#' available. +#' +#' @export +which_translation_available <- function(variable_name, + translation_table = tcats$translation_table, + dest_lang = tcats$dest_lang, + source_lang = tcats$source_lang, + verbose = FALSE) { + if (!is.character(variable_name) || length(variable_name) != 1) { + stop("The variable name must be a single string.") + } + if (!(variable_name %in% names(translation_table))) { + if (verbose) message("Variable not found in translation table.") + return(NULL) + } + + var_trans_table <- purrr::pluck(translation_table, variable_name) + var_trans_table <- var_trans_table [ , names(var_trans_table) %in% + c(source_lang, dest_lang)] + + if (!(source_lang %in% names(var_trans_table))){ + if (verbose) message("Source language not found in translation table.") + return(NULL) + } + if (!(dest_lang %in% names(var_trans_table))){ + if (verbose) message("Destination language not found in translation table.") + return(NULL) + } + # Get the values that have translations available + filtered_var_trans_table <- var_trans_table[ + var_trans_table[[1]] != "" & !is.na(var_trans_table[[1]]) & + var_trans_table[[2]] != "" & !is.na(var_trans_table[[2]]), ] + filtered_var_trans_table[[1]] %>% + unique() %>% + sort() +} diff --git a/R/translation-functions.R b/R/translation-functions.R index 807379f..cd85923 100644 --- a/R/translation-functions.R +++ b/R/translation-functions.R @@ -14,6 +14,22 @@ set_active_translation_table <- function(transtable) { invisible(old) } +#' Get list of variables in the active translation table +#' +#' Returns a list of variables in the active translation table. +#' +#' @returns A character vector with the names of the variables in the +#' active translation table. +#' +#' @export +#' +#' @examples +#' set_active_translation_table(uc_translation) +#' get_translation_variables() +get_translation_variables <- function() { + names(tcats$translation_table) +} + #' Translated Join #' #' Adds one column (`translated_join`) or several columns (`translated_join_vars`) @@ -66,8 +82,6 @@ translated_join <- function(dataframe, variable, return(dataframe) } - - #' @rdname translated_join #' #' @export @@ -78,7 +92,3 @@ translated_join_vars <- function(dataframe, variables=c(""), ...){ } return(dataframe) } - - - - diff --git a/data-raw/gss_translation.R b/data-raw/gss_translation.R new file mode 100644 index 0000000..4221a2a --- /dev/null +++ b/data-raw/gss_translation.R @@ -0,0 +1,6 @@ +gss_translation_combined <- + readr::read_csv("inst/extdata/gss_cat_transtable_complete.csv") +gss_translation <- + transcats::parse_combined_translation_table(gss_translation_combined) + +usethis::use_data(gss_translation, overwrite = TRUE) diff --git a/data/gss_translation.rda b/data/gss_translation.rda new file mode 100644 index 0000000..fd8a001 Binary files /dev/null and b/data/gss_translation.rda differ diff --git a/man/get_translation_variables.Rd b/man/get_translation_variables.Rd new file mode 100644 index 0000000..8941f3c --- /dev/null +++ b/man/get_translation_variables.Rd @@ -0,0 +1,19 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/translation-functions.R +\name{get_translation_variables} +\alias{get_translation_variables} +\title{Get list of variables in the active translation table} +\usage{ +get_translation_variables() +} +\value{ +A character vector with the names of the variables in the +active translation table. +} +\description{ +Returns a list of variables in the active translation table. +} +\examples{ +set_active_translation_table(uc_translation) +get_translation_variables() +} diff --git a/man/gss_translation.Rd b/man/gss_translation.Rd new file mode 100644 index 0000000..9d7897e --- /dev/null +++ b/man/gss_translation.Rd @@ -0,0 +1,23 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/data.R +\docType{data} +\name{gss_translation} +\alias{gss_translation} +\title{Translation table for gss_cat} +\format{ +\subsection{\code{gss_translation}}{ + +A list of tibbles, each with three columns named "en", "es", "fr". +Their names correspond to the categorical variables involved: +\code{marital}, \code{race}, \code{rincome}, \code{partyid}, \code{relig}, \code{denom}. +} +} +\usage{ +gss_translation +} +\description{ +A translation table for the variable gss_cat, a data source from the +General Social Survey that is included in the package \code{forcats} +and used for examples in \code{transcats}. +} +\keyword{datasets} diff --git a/man/translation_available_for.Rd b/man/translation_available_for.Rd new file mode 100644 index 0000000..1c95561 --- /dev/null +++ b/man/translation_available_for.Rd @@ -0,0 +1,80 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/translation-available.R +\name{translation_available_for} +\alias{translation_available_for} +\alias{num_translation_available} +\alias{all_translation_available_for} +\alias{which_translation_unavailable_for} +\title{Check whether translations are available for all values in a vector/column} +\usage{ +translation_available_for( + dataframe, + variable_name, + translation_table = tcats$translation_table, + dest_lang = tcats$dest_lang, + source_lang = tcats$source_lang, + verbose = FALSE +) + +num_translation_available( + dataframe, + variable_name, + translation_table = tcats$translation_table, + dest_lang = tcats$dest_lang, + source_lang = tcats$source_lang, + verbose = FALSE +) + +all_translation_available_for( + dataframe, + variable_name, + translation_table = tcats$translation_table, + dest_lang = tcats$dest_lang, + source_lang = tcats$source_lang, + verbose = FALSE +) + +which_translation_unavailable_for( + dataframe, + variable_name, + translation_table = tcats$translation_table, + dest_lang = tcats$dest_lang, + source_lang = tcats$source_lang, + verbose = FALSE +) +} +\arguments{ +\item{dataframe}{A vector or dataframe to be checked. If a dataframe, +it should contain the variable specified in \code{variable}.} + +\item{variable_name}{The name of the variable to be checked, as a string.} + +\item{translation_table}{A translation table, by default +this is the active translation table.} + +\item{dest_lang}{The destination language code, by default +this is the current source language, set by set_dest_lang().} + +\item{source_lang}{The source language code, by default +this is the current source language, set by set_source_lang().} + +\item{verbose}{If TRUE, prints messages about the process.} +} +\value{ +A list of values with available translation +} +\description{ +\code{translation_available_for} checks if the values in a vector or +column to see which have translations available in the +translation table. + +\code{num_translation_available} returns the number of values +that have translations available, from zero to +length(unique(vector)). + +\code{all_translation_available_for} checks if all values in the vector +have translations available in the translation table. + +\code{which_translation_unavailable_for} returns a vector with the values +that do not have translations available in the translation table. +} diff --git a/man/which_translation_available.Rd b/man/which_translation_available.Rd new file mode 100644 index 0000000..fbc26fb --- /dev/null +++ b/man/which_translation_available.Rd @@ -0,0 +1,43 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/translation-available.R +\name{which_translation_available} +\alias{which_translation_available} +\title{Show values with available translations} +\usage{ +which_translation_available( + variable_name, + translation_table = tcats$translation_table, + dest_lang = tcats$dest_lang, + source_lang = tcats$source_lang, + verbose = FALSE +) +} +\arguments{ +\item{variable_name}{The name of the variable to be checked, +as a string.} + +\item{translation_table}{A translation table, by default +this is the active translation table.} + +\item{dest_lang}{The destination language code, by default +this is the current source language, set by set_dest_lang().} + +\item{source_lang}{The source language code, by default +this is the current source language, set by set_source_lang().} + +\item{verbose}{If TRUE, prints messages about the process.} +} +\value{ +A character vector with the values that have translations +available. +} +\description{ +\code{which_translation_available} returns the values for which +there is an available translation in the translation table. + +Note that unlike functions like \code{translation_available_for}, +\code{which_translation_available} does not check the values +within a dataframe or vector, but looks directly at the +translation table and returns all possible values that +can be translated. +} diff --git a/tests/testthat/test-translation-available.R b/tests/testthat/test-translation-available.R new file mode 100644 index 0000000..8a5df7a --- /dev/null +++ b/tests/testthat/test-translation-available.R @@ -0,0 +1,45 @@ +test_that("Testing translation_available functions", { + set_active_translation_table(gss_translation) + set_source_lang("en") + set_dest_lang("fr") + expect_equal(get_translation_variables(), + c("marital", "race", "rincome", "partyid", "relig", "denom")) + expect_equal(translation_available_for(forcats::gss_cat, "marital"), + c("Never married", "Divorced", "Widowed", "Married", "Separated", + "No answer")) + expect_equal(num_translation_available(forcats::gss_cat, "marital"), + length(unique(forcats::gss_cat$marital))) + expect_equal(num_translation_available(forcats::gss_cat, "race"), + length(unique(forcats::gss_cat$race))) + expect_equal(all_translation_available_for(forcats::gss_cat, "rincome"), + TRUE) + expect_equal(all_translation_available_for(forcats::gss_cat, "marital"), + TRUE) + expect_equal(which_translation_unavailable_for(forcats::gss_cat, "marital"), + character(0)) + set_dest_lang("cz") # Czech is not available + expect_equal(all_translation_available_for(forcats::gss_cat, "marital"), + FALSE) + expect_equal(which_translation_unavailable_for(forcats::gss_cat, "marital"), + c("Never married", "Divorced", "Widowed", "Married", "Separated", + "No answer")) + expect_equal(translation_available_for(forcats::gss_cat, "marital"), + NULL) +}) +test_that("Testing which_translation_available", { + set_active_translation_table(gss_translation) + set_source_lang("en") + set_dest_lang("fr") + expect_equal(which_translation_available("marital"), + sort(c("Never married", "Divorced", "Widowed", "Married", "Separated", + "No answer"))) + expect_equal(which_translation_available("partyid"), + sort(c("Ind,near rep", "Not str republican", "Independent", + "Not str democrat", "Strong democrat", "Ind,near dem", + "Strong republican", "Other party", "No answer", "Don't know"))) + set_dest_lang("cz") # Czech is not available + expect_equal(which_translation_available("marital"), + NULL) + expect_equal(which_translation_available("partyid"), + NULL) +}) diff --git a/tests/testthat/test-translation-functions.R b/tests/testthat/test-translation-functions.R index edb1419..a296d0b 100644 --- a/tests/testthat/test-translation-functions.R +++ b/tests/testthat/test-translation-functions.R @@ -1,5 +1,4 @@ test_that("Translation works", { - load(test_path("fixtures", "gss-vars.Rdata")) expect_equal(dplyr::pull(translated_join_vars(gss_cat, gss_cat_trans_variables, gss_translation, "fr", "en")[5,"relig_fr"]), "Aucune religion") @@ -28,3 +27,17 @@ test_that("Output options order columns as expected", { "denom", "tvhours", "marital_es", "race_es", "rincome_es", "partyid_es", "relig_es", "denom_es")) }) + +test_that("get_translation_variables returns appropriate list", { + old <- set_active_translation_table(uc_translation) + expect_equal(get_translation_variables(), names(uc_translation)) + expect_true("protest_domain" %in% get_translation_variables()) + + set_active_translation_table(gss_var_table) + expect_equal(get_translation_variables(), names(gss_var_table)) + expect_equal(get_translation_variables(), + c("year", "marital", "age", "race", "rincome", "partyid", "relig", + "denom", "tvhours", "language")) + expect_true("marital" %in% get_translation_variables()) + set_active_translation_table(old) +})