#' @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))

  }

)