Nothing
#' Create a 'clinical data table', associated to a plot.
#'
#' Interactive table is created, with the possibility to have
#' clickeable link to patient-specific report, and included
#' within a button.
#' @param keyLab String with label for \code{keyVar}.
#' @param tableButton Logical, if TRUE (by default)
#' the table is included within an HTML button.
#' @param tableVars Character vector with variables to be included
#' in the table.
#' @param tableLab Named character vector with labels
#' for each \code{tableVars}.
#' @param tablePars List with parameters passed to the
#' \code{\link[clinUtils]{getClinDT}} function.
#' @param verbose Logical, if TRUE (FALSE by default) progress messages are printed
#' in the current console.
#' @inheritParams formatDataForPlotClinData
#' @inheritParams clinDataReview-common-args
#' @inheritParams clinDataReview-common-args-summaryStatsVis
#' @return \code{\link[DT]{datatable}}
#' @author Laure Cougnaud
#' @importFrom clinUtils getClinDT getLabelVar
#' @importFrom crosstalk SharedData
#' @importFrom stats as.formula
#' @export
tableClinData <- function(
data,
idVar = "USUBJID", idLab = getLabelVar(idVar, labelVars = labelVars),
keyVar = NULL, keyLab = getLabelVar(keyVar, labelVars = labelVars),
pathVar = NULL, pathLab = getLabelVar(pathVar, labelVars = labelVars),
pathExpand = FALSE,
tableVars = colnames(data),
tableLab = getLabelVar(tableVars, labelVars = labelVars),
tableButton = TRUE, tablePars = list(),
id = paste0("plotClinData", sample.int(n = 1000, size = 1)),
labelVars = NULL,
verbose = FALSE){
tableVarsInit <- tableVars
if(is.null(tablePars)) tablePars <- list()
if(!idVar %in% colnames(data))
warning(paste(
"Subject ID variable:", idVar,
"is not available in the data, so it is ignored."
))
# add key/id in variables to display
# (used for linking plot <-> table and for the path)
tableVars <- unique(c(
if(idVar %in% colnames(data)) setdiff(idVar, tableVars),
tableVars,
keyVar
))
tableLab <- c(
getLabelVar(var = idVar, label = idLab, labelVars = labelVars),
tableLab,
getLabelVar(var = keyVar, label = keyLab, labelVars = labelVars)
)
tableLab <- tableLab[!duplicated(names(tableLab))]
usePathVar <- !is.null(pathVar)
if(usePathVar && !pathVar %in% colnames(data)){
warning(paste(
"Variable with path to subject profile:", pathVar,
"is not available in the data, so it is ignored."
))
usePathVar <- FALSE
}
# add hyperlink in the table:
if(usePathVar){
tableVars <- c(pathVar, tableVars) # add in variables for DT
# create the hyperlink (if not already created)
if(pathExpand){
tableLab[pathVar] <- getLabelVar(var = pathVar,
label = pathLab, labelVars = labelVars)
}
}
# retain only specified variables:
data <- data[, tableVars, drop = FALSE]
# convert character columns to factor
colCharacter <- sapply(data, function(x)
is.character(x) & !is.factor(x)
)
data[, colCharacter] <- lapply(data[, colCharacter, drop = FALSE], as.factor)
## set DT options
if(usePathVar){
tablePars <- c(tablePars,
# escape column with hyperlink
if(!is.null(pathVar) & pathExpand)
c(
list(escape = -match(pathVar, colnames(data))),
# expand the variable
list(expandVar = pathVar)
)
)
}
# ID column non visible:
# if not specified in input columns
# or added in the pathVar column
colsNonVisibleExtra <- c(
# remove pathVar if saved in pathVar column
if(usePathVar & !pathExpand) pathVar,
# key-columns not displayed
if(!all(keyVar %in% tableVarsInit)) setdiff(keyVar, tableVarsInit)
)
if(length(colsNonVisibleExtra) > 0){
tablePars$nonVisibleVar <- unique(c(tablePars$nonVisibleVar, colsNonVisibleExtra))
}
tablePars$colnames <- setNames(names(tableLab), tableLab)
# use idVar column in DT (for filter/sortering), and display it with hyperlink
if(usePathVar & !pathExpand){
iPath <- match(pathVar, tableVars)-1
filterHyperlinkJS <- JS("function(data, type, row){",
" if(type === 'display'){",
paste0("var link = '<a href=\"' + row[", iPath,
"] + '\" target=\"_blank\">' + data + '</a>';"),
" return link;",
" } else {",
" return data;",
" }",
"}"
)
tablePars$options$columnDefs <- c(tablePars$options$columnDefs,
list(list(targets = match(idVar, tableVars)-1, render = filterHyperlinkJS))
)
}
# build shared data
dataTableSharedData <- crosstalk::SharedData$new(
data = data,
key = if(!is.null(keyVar)) varToFm(keyVar),
group = id
)
# create table
argsClinDT <- c(list(data = dataTableSharedData), tablePars)
table <- do.call(getClinDT, argsClinDT)
if(tableButton){
attributes(table)$metadata <- list(
button = tableButton,
buttonTitle = "Click to show or hide the data associated to the plot"
)
}
return(table)
}
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.