From fee7b9f87fc193c2c1040096ad271206ade62b68 Mon Sep 17 00:00:00 2001 From: CarwilB <54286746+CarwilB@users.noreply.github.com> Date: Wed, 23 Jul 2025 09:58:14 -0700 Subject: [PATCH 1/6] translation available --- NAMESPACE | 2 + R/data.R | 12 ++ R/translation-functions.R | 129 +++++++++++++++++++- data-raw/gss_translation.R | 6 + data/gss_translation.rda | Bin 0 -> 2340 bytes man/get_translation_variables.Rd | 19 +++ man/gss_translation.Rd | 23 ++++ man/translation_available_for.Rd | 80 ++++++++++++ tests/testthat/test-translation-functions.R | 15 ++- 9 files changed, 283 insertions(+), 3 deletions(-) create mode 100644 data-raw/gss_translation.R create mode 100644 data/gss_translation.rda create mode 100644 man/get_translation_variables.Rd create mode 100644 man/gss_translation.Rd create mode 100644 man/translation_available_for.Rd diff --git a/NAMESPACE b/NAMESPACE index 0ca4623..35dbfcd 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,6 +22,7 @@ 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) 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/translation-functions.R b/R/translation-functions.R index 807379f..53afa07 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 @@ -79,6 +93,117 @@ translated_join_vars <- function(dataframe, variables=c(""), ...){ return(dataframe) } +#' 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` checks if all values in the vector +#' have translations available in the translation table. +#' +#' `which_translation_unavailable` 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 <- 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 <- 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) +} 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 0000000000000000000000000000000000000000..fd8a0015bc98fa4ecfbadeb3c25394a3fb47fa8c GIT binary patch literal 2340 zcmV+<3ETEUT4*^jL0KkKS+r}0i2w^G|K0!p|K0cZ|KLA&-_XDR|L{N{U?K<*2mlZO zVH4mAe?1PNF<4FQ-d6O1$QqEU0009}sp$5qev}?*PbsF-dP6_}01X-d0D6XjZ1{nfi%+-LjVNO#9#po005W?lOWJE zVJ4(g6;H%b=#OfTL}}_Y$)}{q3_#OB7=}Xu2AX09Oh5+!0002c00006gFpZP0LTMC z07RgI0D&}9@@jfU(Hfpfo~foIAQ}K@(8x42224SwGMC{2rt!N5I!1ss0iYqYZXsk% zb{Y%>yi(N)0Hk08Z{x;)~ypkBy>RvF$WCC zqxn!nH1{Yp*;Jq8cYubW{&W#I(g2mX#EAA_W4$go2tn4Ge0b{nd>BHuADhSI@_9XB z!%}gLHzZA{?nt2&2mulzRU!(fzsfGm; z#&alfhUYTC-e`#hO!a%6Q)r4k_#hB^L8v(c?~M*VIdRV%?+=&1IiY+P!5=D0pszl` zATk2F@GOXn3}}2>Qfm<$1?XM(%2=Jist5_r`pVJYg|l1>1Cc})8=y|ecx!6^x~#m| z%S9$II!BV%ui(666vicxP{wrz`0FOzn910yhhhsV%P53QF12SvL1e}Cnp|_8z<_(g z$>^}MUrbj)U%(*qKoC11st^$qjD#d2s2y+yq9Fx94X{v(kXH4epgdJT7C=xHVvq#^ zWL1!es;a8U3k8f~ix@Bz1Y*S?#z0047AT5{kwsBq0E&mh06nN6Ex`;HiY|NjC3Mf5 zpM^BFuGwj7s*0*;s=nKi;v70CH(rCaH5%@8ZZjfqoKnCd3W7=!mSP1(Lot-}fs2Fl zE|D{VDj5cjdFW0IhA*4g35G_HfKGvmhR`u!7zn_y+PA6$EevZ;CU234f*4!y5@g8) zjX;PnFkr1iG)f|<9^r;HAo3HC0RRm^x9mjsgJE&)LvLos^RSlimP_SnvpGJ|?w*P$ z)fS;e6j4mj)HwqWJeyg~jKwQkv@HxV6HM#lv>U0&O%t{8KJ(ULA$fYzq&5#n(&_24 z9gqiwXMKBQ&h={~QVj?TTA~nF{l>mT%fPjF9rBb6Ad!i+(G}3!-K@c%*P9VmWuoO;UO@>RD4;<3LL^DaC&S7;>r}JyRaw1Ji3ZEgtSlC+GQ!r8 zgc{c2XAmkDsfJY$t#4nKBQqd9`~b`5m=#dXR!sQ*S;<7W%?2{%XR%!5xnXLCH8L*? z+Vrn=#u?3c(00FwEKzyq=@8s(J{c&7`ba+p(|(-mu=v>R7#NuFoDsu#U)de+1e)Fm zud)YWJ*>nk6#al%4h7kc%8gnP2Ch4*)%gT4%=0D_7b(-3^@qd*>WFxU)Eu-MO{4;9 zJ?1*ZHh??JhBw)DrRZGD#|d~NSMF-5ZuUr(__iu-VYBs zr_3J7kZ%X$ImgNT(e z4_94VnYJ8nxKzk!Em0^E&hWs*E0j5dED*wdazV|xYe2}5Cz>831BM(^;0-wFShj&8 zn(-`6ZPTBBy?Due^%X`N#`iYl+$G$bnVaHH8ql~S$t6g)lm^(lAY;4ee{1iq3gv$u69!c~R0lBLpD#Dub6T8xrufsfB=R;QF{IVmPUO zP%VjKSdn|$S8MB#jD$GqnCv2(wGgEU7b*^eijP6tHaMFA)Wcir=)i%1eDtX!v~(Ba zofi%KhETXZc;Y@RHcVVO^HVxo0Lv3l7{D?YAu>r=-dwm`wJ@dal?!?B^vAXMhcVFy zno}H*tbq{ilxU5hYbLU5N|m*5xOLc;C(mBRO~k2J+YKOGxy)q9+3FQ z+8!~=_+?t#Q zIt@EBLV$G^%rQ2lHuW-V1C+~edkOYDYIlR2b50xS+G`&>h~o_Q;j^CMt?(1KXh4yL z=}8D_9uzjw)E$<+5c&sev3AsSj?~%~!L!^hZ#_gc<@QJ75f31$dbaM<*r*1u^Nm~g zoz6d?9Q|bBjmOwDJ|0NPB$9#97dDvWO_(_A3w(pdDsm@UFM$FK@h4h%QxI_<{x0N- KaG@b+*9{UR4l6wX literal 0 HcmV?d00001 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..db1134a --- /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-functions.R +\name{translation_available_for} +\alias{translation_available_for} +\alias{num_translation_available} +\alias{all_translation_available} +\alias{which_translation_unavailable} +\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( + dataframe, + variable_name, + translation_table = tcats$translation_table, + dest_lang = tcats$dest_lang, + source_lang = tcats$source_lang, + verbose = FALSE +) + +which_translation_unavailable( + 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} checks if all values in the vector +have translations available in the translation table. + +\code{which_translation_unavailable} returns a vector with the values +that do not have translations available in the translation table. +} 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) +}) From 9ba76efb81814efd077280df5dec15273ad977b8 Mon Sep 17 00:00:00 2001 From: CarwilB <54286746+CarwilB@users.noreply.github.com> Date: Wed, 23 Jul 2025 10:53:30 -0700 Subject: [PATCH 2/6] Separate and improve translation_available_for funtions. Tests. --- R/translation-available.R | 115 ++++++++++++++++++++ R/translation-functions.R | 115 -------------------- man/translation_available_for.Rd | 12 +- tests/testthat/test-translation-available.R | 28 +++++ 4 files changed, 149 insertions(+), 121 deletions(-) create mode 100644 R/translation-available.R create mode 100644 tests/testthat/test-translation-available.R diff --git a/R/translation-available.R b/R/translation-available.R new file mode 100644 index 0000000..a0487bc --- /dev/null +++ b/R/translation-available.R @@ -0,0 +1,115 @@ +#' 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) +} + +} diff --git a/R/translation-functions.R b/R/translation-functions.R index 53afa07..cd85923 100644 --- a/R/translation-functions.R +++ b/R/translation-functions.R @@ -92,118 +92,3 @@ translated_join_vars <- function(dataframe, variables=c(""), ...){ } return(dataframe) } - -#' 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` checks if all values in the vector -#' have translations available in the translation table. -#' -#' `which_translation_unavailable` 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 <- 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 <- 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) -} - diff --git a/man/translation_available_for.Rd b/man/translation_available_for.Rd index db1134a..2370e5a 100644 --- a/man/translation_available_for.Rd +++ b/man/translation_available_for.Rd @@ -3,8 +3,8 @@ \name{translation_available_for} \alias{translation_available_for} \alias{num_translation_available} -\alias{all_translation_available} -\alias{which_translation_unavailable} +\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( @@ -25,7 +25,7 @@ num_translation_available( verbose = FALSE ) -all_translation_available( +all_translation_available_for( dataframe, variable_name, translation_table = tcats$translation_table, @@ -34,7 +34,7 @@ all_translation_available( verbose = FALSE ) -which_translation_unavailable( +which_translation_unavailable_for( dataframe, variable_name, translation_table = tcats$translation_table, @@ -72,9 +72,9 @@ translation table. that have translations available, from zero to length(unique(vector)). -\code{all_translation_available} checks if all values in the vector +\code{all_translation_available_for} checks if all values in the vector have translations available in the translation table. -\code{which_translation_unavailable} returns a vector with the values +\code{which_translation_unavailable_for} returns a vector with the values that do not have translations available in the translation table. } diff --git a/tests/testthat/test-translation-available.R b/tests/testthat/test-translation-available.R new file mode 100644 index 0000000..28d03e8 --- /dev/null +++ b/tests/testthat/test-translation-available.R @@ -0,0 +1,28 @@ +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) +}) From f23c6eafc2654efffb2e2d2a5699398778742033 Mon Sep 17 00:00:00 2001 From: CarwilB <54286746+CarwilB@users.noreply.github.com> Date: Wed, 23 Jul 2025 10:54:25 -0700 Subject: [PATCH 3/6] New function which_translation_available --- R/translation-available.R | 58 +++++++++++++++++++++++++++++++++++++++ 1 file changed, 58 insertions(+) diff --git a/R/translation-available.R b/R/translation-available.R index a0487bc..80196e6 100644 --- a/R/translation-available.R +++ b/R/translation-available.R @@ -112,4 +112,62 @@ which_translation_unavailable_for <- function(dataframe, variable_name, 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 %>% + filter((.[[1]] != "") & !is.na(.[[1]])) %>% + filter((.[[2]] != "") & !is.na(.[[2]])) + filtered_var_trans_table[[1]] %>% + unique() %>% + sort() } From 75d78b4b7911675398597c781a2a39581cca24d6 Mon Sep 17 00:00:00 2001 From: CarwilB <54286746+CarwilB@users.noreply.github.com> Date: Wed, 23 Jul 2025 10:54:48 -0700 Subject: [PATCH 4/6] Documentation --- NAMESPACE | 1 + man/translation_available_for.Rd | 2 +- man/which_translation_available.Rd | 43 ++++++++++++++++++++++++++++++ 3 files changed, 45 insertions(+), 1 deletion(-) create mode 100644 man/which_translation_available.Rd diff --git a/NAMESPACE b/NAMESPACE index 35dbfcd..f266514 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -29,6 +29,7 @@ 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) diff --git a/man/translation_available_for.Rd b/man/translation_available_for.Rd index 2370e5a..1c95561 100644 --- a/man/translation_available_for.Rd +++ b/man/translation_available_for.Rd @@ -1,5 +1,5 @@ % Generated by roxygen2: do not edit by hand -% Please edit documentation in R/translation-functions.R +% Please edit documentation in R/translation-available.R \name{translation_available_for} \alias{translation_available_for} \alias{num_translation_available} 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. +} From 90d070bc6e03c5b82c770bd7bc20d52eb27e4864 Mon Sep 17 00:00:00 2001 From: CarwilB <54286746+CarwilB@users.noreply.github.com> Date: Wed, 23 Jul 2025 10:54:48 -0700 Subject: [PATCH 5/6] + test --- tests/testthat/test-translation-available.R | 17 +++++++++++++++++ 1 file changed, 17 insertions(+) diff --git a/tests/testthat/test-translation-available.R b/tests/testthat/test-translation-available.R index 28d03e8..8a5df7a 100644 --- a/tests/testthat/test-translation-available.R +++ b/tests/testthat/test-translation-available.R @@ -26,3 +26,20 @@ test_that("Testing translation_available functions", { 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) +}) From cf97b8968dc5ced1c4d50ddced2362a1a5a4fef1 Mon Sep 17 00:00:00 2001 From: CarwilB <54286746+CarwilB@users.noreply.github.com> Date: Wed, 23 Jul 2025 11:11:02 -0700 Subject: [PATCH 6/6] Simplify code to pass check() and increment version number. --- DESCRIPTION | 2 +- NAMESPACE | 1 + R/transcats-package.R | 1 + R/translation-available.R | 6 +++--- 4 files changed, 6 insertions(+), 4 deletions(-) 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 f266514..d2986bb 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -39,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/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 index 80196e6..e8fe71d 100644 --- a/R/translation-available.R +++ b/R/translation-available.R @@ -164,9 +164,9 @@ which_translation_available <- function(variable_name, return(NULL) } # Get the values that have translations available - filtered_var_trans_table <- var_trans_table %>% - filter((.[[1]] != "") & !is.na(.[[1]])) %>% - filter((.[[2]] != "") & !is.na(.[[2]])) + 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()