qPharmetra / qpToolkit

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

format.demoTable(), tabSummarize(), and tabStats(): suggested code #41

Closed bergsmat closed 4 years ago

bergsmat commented 4 years ago

Per Klaas:

format.demoTable = function (demoTable, formula) 
{
  names(demoTable)[1] = "Parameter"
  theParameters = full.names(all.vars(nlme::getCovariateFormula(formula)[[2]]))
  msel = which(demoTable$Parameter %in% theParameters)
  msel2 = which(demoTable$Parameter %nin% theParameters)
  demoTable$Parameter[msel] = paste("\\textbf{", demoTable$Parameter[msel], 
                                    "}", sep = "")
  demoTable$Parameter[msel2] = paste("\\hfill ", demoTable$Parameter[msel2], 
                                     sep = "")
  demoTable = reorder.names(demoTable, Cs(Parameter))
  demoTable = apply(demoTable, 2, function(x) gsub("\\%", "\\\\%", 
                                                   x))
  dimnames(demoTable)[[2]][1] = "Trial"
  return(demoTable)
}

tabSummarize = 
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(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)
}
tabStats = function (x, BY, nSignif = 3, conFunc1 = conDataFun1, conFunc2 = conDataFun2, 
                     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)
}
bergsmat commented 4 years ago

implemented as written. Examples still seem to work well.