search

qPharmetra / qpToolkit

Tools for population PK modeling, visualization, and reporting
Other
1 stars 1 forks source link

tabSummarize() needs a mechanism to handle NA #72

Open bergsmat opened 3 years ago

bergsmat commented 3 years ago

Currently tabSummarize() returns NA where any of the input is NA.

bergsmat commented 3 years ago

Suggested code from team members:

conDataFun1_narm <- function (y, nSignif) paste(signif(mean(y, na.rm = TRUE), nSignif), " (", signif(sqrt(var(y, na.rm = TRUE)), nSignif - 1), ")", sep = "")

conDataFun2_narm <- function (y, nSignif) paste(signif(median(y, na.rm = TRUE), nSignif), " (", signif(min(y, na.rm=TRUE), nSignif), " - ", signif(max(y, na.rm=TRUE), nSignif), ")", sep = "")

tabStats_narm <- function (x, BY, nSignif = 3, conFunc1 = conDataFun1_narm, conFunc2 = conDataFun2_narm, catFunc = catDataFun, ndigits.categorical = 1, parName) { if (missing(parName)) { parName = deparse((match.call()[2])) parName = substring(parName, 1, (nchar(parName) - 2)) } BY = lapply(BY, function(by) c(as.character(by), rep("All", length(by)))) if (is.factor(x) | is.character(x)) { x = unlist(list(x, x)) if (is.character(x)) x = as.factor(x) tmp = data.frame(t(aggregate(x, by = BY, FUN = catFunc, ndigits.categorical = ndigits.categorical))) row.names(tmp)[(length(names(BY)) + 1):nrow(tmp)] = levels(x) } if (is.numeric(x)) { x = c(x, x) tmp1 = data.frame(t(aggregate(x, by = BY, FUN = function(y, nSignif) conFunc1(y, nSignif = nSignif), nSignif = nSignif))) tmp2 = data.frame(t(aggregate(x, by = BY, FUN = function(y, nSignif) conFunc2(y, nSignif = nSignif), nSignif = nSignif))) tmp = rbind(tmp1, tmp2[2, ]) } names(tmp) = levels(as.factor(unlist(BY))) tmp2 = as.data.frame(tmp[, 1]) names(tmp2) = "parameter" tmp2$parameter = row.names(tmp) tmp2$parameter[1] = parName if (is.numeric(x)) tmp2$parameter = c(parName, "Mean (SD)", "Median (range)") tmp = cbind(tmp2, tmp) row.names(tmp) = 1:nrow(tmp) for (i in 1:ncol(tmp)) tmp[, i] = as.character(tmp[, i]) tmp[1, ] = c(parName, rep("", length(2:ncol(tmp)))) return(tmp) }

tabSummarize_narm <- function (formula, data, nSignif = 3, extra.blank.line = TRUE, ndigits.categorical = 1) { allX = all.vars(nlme::getResponseFormula(formula)[[2]]) allY = all.vars(nlme::getCovariateFormula(formula)[[2]]) BY = lapply(1:length(allX), function(x, allX, data) eval(as.name(allX[[x]]), data), data = data, allX = allX) names(BY) = allX YYY = lapply(allY, function(yyy, data) eval(as.name(yyy), data), data = data) names(YYY) = allY theData = do.call("rbind", lapply(1:length(YYY), function(z, YYY, BY, extra.blank.line, nSignif, ndigits.categorical) { stats = tabStats_narm(x = YYY[[z]], BY = BY, parName = names(YYY)[z], nSignif = nSignif, ndigits.categorical = ndigits.categorical) if (extra.blank.line == TRUE) { EBL = stats[1, ] EBL[1, ] = rep("", ncol(stats)) stats = rbind(EBL, stats) } return(stats) }, YYY = YYY, BY = BY, extra.blank.line = extra.blank.line, nSignif = nSignif, ndigits.categorical = ndigits.categorical)) row.names(theData) = 1:nrow(theData) theData$parameter = full.names(theData$parameter) names.order = as.character(unique(eval(as.name(allX[1]), data))) theData = theData[, c("parameter", names.order, "All")] ndf = theData[1, ] NNN = tapply(YYY[[1]], BY, length) NNN = NNN[names.order] ndf[1, ] = c("", paste("(N=", c(as.numeric(NNN), length(YYY[[1]])), ")", sep = "")) theData = rbind(ndf, theData) return(theData) }