Merge pull request #184 from BIMSBbioinfo/dev

Dev -> main
BIMSBbioinfo · Dec 30, 2024 · 058d50f · 058d50f
2 parents a2d7642 + e62246e
commit 058d50f
Show file tree

Hide file tree

Showing 38 changed files with 918 additions and 600 deletions.
diff --git a/NAMESPACE b/NAMESPACE
@@ -331,6 +331,8 @@ importFrom(ggplot2,coord_fixed)
 importFrom(ggplot2,geom_rect)
 importFrom(ggplot2,ggplot)
 importFrom(ggplot2,ggproto)
+importFrom(ggplot2,xlim)
+importFrom(ggplot2,ylim)
 importFrom(ggpubr,ggarrange)
 importFrom(ggrepel,geom_label_repel)
 importFrom(grDevices,as.raster)

diff --git a/R/assay.R b/R/assay.R
@@ -553,22 +553,31 @@ vrMainFeatureType.vrAssayV2 <- function(object){
 #' @export
 vrMainFeatureType.vrAssay <- vrMainFeatureType.vrAssayV2
 
+#' @param ignore ignore if some assays dont have the feature set name
+#' 
 #' @rdname vrMainFeatureType
 #' @order 5
 #' @export
 "vrMainFeatureType<-.vrAssayV2" <- function(object, ignore = FALSE, value){
   if(value %in% names(object@data)){
     object@main_featureset <- value
-  } else if(!ignore){
-    stop("the feature type '", value, "' is not found in the assay!") 
+  } else {
+    if(ignore){
+      warning("The feature type '", value, "' is not found in '", vrAssayNames(object),"'. Main feature type is still set to '", vrMainFeatureType(object), "'")
+    } else {
+      stop("The feature type '", value, "' is not found in '", vrAssayNames(object),"'. Use ignore = TRUE for ignoring this message")
+    }
   }
+
   return(object)
 }
 
+#' @param ignore ignore if some assays dont have the feature set name
+#' 
 #' @rdname vrMainFeatureType
 #' @order 5
 #' @export
-"vrMainFeatureType<-.vrAssay" <- function(object, value){
+"vrMainFeatureType<-.vrAssay" <- function(object, ignore = FALSE, value){
   stop("vrAssay V1 objects do not have multiple feature types!")
 }
 

diff --git a/R/clustering.R b/R/clustering.R
@@ -117,7 +117,8 @@ knn_annoy <- function(data, query = data, k = 10, n_trees = 50, search_k = -1) {
 #' Get clustering of the VoltRon object
 #'
 #' @param object a VoltRon object
-#' @param resolution the resolution parameter for leiden clustering
+#' @param resolution the resolution parameter for leiden clustering.
+#' @param nclus The number of cluster centers for K-means clustering.
 #' @param assay assay name (exp: Assay1) or assay class (exp: Visium, Xenium), see \link{SampleMetadata}. 
 #' if NULL, the default assay will be used, see \link{vrMainAssay}.
 #' @param method The method of clustering. Use 'leiden' to perform graph clustering and 'kmeans' for K-means based clustering

diff --git a/R/generics.R b/R/generics.R
@@ -526,7 +526,7 @@ vrMainSpatial <- function(object, assay = NULL) {
 #' @rdname vrMainImage
 #' @export vrMainImage<-
 #' @noRd
-"vrMainImage<-" <- function(object, assay = NULL, value) {
+"vrMainImage<-" <- function(object, assay = NULL, ignore = FALSE, value) {
   UseMethod(generic = 'vrMainImage<-', object = object)
 }
 
@@ -539,7 +539,7 @@ vrMainSpatial <- function(object, assay = NULL) {
 #' @rdname vrMainSpatial
 #' @export vrMainSpatial<-
 #' @noRd
-"vrMainSpatial<-" <- function(object, assay = NULL, value) {
+"vrMainSpatial<-" <- function(object, assay = NULL, ignore = FALSE, value) {
   UseMethod(generic = 'vrMainSpatial<-', object = object)
 }
 

diff --git a/R/image.R b/R/image.R
@@ -571,11 +571,9 @@ vrMainImage.VoltRon <- function(object, assay = NULL){
   }
 
   # get assay types
-  # image_names <- unlist(lapply(assay_names, function(x) vrMainImage(object[[x]])))
   spatial_names <- unlist(lapply(assay_names, function(x) vrMainSpatial(object[[x]])))
 
   # return data
-  # image_data <- data.frame(Assay = assay_names, Image = image_names)
   spatial_data <- data.frame(Assay = assay_names, Spatial = spatial_names)
 
   # return
@@ -598,16 +596,20 @@ vrMainSpatial.VoltRon <- function(object, assay = NULL){
 #' @order 4
 #' @export
 "vrMainImage<-.VoltRon" <- function(object, assay = NULL, value){
-
-  if(!is.null(assay)){
-    if(length(assay) == 1){
-      # vrMainImage(object[[assay]]) <- value
-      vrMainSpatial(object[[assay]]) <- value
-    } else {
-      stop("You can only set the main image of a single assay")
-    }
+
+  # get assay names
+  assay_names <- vrAssayNames(object, assay = assay)
+
+  # get spatial metadata
+  sample.metadata <- SampleMetadata(object)
+  assayclass <- unique(sample.metadata[assay_names,"Assay"])
+
+  # check for assay number
+  if(length(assayclass) == 1){
+    for(assy in assay_names)
+      vrMainSpatial(object[[assy]], ignore = TRUE) <- value
   } else {
-    stop("You should define the assay whose main image you wanna set, by using 'Assay = <assay name>'")
+    stop("You can only set the main spatial system of a single assay")
   }
 
   return(object)
@@ -623,9 +625,14 @@ vrMainSpatial.VoltRon <- function(object, assay = NULL){
   # get assay names
   assay_names <- vrAssayNames(object, assay = assay)
 
+  # get spatial metadata
+  sample.metadata <- SampleMetadata(object)
+  assayclass <- unique(sample.metadata[assay_names,"Assay"])
+
   # check for assay number
-  if(length(assay_names) == 1){
-    vrMainSpatial(object[[assay_names]]) <- value
+  if(length(assayclass) == 1){
+    for(assy in assay_names)
+      vrMainSpatial(object[[assy]], ignore = TRUE) <- value
   } else {
     stop("You can only set the main spatial system of a single assay")
   }
@@ -657,12 +664,10 @@ vrMainSpatial.vrAssay <- function(object){
 #' @export
 vrMainSpatial.vrAssayV2 <- vrMainSpatial.vrAssay
 
-#' @rdname vrMainImage
-#' @order 5
-#' @export
-"vrMainImage<-.vrAssay" <- function(object, value){
-
-  if(length(value) > 0){
+#' @noRd
+.replaceMainSpatial <- function(object, ignore = FALSE, value){
+
+  if(length(value) %in% c(1,2)){
 
     # get channel name if exists in the value
     if(length(value) == 2){
@@ -675,122 +680,56 @@ vrMainSpatial.vrAssayV2 <- vrMainSpatial.vrAssay
     # set main spatial/image
     if(value %in% vrSpatialNames(object)){
       object@main_image <- value
+
+      # set channel
+      if(!is.null(channel))
+        vrMainChannel(object@image[[value]]) <- channel
+
     } else {
-      stop("'",value,"' is not a spatial coordinate system")
+      if(ignore){
+        warning("'",value,"' is not a spatial coordinate system in '", vrAssayNames(object),"'. Main system is still set to '", vrMainSpatial(object), "'")
+      } else {
+        stop("'",value,"' is not a spatial coordinate system in '", vrAssayNames(object),"'. Use ignore = TRUE for ignoring this message")
+      }
     }
-
-    # set channel
-    if(!is.null(channel))
-      vrMainChannel(object@image[[value]]) <- channel
 
   } else {
-    stop("The Main image is set by either: \n    vrMainImage(object) <- c('image name', 'channel name')\n or vrMainImage(object) <- 'image name'")
+    stop("The Main image is set by either: \n    vrMainSpatial(object) <- c('<spatial name>', '<channel name>')\n or vrMainSpatial(object) <- '<spatial name>'")
   }
 
   return(object)
 }
 
+#' @param ignore if TRUE, the non-existing spatial coordinate system will be ignored.
+#' 
 #' @rdname vrMainImage
 #' @order 5
 #' @export
-"vrMainImage<-.vrAssayV2" <- function(object, value){
-
-  if(length(value) > 0){
-
-    # get channel name if exists in the value
-    if(length(value) == 2){
-      channel <- value[2]
-      value <- value[1]
-    } else {
-      channel <- NULL
-    }
-
-    # set main spatial/image
-    if(value %in% vrSpatialNames(object)){
-      object@main_image <- value
-    } else {
-      stop("'",value,"' is not a spatial coordinate system")
-    }
-
-    # set channel
-    if(!is.null(channel))
-      vrMainChannel(object@image[[value]]) <- channel
-
-  } else {
-    stop("The Main image is set by either: \n    vrMainImage(object) <- c('image name', 'channel name')\n or vrMainImage(object) <- 'image name'")
-  }
-
-  return(object)
-}
+"vrMainImage<-.vrAssay" <- .replaceMainSpatial
 
+#' @param ignore if TRUE, the non-existing spatial coordinate system will be ignored.
+#' 
+#' @rdname vrMainImage
+#' @order 5
+#' @export
+"vrMainImage<-.vrAssayV2" <- .replaceMainSpatial
+
+#' @param ignore if TRUE, the non-existing spatial coordinate system will be ignored.
+#' 
 #' @rdname vrMainSpatial
 #' @order 5
 #' @export
-"vrMainSpatial<-.vrAssay" <- function(object, value){
-
-  if(length(value) > 0){
-
-    # get channel name if exists in the value
-    if(length(value) == 2){
-      channel <- value[2]
-      value <- value[1]
-    } else {
-      channel <- NULL
-    }
-
-    # set main spatial/image
-    if(value %in% vrSpatialNames(object)){
-      object@main_image <- value
-    } else {
-      stop("'",value,"' is not a spatial coordinate system")
-    }
-
-    # set channel
-    if(!is.null(channel))
-      vrMainChannel(object@image[[value]]) <- channel
-
-  } else {
-    stop("The Main image is set by either: \n    vrMainImage(object) <- c('image name', 'channel name')\n or vrMainImage(object) <- 'image name'")
-  }
-
-  return(object)
-}
+"vrMainSpatial<-.vrAssay" <- .replaceMainSpatial
 
+#' @param ignore if TRUE, the non-existing spatial coordinate system will be ignored.
+#'
 #' @rdname vrMainSpatial
 #' @order 5
 #' @export
-"vrMainSpatial<-.vrAssayV2" <- function(object, value){
-
-  if(length(value) > 0){
-
-    # get channel name if exists in the value
-    if(length(value) == 2){
-      channel <- value[2]
-      value <- value[1]
-    } else {
-      channel <- NULL
-    }
-
-    # set main spatial/image
-    if(value %in% vrSpatialNames(object)){
-      object@main_image <- value
-    } else {
-      stop("'",value,"' is not a spatial coordinate system")
-    }
-
-    # set channel
-    if(!is.null(channel))
-      vrMainChannel(object@image[[value]]) <- channel
-
-  } else {
-    stop("The Main image is set by either: \n    vrMainImage(object) <- c('image name', 'channel name')\n or vrMainImage(object) <- 'image name'")
-  }
-
-  return(object)
-}
+"vrMainSpatial<-.vrAssayV2" <- .replaceMainSpatial
 
 #' @param assay assay name (exp: Assay1) or assay class (exp: Visium, Xenium), see \link{SampleMetadata}. 
-#' If NULL, the default assay will be used, see \link{vrMainAssay}. If given as "all", then provides a summary of spatial systems across all assays
+#' If NULL, the default assay will be used, see \link{vrMainAssay}. If equals to "all", then provides a summary of spatial systems across all assays
 #'
 #' @rdname vrImageNames
 #'
@@ -810,14 +749,14 @@ vrImageNames.VoltRon <- function(object, assay = NULL){
     }
   }
 
-  # image_names <- unique(unlist(lapply(assay_names, function(x) vrImageNames(object[[x]]))))
+  # unique names
   spatial_names <- unique(unlist(lapply(assay_names, function(x) vrSpatialNames(object[[x]]))))
 
   return(spatial_names)
 }
 
 #' @param assay assay name (exp: Assay1) or assay class (exp: Visium, Xenium), see \link{SampleMetadata}. 
-#' if NULL, the default assay will be used, see \link{vrMainAssay}.
+#' if NULL, the default assay will be used, see \link{vrMainAssay}. If equals to "all", then provides a summary of spatial systems across all assays
 #'
 #' @rdname vrSpatialNames
 #'
@@ -963,7 +902,6 @@ vrImageChannelNames.VoltRon <- function(object, assay = NULL){
   }
 
   # get image names
-  # image_names <- unlist(lapply(assay_names, function(x) vrMainImage(object[[x]])))
   spatial_names <- unlist(lapply(assay_names, function(x) vrMainSpatial(object[[x]])))
 
   # get channel names
@@ -1500,12 +1438,6 @@ vrCoordinates.vrSpatial <- function(object) {
   } else {
     stop("Please make sure that the coordinates matrix have only two or three columns: for x and y coordinates")
   }
-
-  # if(ncol(value) != 2) {
-  #   stop("Please make sure that the coordinates matrix have only two columns: for x and y coordinates")
-  # } else {
-  #   colnames(value) <- c("x", "y")
-  # }
 
   methods::slot(object = object, name = 'coords') <- value
   return(object)

diff --git a/R/objects.R b/R/objects.R
@@ -1403,13 +1403,12 @@ vrMainFeatureType.VoltRon <- function(object, assay = NULL){
   }
 }
 
-#' @param ignore ignore if some assays dont have the feature set name
 #' @param value the name of main feature set
 #'
 #' @rdname vrMainFeatureType
 #' @order 4
 #' @export
-"vrMainFeatureType<-.VoltRon" <- function(object, assay = NULL, ignore = FALSE, value){
+"vrMainFeatureType<-.VoltRon" <- function(object, assay = NULL, value){
 
   # sample metadata
   sample_metadata <- SampleMetadata(object)
@@ -1421,7 +1420,7 @@ vrMainFeatureType.VoltRon <- function(object, assay = NULL){
     stop("You can only set the main feature type of a single assay type")
   } else {
     for(assy in assay_names){
-      vrMainFeatureType(object[[assy]], ignore = ignore) <- value
+      vrMainFeatureType(object[[assy]], ignore = TRUE) <- value
     }
   }