In clinDataReview: Clinical Data Review Tool

library(knitr)
knitr::opts_chunk$set(
    echo = FALSE, 
    warning = FALSE, error = FALSE, message = FALSE, 
    results = "asis"
)

knitr::knit_hooks$set(
    message = function(x, options) {
        paste('\n\n<div class="alert alert-info">',
            gsub('##', '\n', x),
            '</div>', sep = '\n')
    }
)

# print warnings where they occur (warn = 0 by default)
options(warn = 1)

attach(params)
if(!exists("patientProfilePath"))   patientProfilePath <- NULL
if(!exists("loopingVar")) loopingVar <- NULL
if(!exists("loopingTotal")) loopingTotal <- TRUE

library(clinDataReview)
library(clinUtils)
library(inTextSummaryTable)
library(plyr)# for dlply, rbind.fill

if(!exists("reportTitleLevel")) reportTitleLevel <- 1

# Create a header at the wanted depth
cat(getMdHeader(title = reportTitle, level = reportTitleLevel))

# Load data
pathData <- file.path(pathDataFolder, dataFileName)

dataAll <- clinUtils::loadDataADaMSDTM(pathData, verbose = FALSE)
data <- do.call(plyr::rbind.fill, dataAll)

# Extract label information
labelVars <- attr(dataAll, "labelVars")

# Data processing 
if(exists("dataProcessing")){
    data <- processData(
        data = data, 
        dataPath = pathDataFolder,
        processing = dataProcessing,
        verbose = TRUE,
        labelVars = labelVars
    )
    # Labels updated with extra annotation:
    labelVars <- attr(data, "labelVars")
}

# Create URL to patient profiles
if(!is.null(patientProfilePath))
    data <- createPatientProfileVar(
        data = data, 
        patientProfilePath = patientProfilePath,
        checkExist = FALSE
    )

## total

if(exists("dataTotalFileName")){

    # Load data
    pathDataTotal <- file.path(pathDataFolder, dataTotalFileName)

    dataTotalAll <- clinUtils::loadDataADaMSDTM(pathDataTotal, verbose = FALSE)
    dataTotal <- dataTotalAll[[1]]

    # Extract label information
    labelVarsTotal <- attr(dataTotalAll, "labelVars")

    # Total data processing
    if(exists("dataTotalProcessing")){
        dataTotal <- processData(
            data = dataTotal, 
            dataPath = pathDataFolder, 
            processing = dataTotalProcessing,
            verbose = TRUE,
            labelVars = labelVarsTotal,
            labelData = "total data"
        )
    }

}else   dataTotal <- data

# only subset of the data if requested
if(!is.null(loopingVar)){

    # format label for 'knitPrintClinDataReview'
    data[, loopingVar] <- colwise(function(x) gsub("\\.", "", x))(data[, loopingVar, drop = FALSE])
    dataTotal[, loopingVar] <- colwise(function(x) gsub("\\.", "", x))(dataTotal[, loopingVar, drop = FALSE])

    if(exists("loopingNMax") && is.integer(loopingNMax)){
        data <- merge(
            x = data,
            y = unique(data[, loopingVar, drop = FALSE])[seq_len(loopingNMax), , drop = FALSE],
            all = FALSE
        )
    }

}

## Params for the table
statsExtraPP <- list(
    statPatientProfilePath = function(data) 
        toString(sort(unique(data$patientProfilePath))),
    statPatientProfileLink = function(data)
        toString(sort(unique(data$patientProfileLink)))
)       
# get specific set of statistics + stats with subjects profiles path
statsPP <- if(!is.null(patientProfilePath))
    setNames(
        list(quote(statPatientProfileLink)), 
        labelVars["USUBJID"]
    )

## Create tables

# create table with descriptive statistics (data.frame format)
summaryTable <- dlply(data, loopingVar, function(dataI){

    ## Total dataset

    dataTotalI <- dataTotal
    if(!is.null(loopingVar) && loopingTotal){
        if(any(!loopingVar %in% colnames(dataTotalI)))
            stop("Looping variable(s) are not available in the total dataset. ",
                "Are you sure you want to compute the total by 'loopingVar'? (see 'loopingTotal').")
        dataTotalI <- merge(
            x = unique(dataI[, loopingVar, drop = FALSE]), 
            y = dataTotalI, 
            by = loopingVar, 
            all = FALSE # only include data if present in y
        )
    }

    ## Params for the table

    # evaluate !r-lazy parameters 
    argsTable <- forceParams(tableParams)

    # combine all paths across patients
    # the paths should be collapsed with: ', '
    if(!is.null(patientProfilePath))
        argsTable$statsExtra <- c(
            argsTable$statsExtra, statsExtraPP
        )

    if(is.character(argsTable$stats))
        argsTable$stats <- eval(expr = parse(text = argsTable$stats))
    # if statistics are specified for each variable separately:
    if(any(names(argsTable$stats) %in% argsTable$var)){
        argsTable$stats <- sapply(argsTable$stats, c, statsPP, simplify = FALSE)
    }else{
        argsTable$stats <- c(statsPP,argsTable$stats)
    }

    argsTable <- c(
        argsTable,
        list(
            data = dataI, 
            labelVars = labelVars,
            dataTotal = dataTotalI
        )
    )
    summaryTable <- do.call(computeSummaryStatisticsTable, argsTable)
    summaryTable <- subset(summaryTable, !isTotal)

    if(exists("tableProcessing")){

        summaryTable <- processData(
            data = summaryTable, 
            processing = tableProcessing,
            verbose = FALSE,
            labelVars = labelVars,
            labelData = "summary table"
        )
        labelVars <- attr(summaryTable, "labelVars")

    }
    summaryTable$plotID <- seq_len(nrow(summaryTable))

    attr(summaryTable, "labelVars") <- labelVars

    summaryTable

})

labelVars <- attr(summaryTable[[1]], "labelVars")

listPlots <- sapply(summaryTable, function(summaryTableI){

    argsPlot <- plotParams
    argsPlot$data <- summaryTableI
    argsPlot$labelVars <- labelVars
    argsPlot$table <- TRUE
    # Summarized data: so patients profiles should be collapsed for each row of the table
    if("pathExpand" %in% formalArgs(plotFunction)){
      argsPlot$pathExpand <- TRUE
    }
    argsPlot$pathVar <- if(!is.null(patientProfilePath))    names(statsPP)
    if("idVar" %in% formalArgs(plotFunction) & !"idVar" %in% names(argsPlot))
        argsPlot$idVar <- "plotID"

    do.call(plotFunction, argsPlot)

}, simplify = FALSE)

knitPrintClinDataReview(
    list = listPlots,
    level = reportTitleLevel + 1
)

clinDataReview documentation built on March 7, 2023, 5:13 p.m.