#' R6 class that represents a cell in a table.
#'
#' @description
#' The `TableCell` class represents a cell in a table. Both header cells and body
#' cells are represented by this class.
#'
#' @docType class
#' @importFrom R6 R6Class
#' @export
#' @format \code{\link{R6Class}} object.
#' @examples
#' # This class should only be created by using the functions in the table.
#' # It is not intended to be created by users outside of the table.
#' library(basictabler)
#' tbl <- qtbl(data.frame(a=1:2, b=3:4))
#' cell1 <- tbl$cells$setCell(r=4, c=1, cellType="cell", rawValue=5)
#' cell2 <- tbl$cells$setCell(r=4, c=2, cellType="cell", rawValue=6)
#' tbl$renderTable()
TableCell <- R6::R6Class("TableCell",
public = list(
#' @description
#' Create a new `TableCell` object.
#' @param parentTable Owning table.
#' @param rowNumber The row number of the cell. 1 = the first (i.e. top) data
#' row.
#' @param columnNumber The column number of the cell. 1 = the first (i.e.
#' leftmost) data column.
#' @param cellType One of the following values that specifies the type of cell:
#' root, rowHeader, columnHeader, cell, total. The cellType controls the
#' default styling that is applied to the cell.
#' @param visible `TRUE` or `FALSE` to specify whether the cell is rendered.
#' @param rawValue The original unformatted value.
#' @param formattedValue The formatted value (i.e. normally of character data
#' type).
#' @param baseStyleName The name of the style applied to this cell (a character
#' value). The style must exist in the TableStyles object associated with the
#' table.
#' @param styleDeclarations A list containing CSS style declarations.
#' @param asNBSP `TRUE` or `FALSE` to specify whether cells with no formatted
#' value be output as html nbsp.
#' @return No return value.
initialize = function(parentTable, rowNumber=NULL, columnNumber=NULL, cellType="cell", visible=TRUE, rawValue=NULL, formattedValue=NULL, baseStyleName=NULL, styleDeclarations=NULL, asNBSP=FALSE) {
if(parentTable$argumentCheckMode > 0) {
checkArgument(parentTable$argumentCheckMode, FALSE, "TableCell", "initialize", parentTable, missing(parentTable), allowMissing=FALSE, allowNull=FALSE, allowedClasses="BasicTable")
checkArgument(parentTable$argumentCheckMode, FALSE, "TableCell", "initialize", rowNumber, missing(rowNumber), allowMissing=FALSE, allowNull=FALSE, allowedClasses=c("integer", "numeric"))
checkArgument(parentTable$argumentCheckMode, FALSE, "TableCell", "initialize", columnNumber, missing(columnNumber), allowMissing=FALSE, allowNull=FALSE, allowedClasses=c("integer", "numeric"))
checkArgument(parentTable$argumentCheckMode, FALSE, "TableCell", "initialize", cellType, missing(cellType), allowMissing=TRUE, allowNull=FALSE, allowedClasses="character", allowedValues=c("root", "rowHeader", "columnHeader", "cell", "total"))
checkArgument(parentTable$argumentCheckMode, FALSE, "TableCell", "initialize", visible, missing(visible), allowMissing=TRUE, allowNull=FALSE, allowedClasses="logical")
checkArgument(parentTable$argumentCheckMode, FALSE, "TableCell", "initialize", rawValue, missing(rawValue), allowMissing=TRUE, allowNull=TRUE, allowedClasses=c("logical", "integer", "numeric", "complex", "character", "factor", "Date", "POSIXct", "POSIXlt"))
checkArgument(parentTable$argumentCheckMode, FALSE, "TableCell", "initialize", formattedValue, missing(formattedValue), allowMissing=TRUE, allowNull=TRUE, allowedClasses=c("logical", "integer", "numeric", "complex", "character", "factor", "Date", "POSIXct", "POSIXlt"))
checkArgument(parentTable$argumentCheckMode, FALSE, "TableCell", "initialize", baseStyleName, missing(baseStyleName), allowMissing=TRUE, allowNull=TRUE, allowedClasses="character")
checkArgument(parentTable$argumentCheckMode, FALSE, "TableCell", "initialize", styleDeclarations, missing(styleDeclarations), allowMissing=TRUE, allowNull=TRUE, allowedClasses="list", allowedListElementClasses=c("character", "integer", "numeric"))
checkArgument(parentTable$argumentCheckMode, FALSE, "TableCell", "initialize", asNBSP, missing(asNBSP), allowMissing=TRUE, allowNull=FALSE, allowedClasses="logical")
}
private$p_parentTable <- parentTable
if(private$p_parentTable$traceEnabled==TRUE) private$p_parentTable$trace("TableCell$new", "Creating new TableCell",
list(rowNumber=rowNumber, columnNumber=columnNumber))
private$p_instanceId <- private$p_parentTable$getNextInstanceId()
private$p_rowNumber <- rowNumber
private$p_columnNumber <- columnNumber
private$p_cellType <- cellType
private$p_visible <- visible
private$p_rawValue <- rawValue
private$p_formattedValue <- as.character(formattedValue)
private$p_asNBSP <- asNBSP
private$p_baseStyleName <- baseStyleName
if (!is.null(styleDeclarations)) private$p_style = private$p_parentTable$createInlineStyle(baseStyleName=baseStyleName, declarations=styleDeclarations)
if(private$p_parentTable$traceEnabled==TRUE) private$p_parentTable$trace("TableCell$new", "Created new TableCell")
},
#' @description
#' Set the cell location in the table. Mainly exists for internal use.
#' Typically used after rows/columns/cells are inserted or deleted (which
#' shifts other cells).
#' @param rowNumber The row number of the cell. 1 = the first (i.e. top) data
#' row.
#' @param columnNumber The column number of the cell. 1 = the first (i.e.
#' leftmost) data column.
#' @return No return value.
updatePosition = function(rowNumber=NULL, columnNumber=NULL) {
if(private$p_parentTable$argumentCheckMode > 0) {
checkArgument(private$p_parentTable$argumentCheckMode, FALSE, "TableCell", "updatePosition", rowNumber, missing(rowNumber), allowMissing=FALSE, allowNull=FALSE, allowedClasses=c("integer", "numeric"))
checkArgument(private$p_parentTable$argumentCheckMode, FALSE, "TableCell", "updatePosition", columnNumber, missing(columnNumber), allowMissing=FALSE, allowNull=FALSE, allowedClasses=c("integer", "numeric"))
}
private$p_rowNumber <- rowNumber
private$p_columnNumber <- columnNumber
},
#' @description
#' Stub only (ignore).
#' @return No return value.
getCopy = function() {
copy <- list()
return(invisible(copy))
},
#' @description
#' Return the contents of this object as a list for debugging.
#' @return A list of various object properties.
asList = function() {
lst <- list(
row=private$p_rowNumber,
column=private$p_columnNumber,
cellType=private$p_cellType,
visible=private$p_visible,
rawValue=private$p_rawValue,
formattedValue=private$p_formattedValue,
asNBSP=private$p_asNBSP
)
return(invisible(lst))
},
#' @description
#' Return the contents of this object as JSON for debugging.
#' @return A JSON representation of various object properties.
asJSON = function() {
if (!requireNamespace("jsonlite", quietly = TRUE)) {
stop("The jsonlite package is needed to convert to JSON. Please install the jsonlite package.", call. = FALSE)
}
jsonliteversion <- utils::packageDescription("jsonlite")$Version
if(numeric_version(jsonliteversion) < numeric_version("1.1")) {
stop("Version 1.1 or above of the jsonlite package is needed to convert to JSON. Please install an updated version of the jsonlite package.", call. = FALSE)
}
return(jsonlite::toJSON(self$asList()))
}
),
active = list(
#' @field instanceId An integer value that uniquely identifies this cell.
#' NB: This number is guaranteed to be unique within the table,
#' but the method of generation of the values may change in future, so
#' you are advised not to base any logic on specific values.
instanceId = function(value) { return(invisible(private$p_instanceId)) },
#' @field cellType One of the following values that specifies the type of cell:
#' root, rowHeader, columnHeader, cell, total. The cellType controls the
#' default styling that is applied to the cell.
cellType = function(value) {
if(missing(value)) return(invisible(private$p_cellType))
else {
if(private$p_parentTable$argumentCheckMode > 0) {
checkArgument(private$p_parentTable$argumentCheckMode, FALSE, "TableCell", "cellType", value, missing(value), allowMissing=TRUE, allowNull=TRUE, allowedClasses="character", allowedValues=c("root", "rowHeader", "columnHeader", "cell", "total"))
}
private$p_cellType <- value
return(invisible())
}
},
#' @field rowNumber The row number of the cell. 1 = the first (i.e. top) data
#' row.
rowNumber = function(value) { return(invisible(private$p_rowNumber)) },
#' @field columnNumber The column number of the cell. 1 = the first (i.e.
#' leftmost) data column.
columnNumber = function(value) { return(invisible(private$p_columnNumber)) },
#' @field visible TRUE or FALSE to specify whether the cell is rendered.
visible = function(value) {
if(missing(value)) return(invisible(private$p_visible))
else {
if(private$p_parentTable$argumentCheckMode > 0) {
checkArgument(private$p_parentTable$argumentCheckMode, FALSE, "TableCell", "visible", value, missing(value), allowMissing=TRUE, allowNull=TRUE, allowedClasses="logical")
}
private$p_visible <- value
return(invisible())
}
},
#' @field rawValue The original unformatted value.
rawValue = function(value) {
if(missing(value)) return(invisible(private$p_rawValue))
else {
if(private$p_parentTable$argumentCheckMode > 0) {
checkArgument(private$p_parentTable$argumentCheckMode, FALSE, "TableCell", "rawValue", value, missing(value), allowMissing=TRUE, allowNull=TRUE, allowedClasses=c("logical", "integer", "numeric", "complex", "character", "factor", "Date", "POSIXct", "POSIXlt"))
}
private$p_rawValue <- value
return(invisible())
}
},
#' @field formattedValue The formatted value (i.e. normally of character data
#' type).
formattedValue = function(value) {
if(missing(value)) return(invisible(private$p_formattedValue))
else {
if(private$p_parentTable$argumentCheckMode > 0) {
checkArgument(private$p_parentTable$argumentCheckMode, FALSE, "TableCell", "formattedValue", value, missing(value), allowMissing=TRUE, allowNull=TRUE, allowedClasses=c("logical", "integer", "numeric", "complex", "character", "factor", "Date", "POSIXct", "POSIXlt"))
}
private$p_formattedValue <- as.character(value)
return(invisible())
}
},
#' @field asNBSP TRUE or FALSE to specify whether cells with no formatted
#' value be output as html nbsp.
asNBSP = function(value) {
if(missing(value)) return(invisible(private$p_asNBSP))
else {
if(private$p_parentTable$argumentCheckMode > 0) {
checkArgument(private$p_parentTable$argumentCheckMode, FALSE, "TableCell", "asNBSP", value, missing(value), allowMissing=TRUE, allowNull=FALSE, allowedClasses="logical")
}
private$p_formattedValue <- value
return(invisible())
}
},
#' @field fValueOrNBSP For internal use by the renderers only.
fValueOrNBSP = function(value) {
hasValue <- FALSE
if(length(private$p_formattedValue)>0)
{
hasValue <- (nchar(private$p_formattedValue)>0)
}
if((!hasValue) && (private$p_asNBSP==TRUE)) {
return(invisible(htmltools::HTML(" ")))
}
else { return(invisible(private$p_formattedValue)) }
},
#' @field isMerged For internal use by the renderers only.
isMerged = function(value) { # for internal use by the renderers only
if(missing(value)) { return(invisible(private$p_isMerged)) }
else {
private$p_isMerged <- value
return(invisible())
}
},
#' @field isMergeRoot For internal use by the renderers only.
isMergeRoot = function(value) { # for internal use by the renderers only
if(missing(value)) { return(invisible(private$p_isMergeRoot)) }
else {
private$p_isMergeRoot <- value
return(invisible())
}
},
#' @field mergeIndex For internal use by the renderers only.
mergeIndex = function(value) { # for internal use by the renderers only
if(missing(value)) { return(invisible(private$p_mergeIndex)) }
else {
private$p_mergeIndex <- value
return(invisible())
}
},
#' @field baseStyleName The name of the style applied to this cell (a character
#' value). The style must exist in the TableStyles object associated with the
#' table.
baseStyleName = function(value) {
if(missing(value)) { return(invisible(private$p_baseStyleName)) }
else {
if(private$p_parentTable$argumentCheckMode > 0) {
checkArgument(private$p_parentTable$argumentCheckMode, FALSE, "TableCell", "baseStyleName", value, missing(value), allowMissing=FALSE, allowNull=FALSE, allowedClasses="character")
}
private$p_baseStyleName <- value
return(invisible())
}
},
#' @field style A TableStyle object that can apply overrides to the base style
#' for this cell.
style = function(value) {
if(missing(value)) { return(invisible(private$p_style)) }
else {
if(private$p_parentTable$argumentCheckMode > 0) {
checkArgument(private$p_parentTable$argumentCheckMode, FALSE, "TableCell", "style", value, missing(value), allowMissing=FALSE, allowNull=FALSE, allowedClasses="TableStyle")
}
private$p_style <- value
return(invisible())
}
}
),
private = list(
p_parentTable = NULL, # an object ref (the single table instance)
p_instanceId = NULL, # an integer
p_rowNumber = NULL, # an integer
p_columnNumber = NULL, # an integer
p_cellType = NULL, # root, rowHeader, columnHeader, cell, total
p_isMerged = NULL, # TRUE if the cell is part of a merged cell (but only set by BasicTable$applyCellMerges())
p_isMergeRoot = NULL, # TRUE if the cell is the top-most, left-most cell in the merged cell (also only set by...)
p_mergeIndex = NULL, # the index of the merged cell (also only set by...)
p_visible = NULL,
p_rawValue = NULL , # a value (unique to this cell)
p_formattedValue = NULL, # a value (unique to this cell)
p_asNBSP = NULL, # TRUE to output cells without a formatted value as in html
p_baseStyleName = NULL, # a string
p_style = NULL # an object ref (may or may not be shared) to a TableStyle object
)
)
Add the following code to your website.
For more information on customizing the embed code, read Embedding Snippets.