--- a
+++ b/R/sample.R
@@ -0,0 +1,549 @@
+## vrSample ####
+
+### subset ####
+
+#' Methods for vrSample objects
+#'
+#' Methods for \code{\link{vrSample}} objects for generics defined in other
+#' packages
+#'
+#' @param x A vrSample object
+#' @param i the name of layer associated with the sample, see \link{SampleMetadata}
+#' @param value a vrLayer object, see \link{vrLayer}
+#' 
+#' @name vrSample-methods
+#' @rdname vrSample-methods
+#'
+#' @concept vrsample
+#'
+NULL
+
+#' @describeIn vrSample-methods Accessing vrLayer objects from \code{vrSample} objects
+#' 
+#' @importFrom methods slot
+setMethod(
+  f = '[[',
+  signature = c('vrSample', "character"),
+  definition = function(x, i){
+
+    # sample names
+    layer_names <- names(methods::slot(x, "layer"))
+
+    # check query sample name
+    if(!i %in% layer_names){
+      stop("There are no layers named ", i, " in this sample")
+    }
+
+    # return samples
+    return(x@layer[[i]])
+  }
+)
+
+
+#' @describeIn vrSample-methods Accessing vrLayer objects from \code{vrSample} objects
+#' 
+#' @importFrom methods slot
+setMethod(
+  f = '[[<-',
+  signature = c('vrSample', "character"),
+  definition = function(x, i, value){
+
+    # check if value if vrLayer
+    if(!inherits(value, "vrLayer")){
+      stop("The provided object is not of class vrLayer")
+    }
+
+    # sample names
+    layer_names <- names(methods::slot(x, "layer"))
+
+    # check query sample name
+    if(!i %in% layer_names){
+      stop("There are no layers named ", i, " in this sample")
+    }
+
+    # change layer
+    x@layer[[i]] <- value
+
+    # return
+    return(x)
+  }
+)
+
+## vrBlock ####
+
+### subset ####
+
+#' @describeIn vrSample-methods (deprecated) Accessing vrLayer objects from \code{vrBlock} objects
+#' 
+#' @importFrom methods slot
+setMethod(
+  f = '[[',
+  signature = c('vrBlock', "character"),
+  definition = function(x, i){
+    
+    # sample names
+    layer_names <- names(methods::slot(x, "layer"))
+    
+    # check query sample name
+    if(!i %in% layer_names){
+      stop("There are no layers named ", i, " in this sample")
+    }
+    
+    # return samples
+    return(x@layer[[i]])
+  }
+)
+
+#' @describeIn vrSample-methods (deprecated) Overwriting vrLayer objects from \code{vrBlock} objects
+#' 
+#' @importFrom methods slot
+setMethod(
+  f = '[[<-',
+  signature = c('vrBlock', "character"),
+  definition = function(x, i, value){
+    
+    # check if value if vrLayer
+    if(!inherits(value, "vrLayer")){
+      stop("The provided object is not of class vrLayer")
+    }
+    
+    # sample names
+    layer_names <- names(methods::slot(x, "layer"))
+    
+    # check query sample name
+    if(!i %in% layer_names){
+      stop("There are no layers named ", i, " in this sample")
+    }
+    
+    # change layer
+    x@layer[[i]] <- value
+    
+    # return
+    return(x)
+  }
+)
+
+## vrLayer ####
+
+### subset ####
+
+#' Methods for vrLayer objects
+#'
+#' Methods for \code{\link{vrLayer}} objects for generics defined in other
+#' packages
+#'
+#' @param x A vrLayer object
+#' @param i the name of assay associated with the layer, see \link{SampleMetadata}
+#' @param value a vrAssayV2 object, see \link{vrAssayV2}
+#' 
+#' @name vrLayer-methods
+#' @rdname vrLayer-methods
+#'
+#' @concept vrlayer
+#'
+NULL
+
+#' @describeIn vrLayer-methods Accessing vrAssay objects from \code{vrLayer} objects
+#' 
+#' @importFrom methods slot
+setMethod(
+  f = '[[',
+  signature = c('vrLayer', "character"),
+  definition = function(x, i){
+
+    # if no assay were found, check sample names
+    assay_names <- names(methods::slot(x, "assay"))
+
+    # check query sample name
+    if(!i %in% assay_names){
+      stop("There are no assays named ", i, " in this object")
+    } else {
+      return(x@assay[[i]])
+    }
+  }
+)
+
+#' @describeIn vrLayer-methods Overwriting vrAssay objects from \code{vrLayer} objects
+#' 
+#' @importFrom methods slot
+setMethod(
+  f = '[[<-',
+  signature = c('vrLayer', "character"),
+  definition = function(x, i, value){
+
+    # if no assay were found, check sample names
+    assay_names <- names(methods::slot(x, "assay"))
+
+    # check query sample name
+    if(!i %in% assay_names){
+      stop("There are no assays named ", i, " in this object")
+    }
+
+    x@assay[[i]] <- value
+    return(x)
+  }
+)
+
+####
+# Methods ####
+####
+
+### vrSample Methods ####
+
+mergevrSample <- function(x, y, samples = NULL){
+  
+  # start
+  object <- x
+  object_list <- y
+   
+  # combine all elements
+  if(!is.list(object_list))
+    object_list <- list(object_list)
+  object_list <- c(object, object_list)
+  names(object_list) <- samples
+  
+  # set VoltRon class
+  return(object_list)
+}
+
+#' Merging vrSample objects
+#'
+#' Given a vrSample object, and a list of vrSample objects, merge all.
+#'
+#' @param x a vrSample object
+#' @param y a list of vrSample objects
+#' @param samples the sample names
+#'
+#' @method merge vrSample
+setMethod("merge", "vrSample", mergevrSample)
+
+#' Merging vrBlock objects
+#'
+#' Given a vrBlock object, and a list of vrSample objects, merge all.
+#' 
+#' @param x a vrSample object
+#' @param y a list of vrSample objects
+#' @param samples the sample names
+#' 
+#' @method merge vrBlock
+setMethod("merge", "vrBlock", mergevrSample)
+# merge.vrBlock <- function(object, object_list, samples = NULL){
+#   merge.vrSample(object, object_list = object_list, samples = samples)
+# }
+
+subsetvrSample <- function(x, subset, assays = NULL, spatialpoints = NULL, image = NULL) {
+  
+  # start
+  object <- x
+  
+  if (!missing(x = subset)) {
+    subset <- enquo(arg = subset)
+  }
+  
+  # subseting on samples, layers and assays
+  layers <- object@layer
+  if(!is.null(assays)){
+    object@layer <- sapply(layers, function(lay) {
+      subsetvrLayer(lay, assays = assays)
+    }, USE.NAMES = TRUE, simplify = TRUE)
+  } else if(!is.null(spatialpoints)){
+    object@layer <- sapply(layers, function(lay) {
+      subsetvrLayer(lay, spatialpoints = spatialpoints)
+    }, USE.NAMES = TRUE, simplify = TRUE)
+  } else if(!is.null(image)){
+    object@layer <- sapply(layers, function(lay) {
+      subsetvrLayer(lay, image = image)
+    }, USE.NAMES = TRUE, simplify = TRUE)
+  }
+  
+  # remove NULL assays
+  ind <- which(vapply(object@layer, function(x) !is.null(x), logical(1)))
+  object@layer <- object@layer[ind]
+  
+  # check if there are layers
+  if(length(object@layer) > 0){
+    
+    # get updated adjaceny and distance
+    catch_connect <- try(slot(object, name = "zlocation"), silent = TRUE)
+    if(!is(catch_connect, 'try-error') && !methods::is(catch_connect,'error')){
+      object@zlocation <- object@zlocation[ind]
+      object@adjacency <- object@adjacency[ind, ind, drop = FALSE]
+    }
+    
+    # return object
+    return(object)
+  } else {
+    return(NULL)
+  }
+}
+
+#' Subsetting vrSample objects
+#'
+#' Given a vrSample object, subset the object given one of the attributes
+#'
+#' @param x a vrSample object
+#' @param subset the subset statement
+#' @param assays the set of assays to subset the object
+#' @param spatialpoints the set of spatial points to subset the object
+#' @param image the subseting string passed to \link{image_crop}
+#'
+#' @method subset vrSample
+#' @order 6
+#'
+#' @importFrom rlang enquo
+setMethod("subset", "vrSample", subsetvrSample)
+
+#' Subsetting vrBlock objects
+#'
+#' Given a vrBlock object, subset the object given one of the attributes
+#' 
+#' @param x a vrSample object
+#' @param subset the subset statement
+#' @param assays the set of assays to subset the object
+#' @param spatialpoints the set of spatial points to subset the object
+#' @param image the subseting string passed to \link{image_crop}
+#'
+#' @method subset vrBlock
+#' @order 6
+setMethod("subset", "vrBlock", subsetvrSample)
+
+# subset.vrBlock <- function(object, subset, assays = NULL, spatialpoints = NULL, image = NULL){
+#   subset.vrSample(object, subset = subset, assays = assays, spatialpoints = spatialpoints, image = image)
+# }
+
+#' @rdname vrSpatialPoints
+#' @order 5
+#' @export
+setMethod("vrSpatialPoints", "vrSample", function(object) {
+  do.call("c", lapply(object@layer, function(lay) {
+    vrSpatialPoints(lay)
+  }))
+})
+
+#' @rdname vrSpatialPoints
+#' @order 5
+#' @export
+setMethod("vrSpatialPoints", "vrBlock", function(object) {
+  do.call("c", lapply(object@layer, function(lay) {
+    vrSpatialPoints(lay)
+  }))
+})
+
+changeAssayNamesvrSample <- function(object, sample.metadata = NULL){
+  
+  if(is.null(sample.metadata))
+    stop("Please provide a sample.metadata")
+  
+  if(!"NewAssayNames" %in% colnames(sample.metadata))
+    stop("Please provide a sample.metadata with NewAssayNames column which includes the new assay names")
+  
+  # change the assay names of the layers
+  layer_names <- names(object@layer)
+  for(lyr in layer_names)
+    object[[lyr]] <- changeAssayNames(object[[lyr]], sample.metadata = sample.metadata[sample.metadata$Layer == lyr,])
+  
+  # return
+  return(object)
+}
+
+#' changeAssayNames.vrSample
+#'
+#' Change the assay names of assays within a vrSample object
+#'
+#' @param sample.metadata the sample metadata with NewAssayNames column which includes the new assay names
+#' 
+#' @rdname changeAssayNames
+#'
+#' @noRd
+setMethod("changeAssayNames", "vrSample", changeAssayNamesvrSample)
+
+changeAssayNamesvrBlock <- function(object, sample.metadata = NULL) {
+  object <- changeAssayNamesvrSample(object, sample.metadata = sample.metadata)
+  return(object)
+}
+
+#' changeAssayNames.vrBlock
+#'
+#' Change the assay names of assays within a vrBlock object
+#' 
+#' @param sample.metadata the sample metadata with NewAssayNames column which includes the new assay names
+#' 
+#' @rdname changeAssayNames
+#'
+#' @noRd
+setMethod("changeAssayNames", "vrBlock", changeAssayNamesvrBlock)
+
+### vrLayer Methods ####
+
+subsetvrLayer <- function(x, subset, assays = NULL, spatialpoints = NULL, image = NULL) {
+  
+  # start
+  object <- x
+  
+  if (!missing(x = subset)) {
+    subset <- enquo(arg = subset)
+  }
+  
+  # subseting on samples, layers and assays
+  if(!is.null(assays)){
+    
+    # get assay names of all assays
+    assay_names <- vapply(object@assay, vrAssayNames, character(1))
+    if(any(assays %in% assay_names)) {
+      assays <- intersect(assays, assay_names)
+      object@assay  <- object@assay[which(assay_names %in% assays)]
+    } else if(any(assays %in% names(object@assay))) {
+      object@assay  <- object@assay[names(object@assay) %in% assays]
+    } else {
+      return(NULL)
+    }
+    
+  } else if(!is.null(spatialpoints)){
+    
+    # get points connected to queried spatialpoints
+    catch_connect <- try(slot(object, name = "connectivity"), silent = TRUE)
+    if(!is(catch_connect, 'try-error') && !methods::is(catch_connect,'error')){
+      if(igraph::vcount(object@connectivity) > 0){
+        spatialpoints <- getConnectedSpatialPoints(object, spatialpoints)
+        object@connectivity <- subset.Connectivity(object@connectivity, spatialpoints)
+      }
+    }
+    
+    # subset assays
+    object@assay <- sapply(object@assay, function(assy) {
+      if(inherits(assy, "vrAssay")){
+        # return(subset.vrAssay(assy, spatialpoints = spatialpoints))
+        return(subsetvrAssay(assy, spatialpoints = spatialpoints))
+      } else {
+        # return(subset.vrAssayV2(assy, spatialpoints = spatialpoints))
+        return(subsetvrAssay(assy, spatialpoints = spatialpoints))
+      }
+    }, USE.NAMES = TRUE, simplify = TRUE)
+    
+  } else if(!is.null(image)){
+    object@assay <- sapply(object@assay, function(assy) {
+      if(inherits(assy, "vrAssay")){
+        # return(subset.vrAssay(assy, image = image))
+        return(subsetvrAssay(assy, image = image))
+      } else {
+        return(subsetvrAssay(assy, image = image))
+      }
+    }, USE.NAMES = TRUE, simplify = TRUE)
+  }
+  
+  # remove NULL assays
+  object@assay <- object@assay[which(vapply(object@assay, function(x) !is.null(x), logical(1)))]
+  
+  # set VoltRon class
+  if(length(object@assay) > 0){
+    return(object)
+  } else {
+    return(NULL)
+  }
+}
+
+#' Subsetting vrLayer objects
+#'
+#' Given a vrLayer object, subset the object given one of the attributes
+#'
+#' @param x a vrLayer object
+#' @param subset the subset statement
+#' @param assays the set of assays to subset the object
+#' @param spatialpoints the set of spatial points to subset the object
+#' @param image the subseting string passed to \link{image_crop}
+#'
+#' @method subset vrLayer
+#' @order 7
+#'
+#' @importFrom rlang enquo
+#' @importFrom methods is
+setMethod("subset", "vrLayer", subsetvrLayer)
+
+#' @rdname vrSpatialPoints
+#' @order 6
+#' @export
+setMethod("vrSpatialPoints", "vrLayer", function(object) {
+  do.call("c", lapply(object@assay, function(assy) {
+      vrSpatialPoints(assy)
+  }))
+})
+
+#' subset.Connectivity
+#'
+#' Subsetting the connectivity graph of vrLayer using spatial points
+#'
+#' @param object the connectivity graph of the vrLayer
+#' @param spatialpoints the set of spatial points
+#'
+#' @importFrom igraph induced_subgraph
+#'
+#' @noRd
+subset.Connectivity <- function(object, spatialpoints = NULL){
+  return(igraph::induced_subgraph(object, spatialpoints))
+}
+
+#' getConnectedSpatialPoints
+#'
+#' get spatial points connected to other spatial points in the connectivity graph of vrLayer
+#'
+#' @param object A vrLayer object
+#' @param spatialpoints the set of spatial points
+#'
+#' @importFrom igraph neighborhood V vcount
+#'
+#' @noRd
+getConnectedSpatialPoints <- function(object, spatialpoints = NULL){
+  if(igraph::vcount(object@connectivity) > 0){
+    spatialpoints <- intersect(spatialpoints, igraph::V(object@connectivity)$name)
+    return(names(unlist(igraph::neighborhood(object@connectivity, nodes = spatialpoints))))
+  } else {
+    return(spatialpoints)
+  }
+}
+
+changeAssayNamesvrLayer <- function(object, sample.metadata = NULL){
+
+  if(is.null(sample.metadata))
+    stop("Please provide a sample.metadata")
+
+  if(!"NewAssayNames" %in% colnames(sample.metadata))
+    stop("Please provide a sample.metadata with NewAssayNames column which includes the new assay names")
+
+  # change the assay names of the connectivity graph if exists
+  catch_connect <- try(slot(object, name = "connectivity"), silent = TRUE)
+  if(!is(catch_connect, 'try-error') && !methods::is(catch_connect,'error')){
+    if(igraph::vcount(object@connectivity) > 0){
+      spatialpoints <- igraph::V(object@connectivity)$name
+      old_assay_names <- vapply(object@assay, vrAssayNames, character(1))
+      new_assay_names <- sample.metadata$NewAssayNames
+      cur_spatialpoints <- spatialpoints
+      for(i in seq_len(length(old_assay_names))){
+        if(old_assay_names[i]!=new_assay_names[i]){
+          ind <- grepl(paste0(old_assay_names[i],"$"), spatialpoints)
+          cur_spatialpoints[ind] <- gsub(paste0(old_assay_names[i],"$"), new_assay_names[i], spatialpoints[ind])
+        }
+      }
+      igraph::V(object@connectivity)$name <- cur_spatialpoints
+    }
+  }
+
+  # change the assay names of vrAssays
+  assay_names <- names(object@assay)
+  for(assy in assay_names)
+    vrAssayNames(object[[assy]]) <- rownames(sample.metadata[sample.metadata$Assay == assy,])
+
+  # return
+  return(object)
+}
+
+#' changeAssayNamesvrLayer
+#'
+#' Change the assay names of assays within a vrSample object
+#'
+#' @rdname changeAssayNames
+#'
+#' @importFrom igraph V V<- vcount
+#' @importFrom methods is
+#'
+#' @noRd
+setMethod("changeAssayNames", "vrLayer", changeAssayNamesvrLayer)