Skip to content
Merged
Show file tree
Hide file tree
Changes from 1 commit
Commits
File filter

Filter by extension

Filter by extension

Conversations
Failed to load comments.
Loading
Jump to
Jump to file
Failed to load files.
Loading
Diff view
Diff view
8 changes: 7 additions & 1 deletion R/descriptives.b.R
Original file line number Diff line number Diff line change
Expand Up @@ -627,7 +627,7 @@ descriptivesClass <- R6::R6Class(

for (var in tableVars)
table$addColumn(name=var, title=var, type="text", combineBelow=TRUE)
table$addColumn(name='counts', title=.('Counts'), type='number')
table$addColumn(name='counts', title=.('Counts'), type='integer')
table$addColumn(name='pc', title=.('% of Total'), type='number', format='pc')
table$addColumn(name='cumpc', title=.('Cumulative %'), type='number', format='pc')

Expand Down Expand Up @@ -997,6 +997,12 @@ descriptivesClass <- R6::R6Class(
table <- tables$get(var)
freq <- freqs[[var]]

# the case values aren't available during init, so set the
# counts type here; only show decimals for non-integer counts
# (i.e. when weighted by non-integer weights)
if ( ! all(freq == round(freq), na.rm=TRUE))
table$addColumn(name='counts', title=.('Counts'), type='number')

Copy link
Copy Markdown
Member

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

this is relying on some undocumented feature, where if you add a column with the same name as an existing column, it replaces it?

this would be a different way to do it:

table$columns[['counts']]$.__enclos_env__$private$.type <- 'number'

Copy link
Copy Markdown
Member Author

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

Went with the private$.type approach. One caveat: it can't be a single chained assignment —

table$columns[['counts']]$.__enclos_env__$private$.type <- 'number'

R desugars that into get-then-set-back calls up to the top-level target, so the final step writes the column list back through table$columns, which is a read-only active binding. That throws unused argument (... list(<environment> x4)). Extracting the column into a local first avoids the writeback:

countsColumn <- table$columns[['counts']]
countsColumn$.__enclos_env__$private$.type <- 'number'


tableVars <- c(var, splitBy)
allLevels <- lapply(jmvcore::select(self$data, tableVars), levels)
grid <- rev(expand.grid(rev(allLevels)))
Expand Down
7 changes: 7 additions & 0 deletions tests/testthat/testdescriptives.R
Original file line number Diff line number Diff line change
Expand Up @@ -168,16 +168,19 @@ params <- list(
list(
weights = NULL,
expected_counts = c(1, 1, 1, 1, 1),
expected_type = "integer",
info = "No weights"
),
list(
weights = c(1, 2, 3, 4, 5),
expected_counts = c(1, 2, 3, 4, 5),
expected_type = "integer",
info = "Integer weights"
),
list(
weights = c(0.5, 1, 1.5, 2, 2.5),
expected_counts = c(0.5, 1, 1.5, 2, 2.5),
expected_type = "number",
info = "Non-integer weights"
)
)
Expand All @@ -194,6 +197,10 @@ testthat::test_that("Weighted grouped frequency table is displayed correctly", {
# THEN the counts in the frequency table are correct
r <- desc$frequencies[[1]]$asDF
testthat::expect_equal(r$counts, param$expected_counts, info = param$info)

# AND the counts are only displayed as decimals for non-integer weights
countsType <- desc$frequencies[[1]]$getColumn("counts")$type
testthat::expect_equal(countsType, param$expected_type, info = param$info)
}
})

Expand Down
Loading