Nothing
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)
# Note: find a way to specify defaults for variables attach(params) if(!exists("loopingVar")) loopingVar <- NULL if(!exists("comparisonTableType")) comparisonTableType <- "none" if(comparisonTableType != "none" & (!exists("pathDataFolderOld") || !file.exists(file.path(pathDataFolderOld, dataFileName))) ){ warning("No comparison table is included because data from previous batch is not available.") comparisonTableType <- "none" } if(!comparisonTableType %in% c("none", "newData-diff")){ warning("Option:", comparisonTableType, "is not available for the plot template", "no comparison is included.") comparisonTableType <- "none" } if(!exists("patientProfilePath")) patientProfilePath <- NULL
library(clinDataReview) library(clinUtils) library(plyr) # for dlply, rbind.fill if(exists("tableParams")) library(inTextSummaryTable)
if(!exists("reportTitleLevel")) reportTitleLevel <- 1 # Create a header at the wanted depth cat(getMdHeader(title = reportTitle, level = reportTitleLevel))
# Load data if(comparisonTableType != "none") { pathsData <- c( "currentData" = pathDataFolder, "previousData" = pathDataFolderOld ) } else pathsData <- c("currentData" = pathDataFolder) dataList <- sapply(names(pathsData), function(dataBatch) { pathDataBatch <- pathsData[[dataBatch]] pathData <- file.path(pathDataBatch, dataFileName) dataAll <- 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 = pathDataBatch, 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 ) data }, simplify = FALSE) data <- dataList$currentData labelVars <- attr(dataList$currentData, "labelVars")
dataList <- sapply(dataList, function(dataBatch) { # Compute summary statistics tableParamsBatch <- params[["tableParams"]] tableParamsBatch$data <- dataBatch summaryTable <- do.call(computeSummaryStatisticsTable, tableParamsBatch) summaryTable <- subset(summaryTable, !isTotal) # extra processing if required if(exists("tableProcessing")){ summaryTable <- processData( data = summaryTable, processing = tableProcessing, verbose = FALSE, labelVars = labelVars, labelData = "summary table" ) labelVars <- attr(summaryTable, "labelVars") } # add summary statistics to input data dataBatchWithStats <- base::merge( x = dataBatch, y = summaryTable, all.x = TRUE, sort = FALSE ) attr(dataBatchWithStats, "labelVars") <- labelVars dataBatchWithStats }, simplify = FALSE) data <- dataList$currentData labelVars <- attr(dataList$currentData, "labelVars")
dataPrevious <- dataList$previousData dataCurrent <- dataList$currentData if(!exists("comparisonTableParams")) comparisonTableParams <- NULL # By default, reference variables are the variables displayed by default # in the table attached to the plot if(is.null(comparisonTableParams$referenceVars)){ argsPlot <- plotParams argsPlot$labelVars <- labelVars referenceVars <- getPlotTableVars(plotFunction, plotArgs = argsPlot) # add looping var (in case e.g. replicated records across looping vars) referenceVars <- c(referenceVars, loopingVar) referenceVars <- setdiff(referenceVars, "Comparison type") comparisonTableParams$referenceVars <- referenceVars comparisonTableParams$changeableVars <- NULL } argsCompTable <- c( list( newData = dataCurrent, oldData = dataPrevious, outputType = comparisonTableType ), comparisonTableParams ) outputComparison <- do.call(clinUtils::compareTables, argsCompTable) if(!is.null(outputComparison)){ data <- outputComparison tableVars <- plotParams$tableVars if(is.null(tableVars)){ tableVars <- c(argsCompTable$referenceVars, argsCompTable$changeableVars) tableVars <- setdiff(tableVars, loopingVar) } tableVars <- c("Comparison type", tableVars) plotParams$tableVars <- tableVars }
if(!is.null(loopingVar)){ # format label for 'knitPrintClinDataReview' data[, loopingVar] <- colwise(function(x) gsub("\\.", "", x))(data[, loopingVar, drop = FALSE]) # only subset of the data if requested in _bookdown.yml if(exists("loopingNMax") && is.integer(loopingNMax)){ data <- merge( x = data, y = unique(data[, loopingVar, drop = FALSE])[seq_len(loopingNMax), , drop = FALSE], all = FALSE ) } } listPlots <- dlply(data, loopingVar, function(dataI){ # Create plot unique ID argsLabel <- c( list("plotTemplate"), if(!is.null(loopingVar)) unique(dataI[, loopingVar, drop = FALSE]) ) id <- do.call(formatLabel, argsLabel) # Create the plot # evaluate !r-lazy parameters argsPlot <- forceParams(plotParams) argsPlot$data <- dataI argsPlot$labelVars <- labelVars argsPlot$table <- TRUE argsPlot$pathVar = if(!is.null(patientProfilePath)) "patientProfilePath" argsPlot$id <- id do.call(plotFunction, argsPlot) }) knitPrintClinDataReview( list = listPlots, level = reportTitleLevel + 1 )
Any scripts or data that you put into this service are public.
Add the following code to your website.
For more information on customizing the embed code, read Embedding Snippets.