--- a +++ b/R/allclasses.R @@ -0,0 +1,447 @@ +#' @include zzz.R +#' @include allgenerics.R +#' @useDynLib VoltRon +NULL + +## vrImage #### + +# Set class union +suppressWarnings({ + setClassUnion("image_matrix", + members = c("matrix", + "data.frame", + "dgRMatrix", + "dgeMatrix", + "Array", + if (requireNamespace("BPCells", quietly = TRUE)) "IterableMatrix" else NULL)) +}) + +#' The vrImage (VoltRon Image) Class +#' +#' @slot coords spatial coordinates of the assay +#' @slot segments spatial coordinates of the segments, if available +#' @slot image image of the spatial assay, bitmap class +#' @slot main_channel the key of the main channel of vrImage object +#' +#' @name vrImage-class +#' @rdname vrImage-class +#' @exportClass vrImage +#' +vrImage <- setClass( + Class = 'vrImage', + slots = c( + coords = 'image_matrix', + segments = 'list', + image = "list", + main_channel = "character" + ) +) + +### show #### + +setMethod( + f = 'show', + signature = 'vrImage', + definition = function(object) { + + # separate names + image_names <- names(object@image) + image_id <- seq_along(image_names) + image_names_split <- split(image_names, ceiling(image_id/10)) + + cat("vrImage (VoltRon Image) Object \n") + text <- "Channels:" + for(img in image_names_split){ + cat(text, paste(img, collapse = ", "), "\n") + text <- " " + } + return(invisible(x = NULL)) + } +) + +## vrSpatial #### + +#' The vrSpatial (VoltRon Spatial) Class +#' +#' @slot coords spatial coordinates of the assay +#' @slot segments spatial coordinates of the segments, if available +#' @slot image image of the spatial assay, bitmap class +#' @slot main_channel the key of the main channel of vrImage object +#' +#' @name vrSpatial-class +#' @rdname vrSpatial-class +#' @exportClass vrSpatial +#' +vrSpatial <- setClass( + Class = 'vrSpatial', + slots = c( + coords = 'image_matrix', + segments = 'list', + image = "list", + main_channel = "character" + ) +) + +### show #### + +setMethod( + f = 'show', + signature = 'vrSpatial', + definition = function(object) { + + # separate names + image_names <- names(object@image) + image_id <- seq_along(image_names) + image_names_split <- split(image_names, ceiling(image_id/10)) + + cat("vrSpatial (VoltRon Spatial) Object \n") + text <- "Channels:" + for(img in image_names_split){ + cat(text, paste(img, collapse = ", "), "\n") + text <- " " + } + return(invisible(x = NULL)) + } +) + +## vrAssay #### + +# Set class union +suppressWarnings({ + setClassUnion("data_matrix", + members = c("matrix", + "dgCMatrix", "dgRMatrix", "dgeMatrix", + "Array", + if (requireNamespace("BPCells", quietly = TRUE)) "IterableMatrix" else NULL)) +}) + +#' The vrAssay (VoltRon Assay) Class +#' +#' @slot rawdata raw data +#' @slot normdata normalized data +#' @slot featuredata feature metadata +#' @slot embeddings list of embeddings +#' @slot image a list of vrImage objects +#' @slot params additional parameters used by different assay types +#' @slot type the type of the assay (tile, molecule, cell, spot, ROI) +#' @slot name the assay name +#' @slot main_image the key of the main image +#' +#' @name vrAssay-class +#' @rdname vrAssay-class +#' @exportClass vrAssay +vrAssay <- setClass( + Class = 'vrAssay', + slots = c( + rawdata = 'data_matrix', + normdata = 'data_matrix', + featuredata = 'data.frame', + embeddings = "list", + image = "list", + params = "list", + type = "character", + name = "character", + main_image = "character" + ) +) + +### show #### + +setMethod( + f = 'show', + signature = 'vrAssay', + definition = function(object) { + cat("vrAssay (VoltRon Assay) of", nrow(vrCoordinates(object)), "spatial points and", nrow(object@rawdata), "features. \n") + return(invisible(x = NULL)) + } +) + +## vrAssayV2 #### + +#' The vrAssayV2 (VoltRon Assay) Class +#' +#' @slot data list of count/normalized datasets +#' @slot featuredata list of feature metadata +#' @slot embeddings list of embeddings +#' @slot image a list of vrImage objects +#' @slot params additional parameters used by different assay types +#' @slot type the type of the assay (tile, molecule, cell, spot, ROI) +#' @slot name the assay name +#' @slot main_image the key of the main image +#' @slot main_featureset the key of the main feature set +#' +#' @name vrAssayV2-class +#' @rdname vrAssayV2-class +#' @exportClass vrAssayV2 +vrAssayV2 <- setClass( + Class = 'vrAssayV2', + slots = c( + data = "list", + featuredata = 'list', + embeddings = "list", + image = "list", + params = "list", + type = "character", + name = "character", + main_image = "character", + main_featureset = "character" + ) +) + +### show #### + +setMethod( + f = 'show', + signature = 'vrAssayV2', + definition = function(object) { + + # check if there is a data or rawdata slot in assay object + cat( + paste0("vrAssayV2 (VoltRon Assay V2) of ", + nrow(vrCoordinates(object)), " spatial points and ", + nrow(object@data[[vrMainFeatureType(object)]]), " features (", vrMainFeatureType(object), "). \n") + ) + + return(invisible(x = NULL)) + } +) + +## vrLayer #### + +# Set classes +setOldClass(Classes = c('igraph')) + +#' The vrLayer (VoltRon Layer) Class +#' +#' @slot assay A list of assays (vrAssay) +#' @slot connectivity the connectivity graph +#' +#' @name vrLayer-class +#' @rdname vrLayer-class +#' @exportClass vrLayer +#' +vrLayer <- setClass( + Class = 'vrLayer', + slots = c( + assay = 'list', + connectivity = 'igraph' + ) +) + +### show #### + +setMethod( + f = 'show', + signature = 'vrLayer', + definition = function(object) { + cat(class(x = object), "(VoltRon Layer) Object \n") + layers <- names(unlist(object@assay)) + cat("Assay(s):", paste(layers, collapse = " "), "\n") + return(invisible(x = NULL)) + } +) + +## vrSample #### + +#' The vrSample (VoltRon Sample) Class +#' +#' @slot layer A list of layers (vrLayer) +#' @slot zlocation a vector of z coordinates of layers +#' @slot adjacency an adjacency matrix of connected layers within a block +#' +#' @name vrSample-class +#' @rdname vrSample-class +#' @exportClass vrSample +#' +vrSample <- setClass( + Class = 'vrSample', + slots = c( + layer = 'list', + zlocation = 'numeric', + adjacency = "matrix" + ) +) + +### show #### + +setMethod( + f = 'show', + signature = 'vrSample', + definition = function(object) { + cat(class(x = object), "(VoltRon Block) Object \n") + layers <- names(unlist(object@layer)) + cat("Layer(s):", paste(layers, collapse = " "), "\n") + return(invisible(x = NULL)) + } +) + +## vrBlock #### + +#' The vrBlock (VoltRon Block) Class +#' +#' @slot layer A list of layers (vrLayer) +#' @slot zlocation a vector of z coordinates of layers +#' @slot adjacency an adjacency matrix of connected layers within a block +#' +#' @name vrBlock-class +#' @rdname vrBlock-class +#' @exportClass vrBlock +#' +vrBlock <- setClass( + Class = 'vrBlock', + slots = c( + layer = 'list', + zlocation = 'numeric', + adjacency = "matrix" + ) +) + +### show #### + +setMethod( + f = 'show', + signature = 'vrBlock', + definition = function(object) { + cat(class(x = object), "(VoltRon Block) Object \n") + layers <- names(unlist(object@layer)) + cat("Layer(s):", paste(layers, collapse = " "), "\n") + return(invisible(x = NULL)) + } +) + +## vrMetadata #### + +suppressWarnings({ + setClassUnion("metadata_data", + members = c("data.table", + "data.frame", + if (requireNamespace("S4Vectors", quietly = TRUE)) "DataFrame" else NULL, + if (requireNamespace("HDF5DataFrame", quietly = TRUE)) "HDF5DataFrame" else NULL, + if (requireNamespace("ZarrDataFrame", quietly = TRUE)) "ZarrDataFrame" else NULL)) +}) + +#' The vrMetadata (VoltRon Metadata) Class +#' +#' @slot tile the metadata of tiles +#' @slot molecule the metadata of molecules +#' @slot cell the metadata of cells +#' @slot spot the metadata of spot +#' @slot ROI the metadata of ROI +#' +#' @name vrMetadata-class +#' @rdname vrMetadata-class +#' @exportClass vrMetadata +#' +vrMetadata <- setClass( + Class = 'vrMetadata', + slots = c( + molecule = 'metadata_data', + cell = 'metadata_data', + spot = 'metadata_data', + ROI = 'metadata_data', + tile = 'metadata_data' + ) +) + +### show #### + +setMethod( + f = 'show', + signature = 'vrMetadata', + definition = function(object) { + cat("VoltRon Metadata Object \n") + cat("This object includes: \n") + lapply(methods::slotNames(object), function(x){ + if(nrow(slot(object, name = x))){ + cat(" ", nrow(slot(object, name = x)), paste0(x, "s"), "\n") + } + }) + return(invisible(x = NULL)) + } +) + +## VoltRon #### + +#' The VoltRon Class +#' +#' @slot samples A list of samples (vrSample) +#' @slot metadata A vrMetadata object that includes metadata of ROIs, spots, and cells +#' @slot sample.metadata Contains meta-information about each sample, layer and assay +#' @slot graph A igraph object +#' @slot main.assay The type of the main assay (i.e. Visium, Xenium, GeoMx etc.) +#' @slot project Name of the project +#' +#' @name VoltRon-class +#' @rdname VoltRon-class +#' @exportClass VoltRon +VoltRon <- setClass( + Class = 'VoltRon', + slots = c( + samples = 'list', + metadata = "vrMetadata", + sample.metadata = "data.frame", + graph = "list", + main.assay = "character", + project = 'character' + ) +) + +### show #### + +setMethod( + f = 'show', + signature = 'VoltRon', + definition = function(object) { + + # print class + cat(class(x = object), "Object \n") + + # sample metadata + sample.metadata <- SampleMetadata(object) + + # get sample and layer names + sample_names <- unique(sample.metadata$Sample) + show_length <- min(5,length(sample_names)) + for(samp in sample_names[seq_len(show_length)]){ + cat(samp, ": \n", sep = "") + layers <- unique(sample.metadata$Layer[sample.metadata$Sample == samp]) + layers <- split(layers, ceiling(seq_along(layers)/5)) + cat(" Layers:", paste(layers[[1]], collapse = " "), "\n") + if(length(layers) > 1){ + for(i in 2:length(layers)){ + cat(" ", paste(layers[[i]], collapse = " "), "\n") + } + } + } + + # get assay names + unique_assays <- unique(sample.metadata$Assay) + + # print + if(length(sample_names) > 5){ + cat("...", "\n") + cat("There are", length(sample_names), "samples in total", "\n") + } + + # print assays + main.assay <- vrMainAssay(object) + unique_assays <- unique_assays[c(which(unique_assays == main.assay),which(unique_assays != main.assay))] + unique_assays[1] <- paste0(unique_assays[1], "(Main)") + cat("Assays:", paste(unique_assays, collapse = " "), "\n") + + # print features + main.feat <- vrMainFeatureType(object) + if(!is.null(main.feat)){ + main.feat <- unique(vrMainFeatureType(object)$Feature) + unique_features <- vrFeatureTypeNames(object) + if(length(main.feat) == 1){ + unique_features <- unique_features[c(which(unique_features == main.feat),which(unique_features != main.feat))] + unique_features[1] <- paste0(unique_features[1], "(Main)") + } + cat("Features:", paste(unique_features, collapse = " "), "\n") + } + + # return invisible + return(invisible(x = NULL)) + } +) \ No newline at end of file