#' @importClassesFrom data.table data.table
####
# Objects and Classes ####
####
### $ methods ####
#' @method $ vrMetadata
#'
"$.vrMetadata" <- function(x, i, ...) {
return(NULL)
}
#' @method $<- vrMetadata
#'
#' @importFrom methods new slot
"$<-.vrMetadata" <- function(x, i, ..., value) {
# molecule metadata
mol.metadata <- methods::slot(x, "molecule")
if(nrow(mol.metadata) > 0)
mol.metadata[[i]] <- value
# cell metadata
cell.metadata <- methods::slot(x, "cell")
if(nrow(cell.metadata) > 0)
cell.metadata[[i]] <- value
# spot metadata
spot.metadata <- methods::slot(x, "spot")
if(nrow(spot.metadata) > 0)
spot.metadata[[i]] <- value
# ROI metadata
roi.metadata <- methods::slot(x, "ROI")
if(nrow(roi.metadata) > 0)
roi.metadata[[i]] <- value
# ROI metadata
tile.metadata <- methods::slot(x, "tile")
if(nrow(tile.metadata) > 0)
tile.metadata[[i]] <- value
return(methods::new("vrMetadata", molecule = mol.metadata, cell = cell.metadata, spot = spot.metadata, ROI = roi.metadata, tile = tile.metadata))
}
#' @method $<- vrMetadata
#'
#' @importFrom methods new slot
#'
"[[<-.vrMetadata" <- function(x, i, ..., value) {
# molecule metadata
mol.metadata <- methods::slot(x, "molecule")
if(nrow(mol.metadata) > 0)
mol.metadata[[i]] <- value
# cell metadata
cell.metadata <- methods::slot(x, "cell")
if(nrow(cell.metadata) > 0)
cell.metadata[[i]] <- value
# spot metadata
spot.metadata <- methods::slot(x, "spot")
if(nrow(spot.metadata) > 0)
spot.metadata[[i]] <- value
# ROI metadata
roi.metadata <- methods::slot(x, "ROI")
if(nrow(roi.metadata) > 0)
roi.metadata[[i]] <- value
# ROI metadata
tile.metadata <- methods::slot(x, "tile")
if(nrow(tile.metadata) > 0)
tile.metadata[[i]] <- value
return(methods::new("vrMetadata", molecule = mol.metadata, cell = cell.metadata, spot = spot.metadata, ROI = roi.metadata, tile = tile.metadata))
}
####
# Methods ####
####
vrSpatialPointsvrMetadata <- function(object, assay = NULL) {
# get spatial points
points <- unlist(lapply(methods::slotNames(object), function(x) {
if(x %in% c("cell", "spot", "ROI")){
mdata <- slot(object, name = x)
if(nrow(mdata) > 0){
if(!is.null(rownames(mdata))){
sp <- rownames(mdata)
} else {
sp <- as.vector(mdata$id)
}
if(!is.null(assay))
sp <- sp[grepl(paste(paste0(assay, "$"), collapse = "|"), sp)]
return(sp)
}
} else {
mdata <- slot(object, name = x)
if(nrow(mdata) > 0){
if(inherits(mdata, "data.table")){
if(!is.null(assay))
sp <- subset(mdata, subset = assay_id %in% assay)
return(sp[["id"]])
} else {
sp <- as.vector(mdata$id)
if(!is.null(assay))
sp <- sp[grepl(paste(paste0(assay, "$"), collapse = "|"), sp)]
return(sp)
}
}
}
}))
# return points
return(points)
}
#' @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}.
#'
#' @rdname vrSpatialPoints
#' @order 3
#'
#' @importFrom methods slotNames
#'
#' @export
setMethod("vrSpatialPoints", "vrMetadata", vrSpatialPointsvrMetadata)
subsetvrMetadata <- function(x, subset, samples = NULL, assays = NULL, spatialpoints = NULL) {
# start
object <- x
if (!missing(x = subset)) {
subset <- enquo(arg = subset)
}
# subset all metadata types
if(!is.null(samples)){
if(nrow(object@molecule) > 0){
mol.metadata <- subset_metadata(object@molecule, samples = samples)
} else {
mol.metadata <- data.table::data.table()
}
cell.metadata <- subset_metadata(object@cell, samples = samples)
spot.metadata <- subset_metadata(object@spot, samples = samples)
roi.metadata <- subset_metadata(object@ROI, samples = samples)
if(nrow(object@tile) > 0){
tile.metadata <- subset_metadata(object@tile, samples = samples)
} else {
tile.metadata <- data.table::data.table()
}
} else if(!is.null(assays)){
assay_names <- unique(lapply(slotToList(object), function(x) {
if(inherits(x, "data.table")){
return(unique(as.vector(x$assay_id)))
} else {
if(!is.null(rownames(x))){
return(unique(stringr::str_extract(rownames(x), "Assay[0-9]+")))
} else {
return(unique(stringr::str_extract(as.vector(x$id), "Assay[0-9]+")))
}
}
}))
assay_names <- unique(do.call(c,assay_names))
if(all(assays %in% assay_names)){
if(nrow(object@molecule) > 0) {
mol.metadata <- subset_metadata(object@molecule, assays = assays)
} else {
mol.metadata <- data.table::data.table()
}
cell.metadata <- subset_metadata(object@cell, assays = assays)
spot.metadata <- subset_metadata(object@spot, assays = assays)
roi.metadata <- subset_metadata(object@ROI, assays = assays)
if(nrow(object@tile) > 0) {
tile.metadata <- object@tile[assay_id %in% assays, ]
} else {
tile.metadata <- data.table::data.table()
}
} else {
if(nrow(object@molecule) > 0) {
mol.metadata <- subset_metadata(object@molecule, assaytypes = assays)
} else {
mol.metadata <- data.table::data.table()
}
cell.metadata <- subset_metadata(object@cell, assaytypes = assays)
spot.metadata <- subset_metadata(object@spot, assaytypes = assays)
roi.metadata <- subset_metadata(object@ROI, assaytypes = assays)
if(nrow(object@tile) > 0) {
tile.metadata <- subset_metadata(object@tile, assaytypes = assays)
} else {
tile.metadata <- data.table::data.table()
}
}
} else if(!is.null(spatialpoints)){
if(nrow(object@molecule) > 0){
mol.metadata <- subset_metadata(object@molecule, spatialpoints = spatialpoints)
} else {
mol.metadata <- data.table::data.table()
}
cell.metadata <- subset_metadata(object@cell, spatialpoints = spatialpoints)
spot.metadata <- subset_metadata(object@spot, spatialpoints = spatialpoints)
roi.metadata <- subset_metadata(object@ROI, spatialpoints = spatialpoints)
if(nrow(object@tile) > 0){
tile.metadata <- subset_metadata(object@tile, spatialpoints = spatialpoints)
} else {
tile.metadata <- data.table::data.table()
}
} else {
stop("No assay, sample or spatial points were provided!")
}
# return new metadata
methods::new("vrMetadata",
molecule = mol.metadata,
cell = cell.metadata,
spot = spot.metadata,
ROI = roi.metadata,
tile = tile.metadata)
}
#' Subsetting vrMetadata objects
#'
#' Given a vrMetadata object, subset the object given one of the attributes
#'
#' @param x a vrMetadata object
#' @param subset the subset statement
#' @param samples the set of samples to subset the object
#' @param assays assay name (exp: Assay1) or assay class (exp: Visium, Xenium), see \code{SampleMetadata(object)}
#' @param spatialpoints the set of spatial points to subset the object
#'
#' @method subset vrMetadata
#' @order 3
#'
#' @importFrom rlang enquo
#' @importFrom stringr str_extract
#' @importFrom data.table setkey
setMethod("subset", "vrMetadata", subsetvrMetadata)
#' subset_sampleMetadata
#'
#' Subseting sample metadata
#'
#' @param metadata sample metadata of a VoltRon object
#' @param samples the set of samples to subset the object
#' @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}.
#'
#' @noRd
subset_sampleMetadata <- function(metadata, samples = NULL, assays = NULL) {
# subseting on samples, layers and assays
if(!is.null(samples)){
if(all(samples %in% metadata$Sample)){
metadata <- metadata[metadata$Sample %in% samples,]
} else {
stop("Some samples with the names '", paste(samples, collapse = ", "), "' are not found in the object")
}
} else if(!is.null(assays)) {
if(all(assays %in% rownames(metadata))){
metadata <- metadata[assays,]
} else if(all(assays %in% metadata$Assay)){
metadata <- metadata[metadata$Assay %in% assays,]
} else {
stop("Some assay with the names or types '", paste(assays, collapse = ", "), "' are not found in the object")
}
}
metadata
}
mergevrMetadata <- function(x, y) {
# 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)
# check if all are VoltRon
if(!all(lapply(object_list, class) == "vrMetadata"))
stop("All arguements have to be of vrMetadata class")
# choose objects
obj1 <- object_list[[1]]
obj2 <- object_list[[2]]
# initial combination
if(length(object_list) > 2){
combined.metadata <- mergevrMetadata(obj1, obj2)
for(i in 3:(length(object_list))){
combined.metadata <- mergevrMetadata(combined.metadata, object_list[[i]])
}
} else {
updateobjects <- updateMetadataAssay(obj1, obj2)
obj1 <- updateobjects$object1
obj2 <- updateobjects$object2
mol.metadata <- rbind_metadata(methods::slot(obj1, "molecule"), methods::slot(obj2, "molecule"))
cell.metadata <- rbind_metadata(methods::slot(obj1, "cell"), methods::slot(obj2, "cell"))
spot.metadata <- rbind_metadata(methods::slot(obj1, "spot"), methods::slot(obj2, "spot"))
roi.metadata <- rbind_metadata(methods::slot(obj1, "ROI"), methods::slot(obj2, "ROI"))
tile.metadata <- rbind_metadata(methods::slot(obj1, "tile"), methods::slot(obj2, "tile"))
combined.metadata <- methods::new("vrMetadata",
molecule = mol.metadata,
cell = cell.metadata,
spot = spot.metadata,
ROI = roi.metadata,
tile = tile.metadata)
}
# return combined object
return(combined.metadata)
}
#' Merging vrMetadata objects
#'
#' Given a vrMetadata object, and a list of vrMetadata objects, merge all.
#'
#' @param x a vrMetadata object
#' @param y a single or a list of vrMetadata objects
#'
#' @method merge vrMetadata
#'
#' @importFrom dplyr bind_rows
#' @importFrom methods slot
#' @export
setMethod("merge", "vrMetadata", mergevrMetadata)
#' rbind_metadata
#'
#' @param metadata1 metadata1
#' @param metadata2 metadata2
#'
#' @method merge vrMetadata
#'
#' @importFrom dplyr bind_rows
#' @noRd
#'
rbind_metadata <- function(metadata1, metadata2){
flag1 <- FALSE
flag2 <- FALSE
if(!inherits(metadata1, "DataFrame")){
flag1 <- TRUE
}
if(!inherits(metadata2, "DataFrame")){
flag2 <- TRUE
}
if(flag1 && flag2){
return(dplyr::bind_rows(metadata1,metadata2))
} else {
if(flag1)
metadata1 <- S4Vectors::DataFrame(metadata1)
if(flag2)
metadata2 <- S4Vectors::DataFrame(metadata2)
return(rbind(metadata1, metadata2))
}
}
#' subset_metadata
#'
#' @param metadata metadata
#' @param samples the set of samples to subset the object
#' @param assays assay name (exp: Assay1), see \code{SampleMetadata(object)}
#' @param assaytypes assay class (exp: Visium, Xenium), see \code{SampleMetadata(object)}
#' @param spatialpoints the set of spatial points to subset the object
#'
#' @noRd
subset_metadata <- function(metadata, assays = NULL, assaytypes = NULL, samples = NULL, spatialpoints = NULL){
if(inherits(metadata, "data.table")){
if(nrow(metadata) > 0){
if(!is.null(assays)){
metadata <- subset(metadata, subset = assay_id %in% assays)
} else if(!is.null(assaytypes)){
metadata <- subset(metadata, subset = Assay %in% assaytypes)
} else if(!is.null(samples)){
metadata <- subset(metadata, subset = Sample %in% samples)
} else if(!is.null(spatialpoints)){
metadata <- subset(metadata, subset = id %in% spatialpoints)
} else {
stop("No assay, sample or spatial points were provided!")
}
} else {
metadata <- data.table::data.table()
}
} else if(inherits(metadata, "DataFrame")){
if(!is.null(assays)){
if("assay_id" %in% colnames(metadata)){
cur_column <- as.vector(metadata$assay_id)
metadata <- metadata[cur_column %in% assays,]
} else {
cur_column <- as.vector(metadata$id)
metadata <- metadata[stringr::str_extract(cur_column, "Assay[0-9]+") %in% assays, ]
}
} else if(!is.null(assaytypes)){
cur_column <- as.vector(metadata$Assay)
metadata <- metadata[cur_column %in% assaytypes,]
} else if(!is.null(samples)){
cur_column <- as.vector(metadata$Sample)
metadata <- metadata[cur_column %in% samples,]
} else if(!is.null(spatialpoints)){
cur_column <- as.vector(metadata$id)
metadata <- metadata[cur_column %in% spatialpoints,]
} else {
stop("No assay, sample or spatial points were provided!")
}
} else {
if(nrow(metadata) > 0){
if(!is.null(assays)){
if(!is.null(rownames(metadata))){
metadata <- metadata[stringr::str_extract(rownames(metadata), "Assay[0-9]+") %in% assays, ]
} else {
if("assay_id" %in% colnames(metadata)){
metadata <- subset(metadata, subset = assay_id %in% assays)
} else {
metadata <- metadata[stringr::str_extract(metadata$id, "Assay[0-9]+") %in% assays, ]
}
}
} else if(!is.null(assaytypes)){
metadata <- subset(metadata, subset = Assay %in% assaytypes)
} else if(!is.null(samples)){
metadata <- subset(metadata, subset = Sample %in% samples)
} else if(!is.null(spatialpoints)){
if(!is.null(rownames(metadata))){
metadata <- metadata[rownames(metadata) %in% spatialpoints,]
} else {
metadata <- metadata[metadata$id %in% spatialpoints,]
}
} else {
stop("No assay, sample or spatial points were provided!")
}
}
}
metadata
}
#' merge.sampleMetadata
#'
#' Merging sample.metadata from two VoltRon objects
#'
#' @param metadata_list a list of sample metadata of a VoltRon object
#'
#' @noRd
#'
merge_sampleMetadata <- function(metadata_list) {
sample_names <- NULL
sample.metadata <- do.call(rbind, metadata_list)
rownames(sample.metadata) <- paste0("Assay", seq_len(nrow(sample.metadata)))
# change sample names if provided
if(!is.null(sample_names)){
# check the number sample names
if(!length(sample_names) %in% c(1,nrow(sample.metadata))){
stop("Please provide only one sample name or of length of object list!")
} else {
sample.metadata$Sample <- sample_names
section_ids <- rep(NA,nrow(sample.metadata))
uniq_names <- unique(sample.metadata$Sample)
for(i in seq_len(length(uniq_names))){
cur_ind <- which(sample.metadata$Sample == uniq_names[i])
section_ids[cur_ind] <- seq_len(length(cur_ind))
}
sample.metadata$Layer <- paste0("Section", section_ids)
}
}
sample.metadata
}
### Assay Methods ####
addAssayvrMetadata <- function(object, metadata = NULL, assay, assay_name, sample = "Sample1", layer = "Section1"){
# get metadata and other info
assay.type <- vrAssayTypes(assay)
object_metadata <- methods::slot(object, name = assay.type)
data <- vrData(assay, norm = FALSE)
# add new assay
assay_ids <- vrAssayNames(object)
assay_ids <- as.numeric(gsub("Assay", "", assay_ids))
assay_id <- paste0("Assay", max(assay_ids)+1)
# metadata
if(inherits(metadata, "data.table")){
if(!is.null(metadata)){
if(nrow(data) > 0){
assay_metadata <- data.table::data.table(metadata[, "id", with=FALSE], assay_id = assay_id, Count = Matrix::colSums(data),
Assay = assay_name, Layer = layer, Sample = sample,
metadata[, colnames(metadata)[!colnames(metadata) %in% c("id", "assay_id", "Count", "Assay", "Layer", "Sample")], with=FALSE])
} else{
assay_metadata <- data.table::data.table(metadata[, "id", with=FALSE], assay_id = assay_id,
Assay = assay_name, Layer = layer, Sample = sample,
metadata[, colnames(metadata)[!colnames(metadata) %in% c("id", "assay_id", "Count", "Assay", "Layer", "Sample")], with=FALSE])
}
}
} else {
# get original names
entityID_nopostfix <- stringr::str_replace(vrSpatialPoints(assay), pattern = "_Assay[0-9]+", "")
entityID <- stringr::str_replace(entityID_nopostfix, pattern = "$", paste0("_", assay_id))
# if original metadata has rownames
if(!"id" %in% colnames(object_metadata)){
rownames_metadata <- stringr::str_replace(rownames(metadata), pattern = "_Assay[0-9]+", "")
# initiate metadata
if(nrow(data) > 0){
assay_metadata <- data.frame(Count = Matrix::colSums(data), row.names = entityID)
} else {
assay_metadata <- data.frame(row.names = entityID)
}
# add metadata
if(!is.null(metadata)){
if(length(setdiff(rownames_metadata, entityID_nopostfix)) > 0){
stop("Some spatial points in the metadata does not match with the assay!")
} else{
assay_metadata <- dplyr::bind_cols(assay_metadata,
metadata[,!colnames(metadata) %in% c("Count", "Assay", "Layer", "Sample"), drop = FALSE])
}
}
# complete assay_metadata
assay_metadata <- dplyr::bind_cols(data.frame(Assay = rep(assay_name, length(entityID)),
Layer = rep(layer, length(entityID)),
Sample = rep(sample, length(entityID))),
assay_metadata)
} else {
metadata_id <- stringr::str_replace(as.vector(metadata$id), pattern = "_Assay[0-9]+", "")
# initiate metadata
if(nrow(data) > 0){
assay_metadata <- data.frame(id = entityID, Count = Matrix::colSums(data), assay_id = assay_id)
} else {
assay_metadata <- data.frame(id = entityID, assay_id = assay_id)
}
# check rownames
if(!is.null(rownames(object_metadata))){
rownames(assay_metadata) <- assay_metadata$id
}
# add metadata
if(!is.null(metadata)){
if(length(setdiff(metadata_id, entityID_nopostfix)) > 0){
stop("Some spatial points in the metadata does not match with the assay!")
} else{
assay_metadata <- dplyr::bind_cols(assay_metadata,
data.frame(Assay = rep(assay_name, length(entityID)),
Layer = rep(layer, length(entityID)),
Sample = rep(sample, length(entityID))),
metadata[,!colnames(metadata) %in% c("id", "Count", "assay_id", "Assay", "Layer", "Sample"), drop = FALSE])
}
} else {
assay_metadata <- dplyr::bind_cols(assay_metadata,
data.frame(Assay = rep(assay_name, length(entityID)),
Layer = rep(layer, length(entityID)),
Sample = rep(sample, length(entityID))))
}
}
}
# add to the main metadata
if(inherits(object_metadata, "DataFrame")){
object_metadata <- rbind(object_metadata, assay_metadata)
} else {
object_metadata <- dplyr::bind_rows(object_metadata, assay_metadata)
}
methods::slot(object, name = assay.type) <- object_metadata
# return
return(object)
}
#' @rdname addAssay
#' @method addAssay vrMetadata
#'
#' @importFrom dplyr bind_rows bind_cols
#' @importFrom methods slot slot<-
#' @importFrom stringr str_replace
#' @importFrom data.table data.table
#' @importFrom Matrix colSums
#'
#' @export
setMethod("addAssay", "vrMetadata", addAssayvrMetadata)
vrAssayNamesvrMetadata <- function(object){
# get assay names from metadata
assay_names <- NULL
for(sl in methods::slotNames(object)){
cur_metadata <- slot(object, name = sl)
if(sl %in% c("molecule", "tile")){
cur_names <- cur_metadata$assay_id
} else {
if("assay_id" %in% colnames(cur_metadata)){
cur_names <- as.vector(cur_metadata$assay_id)
} else if(!is.null(rownames(cur_metadata))){
cur_names <- stringr::str_extract(rownames(cur_metadata), "Assay[0-9]+")
} else{
cur_names <- stringr::str_extract(as.vector(cur_metadata$id), "Assay[0-9]+")
}
}
assay_names <- c(assay_names, unique(cur_names))
}
assay_names
}
#' @rdname vrAssayNames
#' @order 3
#' @importFrom methods slotNames
#' @export
setMethod("vrAssayNames", "vrMetadata", vrAssayNamesvrMetadata)
#' updateMetadataAssay
#'
#' Updating assay names for merge
#'
#' @param object1 vrMetadata object
#' @param object2 vrMetadata object
#'
#' @importFrom stringr str_extract
#' @importFrom methods new
#'
#' @noRd
updateMetadataAssay <- function(object1, object2){
# get assay types
object_list <- slotToList(object1)
assaytype <- unlist(lapply(object_list, function(obj) {
if(inherits(obj, "data.table")){
unique(obj$assay_id)
} else if(inherits(obj, c("HDF5DataFrame", "ZarrDataFrame", "DataFrame"))){
if("assay_id" %in% colnames(obj)){
unique(as.vector(obj$assay_id))
} else {
unique(stringr::str_extract(as.vector(obj$id), "Assay[0-9]+$"))
}
} else {
unique(stringr::str_extract(rownames(obj), "Assay[0-9]+$"))
}
}))
assaytype <- assaytype[order(nchar(assaytype), assaytype)]
# replace assay names
replacement <- paste0("Assay", seq_len(length(assaytype)))
object1 <- lapply(object_list, function(obj) {
if(nrow(obj) > 0){
if(inherits(obj, "data.table")){
# change assay id
temp <- obj$assay_id
for(i in seq_len(length(assaytype)))
temp[grepl(assaytype[i], obj$assay_id)] <- replacement[i]
obj$assay_id <- temp
return(obj)
} else if(inherits(obj, c("HDF5DataFrame", "ZarrDataFrame", "DataFrame"))){
# change assay id
if("assay_id" %in% colnames(obj)){
temp <- as.vector(obj$assay_id)
for(i in seq_len(length(assaytype)))
temp[grepl(assaytype[i], obj$assay_id)] <- replacement[i]
obj$assay_id <- temp
}
# change id
temp <- as.vector(obj$id)
for(i in seq_len(length(assaytype))){
temp[grepl(paste0(assaytype[i],"$"), obj$id)] <-
gsub(paste0(assaytype[i],"$"), replacement[i],
obj$id[grepl(paste0(assaytype[i],"$"), obj$id)])
}
obj$id <- temp
return(obj)
} else {
# change rownames
temp <- rownames(obj)
for(i in seq_len(length(assaytype)))
temp[grepl(paste0(assaytype[i],"$"), rownames(obj))] <-
gsub(paste0(assaytype[i],"$"), replacement[i],
rownames(obj)[grepl(paste0(assaytype[i],"$"), rownames(obj))])
rownames(obj) <- temp
# change assay id
if("assay_id" %in% colnames(obj)){
temp <- obj$assay_id
for(i in seq_len(length(assaytype)))
temp[grepl(assaytype[i], obj$assay_id)] <- replacement[i]
obj$assay_id <- temp
}
return(obj)
}
} else {
return(obj)
}
})
object1 <- methods::new("vrMetadata",
molecule = object1$molecule,
cell = object1$cell,
spot = object1$spot,
ROI = object1$ROI,
tile = object1$tile)
# get assay types
object_list <- slotToList(object2)
assaytype <- unlist(lapply(object_list, function(obj) {
if(inherits(obj, "data.table")){
unique(obj$assay_id)
} else if(inherits(obj, c("HDF5DataFrame", "ZarrDataFrame", "DataFrame"))){
if("assay_id" %in% colnames(obj)){
unique(as.vector(obj$assay_id))
} else {
unique(stringr::str_extract(as.vector(obj$id), "Assay[0-9]+$"))
}
} else {
unique(stringr::str_extract(rownames(obj), "Assay[0-9]+$"))
}
}))
assaytype <- assaytype[order(nchar(assaytype), assaytype)]
# replace assay names
replacement <- paste0("Assay", (length(replacement)+1):(length(replacement) + length(assaytype)))
object2 <- lapply(object_list, function(obj) {
if(nrow(obj) > 0){
if(inherits(obj, "data.table")){
# change assay id
temp <- obj$assay_id
for(i in seq_len(length(assaytype)))
temp[grepl(assaytype[i], obj$assay_id)] <- replacement[i]
obj$assay_id <- temp
return(obj)
} else if(inherits(obj, c("HDF5DataFrame", "ZarrDataFrame", "DataFrame"))){
# change assay id
if("assay_id" %in% colnames(obj)){
temp <- as.vector(obj$assay_id)
for(i in seq_len(length(assaytype)))
temp[grepl(assaytype[i], obj$assay_id)] <- replacement[i]
obj$assay_id <- temp
}
# change id
temp <- as.vector(obj$id)
for(i in seq_len(length(assaytype))){
temp[grepl(paste0(assaytype[i],"$"), obj$id)] <-
gsub(paste0(assaytype[i],"$"), replacement[i],
obj$id[grepl(paste0(assaytype[i],"$"), obj$id)])
}
obj$id <- temp
return(obj)
} else {
# change row names
temp <- rownames(obj)
for(i in seq_len(length(assaytype)))
temp[grepl(paste0(assaytype[i],"$"), rownames(obj))] <-
gsub(paste0(assaytype[i],"$"), replacement[i],
rownames(obj)[grepl(paste0(assaytype[i],"$"), rownames(obj))])
rownames(obj) <- temp
# change id
temp <- obj$id
for(i in seq_len(length(assaytype))){
temp[grepl(paste0(assaytype[i],"$"), obj$id)] <-
gsub(paste0(assaytype[i],"$"), replacement[i],
obj$id[grepl(paste0(assaytype[i],"$"), obj$id)])
}
obj$id <- temp
# change assay id
if("assay_id" %in% colnames(obj)){
temp <- obj$assay_id
for(i in seq_len(length(assaytype)))
temp[grepl(assaytype[i], obj$assay_id)] <- replacement[i]
obj$assay_id <- temp
}
obj
}
} else {
return(obj)
}
})
object2 <- methods::new("vrMetadata",
molecule = object2$molecule,
cell = object2$cell,
spot = object2$spot,
ROI = object2$ROI,
tile = object2$tile)
# return
return(list(object1 = object1, object2 = object2))
}
changeSampleNamesvrMetadata <- function(object, sample_metadata_table){
# get old and new samples
old.samples <- sample_metadata_table$Sample
new.samples <- sample_metadata_table$NewSample
# check all types in the vrMetadata object
new_object <- object
all_types <- methods::slotNames(object)
for(type in all_types){
metadata <- methods::slot(object, name = type)
new_metadata <- methods::slot(new_object, name = type)
if(nrow(new_metadata) > 0){
# change samples
for(i in seq_len(length(old.samples)))
new_metadata$Sample[new_metadata$Sample==old.samples[i]] <- new.samples[i]
# change layers
for(i in seq_len(nrow(sample_metadata_table))){
new_metadata$Layer[grepl(paste0(sample_metadata_table$AssayID[i], "$"), rownames(new_metadata))] <- sample_metadata_table[sample_metadata_table$AssayID[i], "NewLayer"]
}
# rewrite metadata type
methods::slot(new_object, name = type) <- new_metadata
}
}
# return
return(new_object)
}
#' changeSampleNames.vrMetadata
#'
#' Change the sample names of the vrMetadata object and reorient layers if needed
#' This functions requires the new and old sample and layer names passed from \code{changeSampleNames.VoltRon}
#'
#' @param sample_metadata_table the sample metadata with old and new layers and samples passed from \code{changeSampleNames.VoltRon}
#'
#' @rdname changeSampleNames
#' @method changeSampleNames vrMetadata
#'
#' @importFrom methods slot slot<- slotNames
#'
#' @noRd
setMethod("changeSampleNames", "vrMetadata", changeSampleNamesvrMetadata)
### Sample Methods ####
vrSampleNamesvrMetadata <- function(object){
# get assay names from metadata
sample_names <- NULL
for(sl in methods::slotNames(object)){
cur_metadata <- slot(object, name = sl)
sample_names <- c(sample_names, unique(cur_metadata$Sample))
}
# return
sample_names
}
#' @rdname vrSampleNames
#' @method vrSampleNames vrMetadata
#'
#' @importFrom methods slotNames
#' @export
setMethod("vrSampleNames", "vrMetadata", vrSampleNamesvrMetadata)
####
# Functions ####
####
#' setVRMetadata
#'
#' @param molecule molecule data frame
#' @param cell cell data frame
#' @param spot spot data frame
#' @param ROI ROI data frame
#' @param tile tile data frame
#'
#' @importFrom methods new
#'
#' @noRd
setVRMetadata <- function(metadata, data, entityID, main.assay, assay.type, sample_name, layer_name, version){
if(is.null(metadata)){
# set metadata
vr_metadata <- list(molecule = data.table::data.table(),
cell = data.frame(),
spot = data.frame(),
ROI = data.frame(),
tile = data.table::data.table())
# create entity IDs using Assay index, make it colnames
entityID <- stringr::str_replace(entityID, pattern = "$", paste0("_Assay1"))
# create metadata
# slot(vr_metadata, name = assay.type) <-
if(version == "v1"){
vr_metadata[[assay.type]] <-
data.frame(Count = Matrix::colSums(data),
assay_id = "Assay1",
Assay = main.assay,
Layer = layer_name,
Sample = sample_name,
row.names = entityID)
} else if (version == "v2"){
vr_metadata[[assay.type]] <-
data.frame(id = entityID,
Count = Matrix::colSums(data),
assay_id = "Assay1",
Assay = main.assay,
Layer = layer_name,
Sample = sample_name,
row.names = entityID)
}
} else {
if(any(is(metadata) %in% c("data.table", "data.frame", "matrix"))){
vr_metadata <- list(molecule = data.table::data.table(),
cell = data.frame(),
spot = data.frame(),
ROI = data.frame(),
tile = data.table::data.table())
# if metadata is a data.table
if(inherits(metadata, "data.table")){
# if there are no id column, insert entityID
if(!"id" %in% colnames(metadata)){
metadata$id <- entityID
}
# check ID names
if(length(setdiff(metadata$id, entityID)) > 0){
stop("Entity IDs are not matching")
} else {
# entity IDs
metadata <- subset(metadata, subset = entityID %in% id)
# create entity IDs using Assay index, make it colnames
set.seed(nrow(metadata$id))
entityID <- paste0(metadata$id, "_", ids::random_id(bytes = 3, use_openssl = FALSE))
if(nrow(data) > 0){
suppressWarnings({
vr_metadata[[assay.type]] <-
data.table::data.table(id = entityID,
assay_id = "Assay1",
Count = Matrix::colSums(data),
Assay = main.assay,
Layer = layer_name,
Sample = sample_name,
metadata[,-"id"])
})
} else{
suppressWarnings({
vr_metadata[[assay.type]] <-
data.table::data.table(id = entityID,
assay_id = "Assay1",
Assay = main.assay,
Layer = layer_name,
Sample = sample_name,
metadata[,-"id"])
})
}
}
# if metadata is a regular data.frame
} else if(inherits(metadata, "data.frame")){
# check row names
if(length(setdiff(rownames(metadata), entityID)) > 0){
stop("Entity IDs are not matching")
} else {
# entity IDs
if(version == "v1") {
metadata <- metadata[entityID,]
} else if(version == "v2") {
# if there are no id column, insert entityID
if(!"id" %in% colnames(metadata)){
metadata$id <- entityID
}
metadata <- metadata[match(entityID, metadata$id),]
}
# create entity IDs using Assay index, make it colnames
entityID <- stringr::str_replace(entityID, pattern = "$", paste0("_Assay1"))
# create metadata for version 1
if(version == "v1"){
if(nrow(data) > 0){
vr_metadata[[assay.type]] <-
data.frame(Count = Matrix::colSums(data),
assay_id = "Assay1",
Assay = main.assay,
Layer = layer_name,
Sample = sample_name,
metadata,
row.names = entityID)
} else{
vr_metadata[[assay.type]] <-
data.frame(assay_id = "Assay1",
Assay = main.assay,
Layer = layer_name,
Sample = sample_name,
metadata,
row.names = entityID)
}
# create metadata for version 2
} else if(version == "v2"){
if(nrow(data) > 0){
vr_metadata[[assay.type]] <-
data.frame(id = entityID,
Count = Matrix::colSums(data),
assay_id = "Assay1",
Assay = main.assay,
Layer = layer_name,
Sample = sample_name,
metadata,
row.names = entityID)
} else{
vr_metadata[[assay.type]] <-
data.frame(id = entityID,
Assay = main.assay,
assay_id = "Assay1",
Layer = layer_name,
Sample = sample_name,
metadata,
row.names = entityID)
}
}
}
}
}
}
return(
list(
entityID = entityID,
vr_metadata = methods::new("vrMetadata",
molecule = vr_metadata$molecule,
cell = vr_metadata$cell,
spot = vr_metadata$spot,
ROI = vr_metadata$ROI,
tile = vr_metadata$tile)
)
)
}
#' setVRSampleMetadata
#'
#' @param samples a list of vrSample object
#'
#' @noRd
setVRSampleMetadata <- function(samples){
# imput missing sample names
# sample_name_ind <- sapply(names(samples), is.null)
sample_name_ind <- vapply(names(samples), is.null, logical(1))
if(length(sample_name_ind) > 0){
names_samples <- names(samples)
if(any(sample_name_ind)){
null_samples_ind <- which(sample_name_ind)
names_samples[null_samples_ind] <- paste0("Sample", null_samples_ind)
}
} else {
names_samples <- paste0("Sample", seq_len(length(samples)))
}
# get sample metadata
sample_list <- names(samples)
sample.metadata <- NULL
for(i in seq_len(length(sample_list))){
layer_list <- samples[[sample_list[i]]]@layer
layer_data <- NULL
for(j in seq_len(length(layer_list))){
assay_list <- layer_list[[j]]@assay
layer_data <- rbind(layer_data, cbind(names(assay_list), names(layer_list)[j]))
}
sample.metadata <- rbind(sample.metadata, cbind(layer_data, sample_list[i]))
}
sample.metadata <- data.frame(sample.metadata, row.names = paste0("Assay", seq_len(nrow(sample.metadata))))
colnames(sample.metadata) <- c("Assay", "Layer", "Sample")
sample.metadata
}
Datasets
Models
