diff --git a/DESCRIPTION b/DESCRIPTION index 511da41..373655d 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -13,3 +13,4 @@ Depends: stringr, reshape2, RJSONIO, plyr URL: https://github.com/cjgb/pxR License: GPL-3 LazyLoad: yes +RoxygenNote: 7.3.1 diff --git a/R/as.data.frame.px.R b/R/as.data.frame.px.R index 6fd6785..9f033f7 100644 --- a/R/as.data.frame.px.R +++ b/R/as.data.frame.px.R @@ -11,28 +11,58 @@ # 20120402, cjgb: warnings can be either errors or warnings depending on paranoia level # 20120402, cjgb: adapted to the new px object format (where DATA is already a df) # 20141222. fvf: bug in "wide" direction +# 20240311. munoztd0: updated the handling of 'to_values' in the mapvalues function for language translation ################################################################# -as.data.frame.px <- function( x, ..., use.codes = FALSE, warnings.as.errors = TRUE, direction = "long"){ - +as.data.frame.px <- function( x, ..., use.codes = FALSE, warnings.as.errors = TRUE, direction = "long", language=FALSE){ + dat <- x$DATA$value # already a data frame + if ((!is.logical(language) && is.character(language))){ + if(language %in% strsplit(x$LANGUAGES$value, "\",\"")[[1]]){ + use.language = paste0('.',language,'.') + default.language = x$LANGUAGE + codes.ids = match(names(x$CODES), colnames(dat)) + + for(code_id in codes.ids) { + if (is.na(code_id)) { + next + } + from_values = x$VALUES[[code_id]] + to_values = strsplit(x[[paste0('VALUES', use.language)]][[code_id]], "\",\"|\", \"")[[1]] + + if (length(from_values) != length(to_values)) { + stop(paste0('The from and to vectors for code_id ', code_id, ' are not the same length.')) + } + + dat[[codes.ids[code_id]]] <- mapvalues(dat[[codes.ids[code_id]]], + from = from_values, + to = to_values) + } + translated_colnames = names(x[[paste0('CODES', use.language)]])[codes.ids] + translated_colnames = c(translated_colnames, 'value') + colnames(dat) = translated_colnames + + } else { + stop(paste0('Can\'t find the proposed language. Please choose one of the available languages: ', x$LANGUAGES$value)) + } + } else { + language = '' + } + ## maybe we need to change values to codes if (is.logical(use.codes) && use.codes) use.codes <- names(x$CODES) if (! is.logical(use.codes)) for( var.name in intersect( use.codes, intersect(colnames(dat), names(x$CODES) ) ) ) - dat[[var.name]] <- mapvalues(dat[[var.name]], - from = x$VALUES[[var.name]], - to = x$CODES[[var.name]]) - + dat[[var.name]] <- mapvalues(dat[[var.name]], + from = x$VALUES[[var.name]], + to = x$CODES[[var.name]]) + ## do we need to reshape? if (direction == "wide") - # fvf.20121222: The order of variables rows and pivots-columns was inverted - # dcast(dat, list(x$HEADING$value, x$STUB$value)) dcast(dat, list(x$STUB$value,x$HEADING$value)) else dat -} - +} \ No newline at end of file diff --git a/man/as.data.frame.px.Rd b/man/as.data.frame.px.Rd index 787ea54..3960e50 100644 --- a/man/as.data.frame.px.Rd +++ b/man/as.data.frame.px.Rd @@ -10,7 +10,7 @@ This function extracts the data component from a px object as a \code{data.frame } \usage{ \S3method{as.data.frame}{px}( x, ..., use.codes = FALSE, - warnings.as.errors = TRUE, direction = 'long') + warnings.as.errors = TRUE, direction = 'long', language=FALSE) } \arguments{ \item{x}{ a px object } @@ -22,6 +22,7 @@ This function extracts the data component from a px object as a \code{data.frame \item{warnings.as.errors}{ If true, the function will fail in case any issues are found; otherwise, it will generate warnings. } \item{direction}{character string, either ‘"wide"’ to reshape to wide format, or ‘"long"’ to reshape to long format (default).} + \item{language}{ a logical indicating whether to use language-specific values. Default is FALSE.} \item{...}{ Additional arguments, currently not used } } \details{