#' Table
#'
#' @export
Table <- R6Class(
"Table",
private = list(
columns = NULL,
nRows = NULL,
properties = NULL,
fromJson = function(json){
private$fromColumns(json$nRows, lapply(json$columns, function(jsonColumn) Column$new(json=jsonColumn)))
private$properties = TableProperties$new(json=json$properties)
},
fromDataFrame = function(df){
private$fromColumns(nrow(df), lapply(colnames(df), function(cname) Column$new(name=cname, vector=unlist(df[[cname]]))))
},
fromColumns = function(nRows,columns) {
if (is.null(nRows)) stop("Table : nRows is required.")
if (is.null(columns)) stop("Table : columns is required.")
private$columns = columns
private$nRows = nRows
private$properties = TableProperties$new(name=newUUID())
}
),
public = list(
initialize = function(nRows=NULL,columns=NULL,df=NULL,json=NULL){
if (!is.null(json)){
private$fromJson(json)
} else if (!is.null(df)){
private$fromDataFrame(df)
} else {
private$fromColumns(nRows,columns)
}
},
getName = function() private$properties$name,
setName = function(n){
private$properties$name = n
},
getNRows = function() private$nRows,
getColumns = function() private$columns,
getColumn = function(name){
cc <- private$columns
list <- cc[sapply(cc, function(column) column$getName() == name)]
if (length(list) > 0) return (list[[1]])
return (NULL)
},
getColumnNames = function(){
return (lapply(private$columns, function(column) column$getName()))
},
as.data.frame = function(){
d <- data.frame(lapply(private$columns, function(column){
values = column$getValues()
data = values$getData()
if (values$getType() == "factor"){
dictionary = values$getDictionary()
data = factor(data, labels=dictionary)
}
return (data)
}))
colnames(d) <- make.names(lapply(private$columns, function(column) column$getName()))
return (d)
},
toTson = function() list(nRows=tson.int(private$nRows),
columns=lapply(private$columns, function(c) c$toTson()),
properties=private$properties$toTson())
)
)
#' ComputedTable
#'
#' @export
TableProperties <- R6Class(
'TableProperties',
public = list(
name = NULL,
initialize = function(name=NULL, json=NULL){
self$name = name
if (!is.null(json)){
self$name = json$name
}
},
toJson = function(){
return (list(name=self$name))
},
toTson = function(){
return (list(name=tson.character(self$name)))
}
)
)
#' ComputedTable
#'
#' @export
ComputedTable <- R6Class(
'ComputedTable',
inherit=Table,
private = list(
fromDataFrame = function(df){
super$fromDataFrame(df)
ids = self$getColumn(".ids")
if (is.null(ids)) stop("A column named .ids is required.")
values = ids$getValues()
data = values$getData()
if (!is.integer(data)) stop("A column ids must be integer.")
if (values$getType() != "num") stop("A column ids must be integer.")
values$setSubType("uint32")
}
)
)
MatrixTable <- R6Class(
'MatrixTable',
inherit=Table,
private = list(
idColumnName = NULL,
nMatrixCols = NULL,
nMatrixRows = NULL,
fromJson = function(json){
super$fromJson(json)
private$idColumnName=json$idColumnName
private$nMatrixCols=json$nMatrixCols
private$nMatrixRows=json$nMatrixRows
}
),
public = list(
initialize = function(nRows=NULL,nMatrixCols=NULL,nMatrixRows=NULL,idColumnName=".ids",columns=NULL,df=NULL,json=NULL){
super$initialize(nRows=nRows,columns=columns,df=df,json=json)
if (is.null(json)){
if (is.null(nMatrixCols)) stop("Table : nMatrixCols is required.")
if (is.null(nMatrixRows)) stop("Table : nMatrixRows is required.")
if (is.null(idColumnName)) stop("Table : idColumnName is required.")
private$nMatrixCols = nMatrixCols
private$nRows = nRows
}
},
getIdColumnName = function() private$idColumnName,
getNMatrixCols = function() private$nMatrixCols,
getNMatrixRows = function() private$nMatrixRows
)
)
Add the following code to your website.
For more information on customizing the embed code, read Embedding Snippets.