Skip to content

Commit 6089d2b

Browse files
dewittpedewittpe
authored
Merge pull request #30 from dewittpe/fix-26-and-27
Fix 26 and 27
2 parents b56ac12 + 561569c commit 6089d2b

File tree

6 files changed

+237
-37
lines changed

6 files changed

+237
-37
lines changed

‎NEWS.md‎

Lines changed: 6 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -7,6 +7,12 @@
77
change will generally result in less computation time than base R
88
`data.frames` (`data.tables` require even less time).
99

10+
## Bug Fixes
11+
12+
* `summary.medicalcoder_comorbidites()` no longer crashes when a zero row input
13+
is passed in. Consisently return `NA` instead of `NaN` when counts are zeros.
14+
(#26, #27)
15+
1016
## Other Changes
1117

1218
* Extend and improve the internal ICD-9 database to distinguish between CDC and

‎R/summary.R‎

Lines changed: 77 additions & 35 deletions
Original file line numberDiff line numberDiff line change
@@ -130,16 +130,16 @@ summary.medicalcoder_comorbidities_with_subconditions <- function(object, ...) {
130130
condition = cnd,
131131
subcondition = NA_character_,
132132
count = counts[cnd],
133-
percent_of_cohort = 100 * counts[cnd] / N,
133+
percent_of_cohort = if (N > 0) {100 * counts[cnd] / N} else {NA_real_},
134134
percent_of_those_with_condition = NA_real_,
135135
stringsAsFactors = FALSE
136136
)
137137
x2 <- data.frame(
138138
condition = cnd,
139139
subcondition = names(scounts[[cnd]]),
140140
count = scounts[[cnd]],
141-
percent_of_cohort = 100 * scounts[[cnd]] / N,
142-
percent_of_those_with_condition = 100 * scounts[[cnd]] / counts[cnd],
141+
percent_of_cohort = if (N > 0) {100 * scounts[[cnd]] / N} else {NA_real_},
142+
percent_of_those_with_condition = ifelse(scounts[[cnd]] > 0, 100 * scounts[[cnd]] / counts[cnd], NA_real_),
143143
stringsAsFactors = FALSE
144144
)
145145
rbind(x1, x2)
@@ -167,15 +167,19 @@ summary.medicalcoder_comorbidities_with_subconditions <- function(object, ...) {
167167

168168
# Track running counts for patients meeting at least N conditions
169169
# so the summary can report distribution thresholds (>=2, >=3, ...).
170-
tlts <- sapply(2:11, function(x) { as.integer(object[["num_cmrb"]] >= x)})
170+
tlts <- lapply(2:11, function(x) { as.integer(object[["num_cmrb"]] >= x)})
171+
tlts <- do.call(cbind, tlts)
171172
colnames(tlts) <- paste(">=", 2:11, "conditions")
172173

174+
p <- 100 * c(colMeans(cnds), colMeans(tlts))
175+
p <- ifelse(is.nan(p), NA_real_, p)
176+
173177
rtn <-
174178
data.frame(
175179
condition = c(names(cnds), rep("num_cmrb", ncol(tlts))),
176180
label = c(conditions[["condition_label"]], "Any Technology Dependence", "Any Transplantation", "Any Condition", colnames(tlts)),
177181
count = as.integer(c(colSums(cnds), colSums(tlts))),
178-
percent = 100 * c(colMeans(cnds), colMeans(tlts)),
182+
percent = p,
179183
stringsAsFactors = FALSE
180184
)
181185

@@ -195,7 +199,8 @@ summary.medicalcoder_comorbidities_with_subconditions <- function(object, ...) {
195199

196200
# Track running counts for patients meeting at least N conditions
197201
# so the summary can report distribution thresholds (>=2, >=3, ...).
198-
tlts <- sapply(2:11, function(x) { as.integer(object[["num_cmrb"]] >= x)})
202+
tlts <- lapply(2:11, function(x) { as.integer(object[["num_cmrb"]] >= x)})
203+
tlts <- do.call(cbind, tlts)
199204
colnames(tlts) <- paste(">=", 2:11, "conditions")
200205

201206
sets <-
@@ -210,7 +215,11 @@ summary.medicalcoder_comorbidities_with_subconditions <- function(object, ...) {
210215

211216
counts <- lapply(sets, colSums, na.rm = TRUE)
212217
N <- nrow(object)
213-
percents <- lapply(counts, function(x) 100 * x / N)
218+
percents <- lapply(counts,
219+
function(x) {
220+
y <- 100 * x / N
221+
ifelse(is.nan(y), NA_real_, y)
222+
})
214223

215224
rtn <-
216225
data.frame(
@@ -256,11 +265,11 @@ summary.medicalcoder_comorbidities_with_subconditions <- function(object, ...) {
256265

257266
cmrbs <- ..mdcr_internal_charlson_index_scores..[!is.na( ..mdcr_internal_charlson_index_scores..[[attr(object, "method")]]), c("condition_description", "condition")]
258267

259-
cmrbs[["count"]] <- colSums(object[cmrbs[["condition"]]])
268+
cmrbs[["count"]] <- colSums(object[cmrbs[["condition"]]])
260269
cmrbs[["percent"]] <- 100 * colMeans(object[cmrbs[["condition"]]])
261270

262271
num_cmrbs <-
263-
lapply(seq_len(max(object[["num_cmrb"]])),
272+
lapply(seq_len(max(c(1L, object[["num_cmrb"]]))),
264273
function(x) {
265274
y <- object[["num_cmrb"]] >= x
266275
data.frame(
@@ -275,16 +284,31 @@ summary.medicalcoder_comorbidities_with_subconditions <- function(object, ...) {
275284
cmrbs <- rbind(cmrbs, num_cmrbs)
276285
rownames(cmrbs) <- NULL
277286

287+
# set percent to NA instead of NaN
288+
cmrbs[["percent"]][is.nan(cmrbs[["percent"]])] <- NA_real_
289+
278290
index_summary <-
279-
data.frame(
280-
min = min(object[["cci"]]),
281-
q1 = stats::quantile(object[["cci"]], prob = 0.25),
282-
median = stats::median(object[["cci"]]),
283-
q3 = stats::quantile(object[["cci"]], prob = 0.75),
284-
max = max(object[["cci"]]),
285-
row.names = NULL,
286-
stringsAsFactors = FALSE
287-
)
291+
if (length(object[["cci"]]) > 0L) {
292+
data.frame(
293+
min = min(object[["cci"]]),
294+
q1 = stats::quantile(object[["cci"]], prob = 0.25),
295+
median = stats::median(object[["cci"]]),
296+
q3 = stats::quantile(object[["cci"]], prob = 0.75),
297+
max = max(object[["cci"]]),
298+
row.names = NULL,
299+
stringsAsFactors = FALSE
300+
)
301+
} else {
302+
data.frame(
303+
min = NA_integer_,
304+
q1 = NA_real_,
305+
median = NA_real_,
306+
q3 = NA_real_,
307+
max = NA_integer_,
308+
row.names = NULL,
309+
stringsAsFactors = FALSE
310+
)
311+
}
288312

289313
age_summary <-
290314
merge(
@@ -293,6 +317,9 @@ summary.medicalcoder_comorbidities_with_subconditions <- function(object, ...) {
293317
by = c("age_score")
294318
)
295319

320+
# set NA instead of NaN
321+
age_summary[["percent"]][is.nan(age_summary[["percent"]])] <- NA_real_
322+
296323
list(
297324
conditions = cmrbs,
298325
age_summary = age_summary,
@@ -308,35 +335,50 @@ summary.medicalcoder_comorbidities_with_subconditions <- function(object, ...) {
308335
cmrbs <- ..mdcr_internal_elixhauser_index_scores..[!is.na( ..mdcr_internal_elixhauser_index_scores..[[attr(object, "method")]]), "condition", drop = FALSE]
309336
cmrbs <- unique(cmrbs)
310337

311-
cmrbs[["count"]] <- colSums(object[cmrbs[["condition"]]])
338+
cmrbs[["count"]] <- colSums(object[cmrbs[["condition"]]])
312339
cmrbs[["percent"]] <- 100 * colMeans(object[cmrbs[["condition"]]])
313340

314341
num_cmrbs <-
315-
lapply(seq_len(max(object[["num_cmrb"]])),
342+
lapply(seq_len(max(c(1L, object[["num_cmrb"]]))),
316343
function(x) {
317344
y <- object[["num_cmrb"]] >= x
318345
data.frame(condition = paste(">=", x), count = sum(y), percent = 100 * mean(y), stringsAsFactors = FALSE)
319346
})
320347
num_cmrbs <- do.call(rbind, num_cmrbs)
321348
cmrbs <- rbind(cmrbs, num_cmrbs)
322349
rownames(cmrbs) <- NULL
350+
# set percent to NA instead of NaN
351+
cmrbs[["percent"]][is.nan(cmrbs[["percent"]])] <- NA_real_
323352

324353
index_summary <-
325-
data.frame(
326-
index = c("readmission", "mortality"),
327-
min = c(min(object[["readmission_index"]]),
328-
min(object[["mortality_index"]])),
329-
q1 = c(stats::quantile(object[["readmission_index"]], prob = 0.25),
330-
stats::quantile(object[["mortality_index"]], prob = 0.25)),
331-
median = c(stats::median(object[["readmission_index"]]),
332-
stats::median(object[["mortality_index"]])),
333-
q3 = c(stats::quantile(object[["readmission_index"]], prob = 0.75),
334-
stats::quantile(object[["mortality_index"]], prob = 0.75)),
335-
max = c(max(object[["readmission_index"]]),
336-
max(object[["mortality_index"]])),
337-
row.names = NULL,
338-
stringsAsFactors = FALSE
339-
)
354+
if (length(object[["readmission_index"]]) > 0L) {
355+
data.frame(
356+
index = c("readmission", "mortality"),
357+
min = c(min(object[["readmission_index"]]),
358+
min(object[["mortality_index"]])),
359+
q1 = c(stats::quantile(object[["readmission_index"]], prob = 0.25),
360+
stats::quantile(object[["mortality_index"]], prob = 0.25)),
361+
median = c(stats::median(object[["readmission_index"]]),
362+
stats::median(object[["mortality_index"]])),
363+
q3 = c(stats::quantile(object[["readmission_index"]], prob = 0.75),
364+
stats::quantile(object[["mortality_index"]], prob = 0.75)),
365+
max = c(max(object[["readmission_index"]]),
366+
max(object[["mortality_index"]])),
367+
row.names = NULL,
368+
stringsAsFactors = FALSE
369+
)
370+
} else {
371+
data.frame(
372+
index = c("readmission", "mortality"),
373+
min = c(NA_integer_, NA_integer_),
374+
q1 = c(NA_real_, NA_real_),
375+
median = c(NA_real_, NA_real_),
376+
q3 = c(NA_real_, NA_real_),
377+
max = c(NA_integer_, NA_integer_),
378+
row.names = NULL,
379+
stringsAsFactors = FALSE
380+
)
381+
}
340382

341383
list(
342384
conditions = cmrbs,

‎tests/test-summary-charlson.R‎

Lines changed: 35 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -119,6 +119,41 @@ stopifnot(
119119
identical(summary_cumulative$index_summary, summary_current$index_summary)
120120
)
121121

122+
################################################################################
123+
# Zero-row input should summarize without NaN/Inf
124+
df0 <- data.frame(
125+
patid = integer(),
126+
icdv = integer(),
127+
dx = integer(),
128+
code = character(),
129+
age = integer(),
130+
stringsAsFactors = FALSE
131+
)
132+
133+
charlson_zero <- comorbidities(
134+
data = df0,
135+
id.vars = "patid",
136+
icdv.var = "icdv",
137+
icd.codes = "code",
138+
dx.var = "dx",
139+
method = "charlson_quan2011",
140+
flag.method = "current",
141+
poa = 1L,
142+
primarydx = 0L,
143+
age.var = "age"
144+
)
145+
146+
summary_zero <- summary(charlson_zero)
147+
148+
stopifnot(
149+
is.list(summary_zero),
150+
identical(names(summary_zero), c("conditions", "age_summary", "index_summary")),
151+
all(summary_zero$conditions$count == 0L),
152+
!any(is.nan(summary_zero$conditions$percent)),
153+
all(is.na(summary_zero$conditions$percent)),
154+
all(summary_zero$index_summary == 0 | is.na(summary_zero$index_summary))
155+
)
156+
122157
################################################################################
123158
# End of File #
124159
################################################################################

‎tests/test-summary-elixhauser.R‎

Lines changed: 37 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -122,6 +122,43 @@ stopifnot(
122122
identical(summary_cumulative$index_summary, summary_current$index_summary)
123123
)
124124

125+
################################################################################
126+
# Zero-row input should summarize without NaN/Inf
127+
df0 <- data.frame(
128+
patid = integer(),
129+
icdv = integer(),
130+
dx = integer(),
131+
code = character(),
132+
stringsAsFactors = FALSE
133+
)
134+
135+
elixhauser_zero <- comorbidities(
136+
data = df0,
137+
id.vars = "patid",
138+
icdv.var = "icdv",
139+
icd.codes = "code",
140+
dx.var = "dx",
141+
method = "elixhauser_ahrq2025",
142+
flag.method = "current",
143+
poa = 1L,
144+
primarydx = 0L
145+
)
146+
147+
summary_zero <- summary(elixhauser_zero)
148+
149+
stopifnot(
150+
is.list(summary_zero),
151+
identical(names(summary_zero), c("conditions", "index_summary")),
152+
all(summary_zero$conditions$count == 0L),
153+
!any(is.nan(summary_zero$conditions$percent)),
154+
all(is.na(summary_zero$conditions$percent)),
155+
all(is.na(summary_zero$index_summary$min)),
156+
all(is.na(summary_zero$index_summary$q1)),
157+
all(is.na(summary_zero$index_summary$median)),
158+
all(is.na(summary_zero$index_summary$q3)),
159+
all(is.na(summary_zero$index_summary$max))
160+
)
161+
125162
################################################################################
126163
# End of File #
127164
################################################################################

‎tests/test-summary-pccc-subconditions.R‎

Lines changed: 35 additions & 2 deletions
Original file line numberDiff line numberDiff line change
@@ -38,8 +38,8 @@ stopifnot(
3838
all(summary_current[["percent_of_cohort"]] >= 0),
3939
all(summary_current[["percent_of_cohort"]] <= 100),
4040
all(is.na(summary_current[["percent_of_those_with_condition"]][is.na(summary_current[["subcondition"]])])),
41-
all(summary_current[["percent_of_those_with_condition"]][!is.na(summary_current[["subcondition"]])] >= 0),
42-
all(summary_current[["percent_of_those_with_condition"]][!is.na(summary_current[["subcondition"]])] <= 100)
41+
all(summary_current[["percent_of_those_with_condition"]][!is.na(summary_current[["subcondition"]]) & summary_current[["count"]] > 0] >= 0),
42+
all(summary_current[["percent_of_those_with_condition"]][!is.na(summary_current[["subcondition"]]) & summary_current[["count"]] > 0] <= 100)
4343
)
4444

4545
################################################################################
@@ -125,6 +125,39 @@ summary_cumulative <- suppressWarnings(summary(pccc_sub_cumulative))
125125

126126
stopifnot(identical(summary_cumulative, summary_current))
127127

128+
################################################################################
129+
# No conditions flagged -> percentages should be 0/NA, not NaN/Inf
130+
df_none <- data.frame(
131+
patid = 1:3,
132+
icdv = 10L,
133+
dx = 1L,
134+
code = c("XXX1", "XXX2", "XXX3"),
135+
stringsAsFactors = FALSE
136+
)
137+
138+
pccc_empty <- comorbidities(
139+
data = df_none,
140+
id.vars = "patid",
141+
icd.codes = "code",
142+
icdv.var = "icdv",
143+
dx.var = "dx",
144+
method = "pccc_v3.1",
145+
flag.method = "current",
146+
poa = 1,
147+
subconditions = TRUE
148+
)
149+
150+
summary_empty <- summary(pccc_empty)
151+
152+
stopifnot(
153+
inherits(summary_empty, "data.frame"),
154+
all(summary_empty$count == 0),
155+
all(summary_empty$percent_of_cohort == 0),
156+
!any(is.nan(summary_empty$percent_of_cohort)),
157+
all(is.na(summary_empty$percent_of_those_with_condition) | summary_empty$percent_of_those_with_condition == 0),
158+
!any(is.nan(summary_empty$percent_of_those_with_condition))
159+
)
160+
128161
################################################################################
129162
# End of File #
130163
################################################################################

0 commit comments

Comments
 (0)