Skip to content

Commit

Permalink
Continued work on #122
Browse files Browse the repository at this point in the history
  • Loading branch information
1beb committed May 22, 2020
1 parent faa99ef commit 3480038
Show file tree
Hide file tree
Showing 2 changed files with 21 additions and 7 deletions.
23 changes: 16 additions & 7 deletions R/codebook.R
Original file line number Diff line number Diff line change
Expand Up @@ -209,12 +209,21 @@ writeCodebook <- function(...) {
#' @param ... Ignored
as.data.frame.CategoricalVariable <- function(x, ...) {
cats <- crunch::categories(x)
responses <- do.call(rbind, cats@.Data)
responses <- suppressWarnings(do.call(rbind, cats@.Data))
l <- list()
for (i in 1:nrow(responses)) {

if (is.null(responses[i, ]$numeric_value)) {
responses[i,]$numeric_value <- NA_integer_
# CategoricalVariable within MultipleResponseVariable
if (responses[i, ]$name %in% c("not selected", "selected")) {
responses[i,]$numeric_value <- ifelse(
responses[i, ]$name == "selected",
1L,
2L
)
} else {
responses[i,]$numeric_value <- NA_integer_
}
}

l[[i]] <- as.data.frame(
Expand All @@ -231,18 +240,18 @@ as.data.frame.CategoricalVariable <- function(x, ...) {
names(l) <- c("id", "missing", "name", "value")
}

# MultipleResponseVariable
# CategoricalVariable within MultipleResponseVariable
if (ncol(l) == 5) {
names(l) <- c("id", "missing", "value", "a", "b")
names(l) <- c("id", "missing", "name", "value", "drop")

}

for (i in 1:ncol(l)) { l[[i]] <- type.convert(l[[i]], as.is = T) }

s <- data.frame(crunch::table(x, useNA = "ifany"))
names(s) <- c("name", "n")
smry <- data.frame(crunch::table(x, useNA = "ifany"))
names(smry) <- c("name", "n")

res <- merge(l, s)
res <- merge(l, smry)
res[with(res, order(value)),]
}

Expand Down
5 changes: 5 additions & 0 deletions R/reformatResults.R
Original file line number Diff line number Diff line change
Expand Up @@ -127,6 +127,11 @@ getItemData <- function(data, item_name, empty_col, round){
#' @param banner_info A meta data object from \link{getBannerInfo}
#' @param latex A logical identifying if this code is for LaTex or Excel. If TRUE, LaTeX
reformatVar <- function(var, banner_name, theme, proportions, banner_info, latex) {

# if (!identical(names(var$crosstabs[[1]]), names(banner_info$names))) {
# return(NULL) #
# } # could be used in a future where we chain different banners

possible <- c("weighted_n", "unweighted_n", "totals_row", "means", "medians")
if (var$no_totals) {
possible <- setdiff(possible, "totals_row")
Expand Down

0 comments on commit 3480038

Please sign in to comment.