diff --git a/R/conversion.R b/R/conversion.R index a666e16..4590328 100644 --- a/R/conversion.R +++ b/R/conversion.R @@ -806,17 +806,39 @@ as.VoltRon.SpatialExperiment <- function(object, assay_type = "cell", assay_name # image if(nrow(imgdata) > 0){ + + # get image names if(is.null(image_id)){ image_names <- imgdata$image_id[imgdata$sample_id == samp] } else { image_names <- image_id } + + # get image scales + scale.factors_list <- sapply(image_names, function(img){ + SpatialExperiment::scaleFactors(object, + sample_id = samp, + image_id = img) + }) + if(length(unique(scale.factors_list)) > 1){ + stop("All images of a single sample should have the same scale for VoltRon object conversion!: please select an 'image_id'") + } + + # get image list img_list <- sapply(image_names, function(img){ imgraster <- SpatialExperiment::imgRaster(object, sample_id = samp, image_id = img) magick::image_read(imgraster) }, USE.NAMES = TRUE) + + # scale coordinates + scale.factors <- unique(unlist(scale.factors_list)) + cur_coords <- cur_coords*scale.factors + + # reverse y coordinates + imginfo <- getImageInfo(img_list[[1]]) + cur_coords[,2] <- imginfo$height - cur_coords[,2] } else { img_list <- NULL } @@ -930,20 +952,24 @@ as.SpatialExperiment <- function(object, assay = NULL, reg = FALSE){ reducedDims = reduceddims, sample_id=assays, spatialCoords=coords) + spe$sample_id <- assays # get image objects for each assay for(assy in vrAssayNames(object)){ assay_object <- object[[assy]] - img <- vrImages(assay_object) - imgfile <- tempfile(fileext='.png') - magick::image_write(image = img, path = imgfile, format = 'png') - spe <- SpatialExperiment::addImg(spe, - sample_id = vrAssayNames(assay_object), - image_id = "main", - imageSource = imgfile, - scaleFactor = 1, - load = TRUE) - file.remove(imgfile) + channels <- vrImageChannelNames(assay_object) + for(ch in channels){ + img <- vrImages(assay_object, channel = ch) + imgfile <- tempfile(fileext='.png') + magick::image_write(image = img, path = imgfile, format = 'png') + spe <- SpatialExperiment::addImg(spe, + sample_id = vrAssayNames(assay_object), + image_id = ch, + imageSource = imgfile, + scaleFactor = 1, + load = TRUE) + file.remove(imgfile) + } } # return diff --git a/R/io.R b/R/io.R index c77a1ef..3c8ed67 100644 --- a/R/io.R +++ b/R/io.R @@ -266,7 +266,7 @@ write_h5_samples <- function(object, assay = NULL, h5_path, chunkdim, level, # open h5 file if(verbose) - message("HDF5 file: ", h5_path, "\n") + message("HDF5 file: ", h5_path) if(!file.exists("h5_path")) rhdf5::h5createFile(h5_path) @@ -349,7 +349,7 @@ writeHDF5ArrayInMetadata <- function(object, meta.data_list <- list() rhdf5::h5createGroup(h5_path, group = paste0(name, "/", sn)) if(verbose) - message("Writing ", sn, " Metadata \n") + message("Writing ", sn, " Metadata") # write rownames first if they exist, and there is no id column if(!is.null(rownames(meta.data)) && !("id" %in% colnames(meta.data))){ @@ -424,7 +424,7 @@ writeHDF5ArrayInVrData <- function(object, if(!inherits(a, "dgCMatrix")) a <- as(a, "dgCMatrix") if(verbose) - message("Writing '", vrAssayNames(object), "' ", feat, " data \n") + message("Writing '", vrAssayNames(object), "' ", feat, " data") a <- BPCells::write_matrix_hdf5(a, path = h5_path, group = paste0(name, "/", feat), @@ -440,7 +440,7 @@ writeHDF5ArrayInVrData <- function(object, if(!inherits(a, "dgCMatrix")) a <- as(a, "dgCMatrix") if(verbose) - message("Writing '", vrAssayNames(object), "' normalized ", feat, " data \n") + message("Writing '", vrAssayNames(object), "' normalized ", feat, " data") a <- BPCells::write_matrix_hdf5(a, path = h5_path, group = paste0(name, "/", feat, "_norm"), @@ -459,7 +459,7 @@ writeHDF5ArrayInVrData <- function(object, if(!inherits(a, "dgCMatrix")) a <- as(a, "dgCMatrix") if(verbose) - message("Writing '", vrAssayNames(object), "' data \n") + message("Writing '", vrAssayNames(object), "' data") a <- BPCells::write_matrix_hdf5(a, path = h5_path, group = paste0(name, "/rawdata"), @@ -473,7 +473,7 @@ writeHDF5ArrayInVrData <- function(object, if(!inherits(a, "dgCMatrix")) a <- as(a, "dgCMatrix") if(verbose) - message("Writing '", vrAssayNames(object), "' normalized data \n") + message("Writing '", vrAssayNames(object), "' normalized data") a <- BPCells::write_matrix_hdf5(a, path = h5_path, group = paste0(name, "/normdata"), @@ -516,7 +516,7 @@ writeHDF5ArrayInImage <- function(object, if(!inherits(coords, "dgCMatrix")) coords <- as(coords, "dgCMatrix") if(verbose) - message("Writing '", name, "' coordinates \n") + message("Writing '", name, "' coordinates") coords <- BPCells::write_matrix_hdf5(coords, path = h5_path, group = paste0(name, "/", spat, "/coords"), @@ -536,7 +536,7 @@ writeHDF5ArrayInImage <- function(object, # write image if(!inherits(img, "Image_Array") || replace){ if(verbose) - message("Writing '", name, "' image channel '", ch, "' for spatial system '", spat,"' \n") + message("Writing '", name, "' image channel '", ch, "' for spatial system '", spat,"'") img <- ImageArray::writeImageArray(img, output = gsub(".h5$", "", h5_path), name = paste0(name, "/", spat, "/", ch), @@ -575,7 +575,7 @@ write_zarr_samples <- function(object, assay = NULL, zarr_path, chunkdim, level, # create zarr if(verbose) - message("Zarr store: ", zarr_path, "\n") + message("Zarr store: ", zarr_path) zarr.array <- pizzarr::zarr_open(store = zarr_path) # create metadata @@ -657,7 +657,7 @@ writeZarrArrayInMetadata <- function(object, meta.data_list <- list() zarr.array <- pizzarr::zarr_open(store = zarr_path) if(verbose) - message("Writing ", sn, " Metadata \n") + message("Writing ", sn, " Metadata") zarr.array$create_group(paste0(name, "/", sn)) # write rownames first if they exist, and there is no id column @@ -731,7 +731,7 @@ writeZarrArrayInVrData <- function(object, a <- vrData(object, feat_type = feat, norm = FALSE) if(!inherits(a, "DelayedArray") || replace){ if(verbose) - message("Writing '", vrAssayNames(object), "' data \n") + message("Writing '", vrAssayNames(object), "' data") a <- ZarrArray::writeZarrArray(a, zarr_path, name = paste0(name, "/", feat), @@ -747,7 +747,7 @@ writeZarrArrayInVrData <- function(object, a <- vrData(object, feat_type = feat, norm = TRUE) if(!inherits(a, "DelayedArray") || replace){ if(verbose) - message("Writing '", vrAssayNames(object), "' normalized data \n") + message("Writing '", vrAssayNames(object), "' normalized data") a <- ZarrArray::writeZarrArray(a, zarr_path, name = paste0(name, "/", feat, "_norm"), @@ -766,7 +766,7 @@ writeZarrArrayInVrData <- function(object, a <- vrData(object, norm = FALSE) if(!inherits(a, "DelayedArray") || replace){ if(verbose) - message("Writing '", vrAssayNames(object), "' data \n") + message("Writing '", vrAssayNames(object), "' data") a <- ZarrArray::writeZarrArray(a, zarr_path, name = paste0(name, "/rawdata"), @@ -782,7 +782,7 @@ writeZarrArrayInVrData <- function(object, a <- vrData(object, norm = TRUE) if(!inherits(a, "DelayedArray") || replace){ if(verbose) - message("Writing '", vrAssayNames(object), "' normalized data \n") + message("Writing '", vrAssayNames(object), "' normalized data") a <- ZarrArray::writeZarrArray(a, zarr_path, name = paste0(name, "/normdata"), @@ -828,7 +828,7 @@ writeZarrArrayInImage <- function(object, coords <- vrCoordinates(object, spatial_name = spat) if(!inherits(coords, c("DelayedArray", "IterableMatrix")) || replace){ if(verbose) - message("Writing '", name, "' coordinates \n") + message("Writing '", name, "' coordinates") coords <- ZarrArray::writeZarrArray(coords, zarr_path, name = paste0(name, "/", spat, "/coords"), @@ -851,7 +851,7 @@ writeZarrArrayInImage <- function(object, # write image if(!inherits(img, "Image_Array") || replace){ if(verbose) - message("Writing '", name, "' image channel '", ch, "' for spatial system '", spat,"' \n") + message("Writing '", name, "' image channel '", ch, "' for spatial system '", spat,"'") img <- ImageArray::writeImageArray(img, output = gsub(".zarr$", "", zarr_path), name = paste0(name, "/", spat, "/", ch), diff --git a/R/objects.R b/R/objects.R index 18841c3..65bd842 100644 --- a/R/objects.R +++ b/R/objects.R @@ -1205,6 +1205,9 @@ vrData.VoltRon <- function(object, assay = NULL, features = NULL, feat_type = NU data <- NULL for(i in 1:length(assay_names)){ cur_data <- vrData(object[[assay_names[i]]], features = features, feat_type = feat_type, norm = norm, ...) + if(inherits(cur_data, c("dgCMatrix", "CsparseMatrix", "dsparseMatrix"))){ + cur_data <- as.matrix(cur_data) + } if(inherits(cur_data, c("data.frame", "Matrix", "matrix"))){ cur_data <- data.frame(cur_data, feature.ID = rownames(cur_data), check.names = FALSE) } diff --git a/R/spatial.R b/R/spatial.R index 75fd07c..a28aa61 100644 --- a/R/spatial.R +++ b/R/spatial.R @@ -59,7 +59,7 @@ getSpatialNeighbors <- function(object, # metadata if(verbose) - message("Calculating Spatial Neighbors with group.by='", group.by, "' and group.ids='", paste(group.ids, collapse = ","), "'\n") + message("Calculating Spatial Neighbors with group.by='", group.by, "' and group.ids='", paste(group.ids, collapse = ","), "'") metadata = Metadata(object, assay = assy) if(!group.by %in% colnames(metadata)) stop("The column '", group.by, "' was not found in the metadata!") diff --git a/tests/testthat/test_conversion.R b/tests/testthat/test_conversion.R index 01d6dca..db0674c 100644 --- a/tests/testthat/test_conversion.R +++ b/tests/testthat/test_conversion.R @@ -35,7 +35,7 @@ test_that("as.AnnData", { # as.AnnData(visium_data, file = zarr_file, flip_coordinates = TRUE) # clean file - file.remove(h5ad_file) - unlink(zarr_file, recursive = TRUE) + # file.remove(h5ad_file) + # unlink(zarr_file, recursive = TRUE) expect_equal(1,1L) }) \ No newline at end of file