diff --git a/R/wrappers_images.R b/R/wrappers_images.R index f39fb8a..fc298d3 100644 --- a/R/wrappers_images.R +++ b/R/wrappers_images.R @@ -249,3 +249,394 @@ OmeTiffWrapper <- R6::R6Class("OmeTiffWrapper", } ), ) + +#' Image OME-TIFF object wrapper class +#' @title ImageOmeTiffWrapper Class +#' @docType class +#' @description +#' Class representing an OME-TIFF file in a Vitessce dataset. Intended to be used with the spatialBeta and layerControllerBeta views. +#' +#' @rdname ImageOmeTiffWrapper +#' @export +ImageOmeTiffWrapper <- R6::R6Class("ImageOmeTiffWrapper", + inherit = AbstractWrapper, + public = list( + #' @field img_path A local filepath to an OME-TIFF file. + #' @keywords internal + img_path = NULL, + #' @field img_url A remote URL of an OME-TIFF file. + #' @keywords internal + img_url = NULL, + #' @field offsets_path A local filepath to an offsets.json file. + #' @keywords internal + offsets_path = NULL, + #' @field offsets_url A remote URL of an offsets.json file. + #' @keywords internal + offsets_url = NULL, + #' @field coordinate_transformations A list of coordinate transformations. + #' @keywords internal + coordinate_transformations = NULL, + #' @field coordination_values A list of coordination values. + #' @keywords internal + coordination_values = NULL, + #' @field is_remote Whether or not this image is remote. + #' @keywords internal + is_remote = NULL, + #' @field local_img_uid + #' @keywords internal + local_img_uid = NULL, + #' @field local_offsets_uid + #' @keywords internal + local_offsets_uid = NULL, + #' @description + #' Create a wrapper around an OME-TIFF image. + #' @param img_path A local filepath to an OME-TIFF file. + #' @param img_url A remote URL of an OME-TIFF file. + #' @param offsets_path A local filepath to an offsets.json file. + #' @param offsets_url A remote URL of an offsets.json file. + #' @param coordinate_transformations A list of coordinate transformations. + #' @param coordination_values A list of coordination values. + #' @param ... Parameters inherited from `AbstractWrapper`. + #' @return A new `ImageOmeTiffWrapper` object. + initialize = function(img_path = NA, img_url = NA, offsets_path = NA, offsets_url = NA, coordinate_transformations = NA, coordination_values = NA, ...) { + super$initialize(...) + + # Check that exactly one of img_path or img_url is provided + num_inputs <- sum(!is.na(c(img_path, img_url))) + if(num_inputs != 1) { + stop("Expected one of img_path or img_url to be provided") + } + + # Check that at most one of offsets_path or offsets_url is provided + num_offsets <- sum(!is.na(c(offsets_path, offsets_url))) + if(num_offsets > 1) { + stop("Expected zero or one of offsets_path or offsets_url to be provided") + } + + self$img_path <- img_path + self$img_url <- img_url + self$offsets_path <- offsets_path + self$offsets_url <- offsets_url + self$coordinate_transformations <- coordinate_transformations + self$coordination_values <- coordination_values + self$is_remote <- !is.na(img_url) + + self$local_img_uid <- make_unique_filename(".ome.tif") + self$local_offsets_uid <- make_unique_filename(".offsets.json") + }, + #' @description + #' Create the web server routes and file definition creators. + #' @param dataset_uid The ID for this dataset. + #' @param obj_i The index of this data object within the dataset. + #' @param base_dir A base directory to pass into the convert_and_save function. + convert_and_save = function(dataset_uid, obj_i, base_dir = NA) { + if(!self$is_remote) { + super$convert_and_save(dataset_uid, obj_i, base_dir = base_dir) + } + + # Get the file definition creator functions. + file_def_creator <- self$make_file_def_creator(dataset_uid, obj_i) + self$file_def_creators <- append(self$file_def_creators, file_def_creator) + + routes <- self$make_routes(dataset_uid, obj_i) + self$routes <- c(self$routes, routes) + }, + #' @description + #' Create a list representing the server routes. + #' @param dataset_uid The ID for this dataset. + #' @param obj_i The index of this data object within the dataset. + #' @return A list of server route objects. + #' @keywords internal + make_routes = function(dataset_uid, obj_i) { + if(self$is_remote) { + return(list()) + } else { + routes <- list() + if(is.na(self$base_dir)) { + local_img_path <- self$img_path + local_img_route_path <- self$get_route_str(dataset_uid, obj_i, self$local_img_uid) + local_offsets_route_path <- self$get_route_str(dataset_uid, obj_i, self$local_offsets_uid) + } else { + local_img_path <- file.path(self$base_dir, self$img_path) + local_img_route_path <- file_path_to_url_path(self$img_path) + # Do not include offsets in base_dir mode + local_offsets_route_path <- NA + } + + img_route <- VitessceConfigServerRangeRoute$new( + local_img_route_path, + local_img_path + ) + routes <- append(routes, img_route) + + # TODO: Add offsets route when not in base_dir mode + # This would require implementing offsets generation logic + + return(routes) + } + }, + #' @description + #' Make the file definition creator function for the image data type. + #' @param dataset_uid The ID for this dataset. + #' @param obj_i The index of this data object within the dataset. + #' @return A file definition creator function which takes a `base_url` parameter. + make_file_def_creator = function(dataset_uid, obj_i) { + get_image <- function(base_url) { + options <- obj_list() + if(!is_na(self$coordinate_transformations)) { + options[['coordinateTransformations']] <- self$coordinate_transformations + } + + offsets_url <- self$get_offsets_url(base_url, dataset_uid, obj_i) + if(!is.na(offsets_url) && is.na(self$base_dir)) { + # Do not include offsets in base_dir mode + options[['offsetsUrl']] <- offsets_url + } + + file_def <- list( + fileType = "image.ome-tiff", + url = self$get_img_url(base_url, dataset_uid, obj_i) + ) + + if(length(options) > 0) { + file_def[['options']] <- options + } + if(!is_na(self$coordination_values)) { + file_def[['coordinationValues']] <- self$coordination_values + } + return(file_def) + } + return(get_image) + }, + #' @description + #' Get the URL to the image file. + #' @param base_url The base URL for the server. + #' @param dataset_uid The ID for this dataset. + #' @param obj_i The index of this data object within the dataset. + #' @return A URL as a string. + get_img_url = function(base_url = "", dataset_uid = "", obj_i = "") { + if(self$is_remote) { + return(self$img_url) + } + if(!is.na(self$base_dir)) { + return(self$get_url_simple(base_url, file_path_to_url_path(self$img_path, prepend_slash = FALSE))) + } + return(self$get_url(base_url, dataset_uid, obj_i, self$local_img_uid)) + }, + #' @description + #' Get the URL to the offsets file. + #' @param base_url The base URL for the server. + #' @param dataset_uid The ID for this dataset. + #' @param obj_i The index of this data object within the dataset. + #' @return A URL as a string or NA. + get_offsets_url = function(base_url = "", dataset_uid = "", obj_i = "") { + if(!is.na(self$offsets_url) || self$is_remote) { + return(self$offsets_url) + } + if(!is.na(self$offsets_path)) { + return(self$get_url(base_url, dataset_uid, obj_i, self$local_offsets_uid)) + } + return(NA) + } + ), +) + +#' Observation Segmentations OME-TIFF object wrapper class +#' @title ObsSegmentationsOmeTiffWrapper Class +#' @docType class +#' @description +#' Class representing an OME-TIFF file containing observation segmentations in a Vitessce dataset. Intended to be used with the spatialBeta and layerControllerBeta views. +#' +#' @rdname ObsSegmentationsOmeTiffWrapper +#' @export +ObsSegmentationsOmeTiffWrapper <- R6::R6Class("ObsSegmentationsOmeTiffWrapper", + inherit = AbstractWrapper, + public = list( + #' @field img_path A local filepath to an OME-TIFF file. + #' @keywords internal + img_path = NULL, + #' @field img_url A remote URL of an OME-TIFF file. + #' @keywords internal + img_url = NULL, + #' @field offsets_path A local filepath to an offsets.json file. + #' @keywords internal + offsets_path = NULL, + #' @field offsets_url A remote URL of an offsets.json file. + #' @keywords internal + offsets_url = NULL, + #' @field coordinate_transformations A list of coordinate transformations. + #' @keywords internal + coordinate_transformations = NULL, + #' @field obs_types_from_channel_names Whether to use the channel names to determine the obs types. + #' @keywords internal + obs_types_from_channel_names = NULL, + #' @field coordination_values A list of coordination values. + #' @keywords internal + coordination_values = NULL, + #' @field is_remote Whether or not this image is remote. + #' @keywords internal + is_remote = NULL, + #' @field local_img_uid + #' @keywords internal + local_img_uid = NULL, + #' @field local_offsets_uid + #' @keywords internal + local_offsets_uid = NULL, + #' @description + #' Create a wrapper around an OME-TIFF segmentation image. + #' @param img_path A local filepath to an OME-TIFF file. + #' @param img_url A remote URL of an OME-TIFF file. + #' @param offsets_path A local filepath to an offsets.json file. + #' @param offsets_url A remote URL of an offsets.json file. + #' @param coordinate_transformations A list of coordinate transformations. + #' @param obs_types_from_channel_names Whether to use the channel names to determine the obs types. + #' @param coordination_values A list of coordination values. + #' @param ... Parameters inherited from `AbstractWrapper`. + #' @return A new `ObsSegmentationsOmeTiffWrapper` object. + initialize = function(img_path = NA, img_url = NA, offsets_path = NA, offsets_url = NA, coordinate_transformations = NA, obs_types_from_channel_names = NA, coordination_values = NA, ...) { + super$initialize(...) + + # Check that exactly one of img_path or img_url is provided + num_inputs <- sum(!is.na(c(img_path, img_url))) + if(num_inputs != 1) { + stop("Expected one of img_path or img_url to be provided") + } + + # Check that at most one of offsets_path or offsets_url is provided + num_offsets <- sum(!is.na(c(offsets_path, offsets_url))) + if(num_offsets > 1) { + stop("Expected zero or one of offsets_path or offsets_url to be provided") + } + + self$img_path <- img_path + self$img_url <- img_url + self$offsets_path <- offsets_path + self$offsets_url <- offsets_url + self$coordinate_transformations <- coordinate_transformations + self$obs_types_from_channel_names <- obs_types_from_channel_names + self$coordination_values <- coordination_values + self$is_remote <- !is.na(img_url) + + self$local_img_uid <- make_unique_filename(".ome.tif") + self$local_offsets_uid <- make_unique_filename(".offsets.json") + }, + #' @description + #' Create the web server routes and file definition creators. + #' @param dataset_uid The ID for this dataset. + #' @param obj_i The index of this data object within the dataset. + #' @param base_dir A base directory to pass into the convert_and_save function. + convert_and_save = function(dataset_uid, obj_i, base_dir = NA) { + if(!self$is_remote) { + super$convert_and_save(dataset_uid, obj_i, base_dir = base_dir) + } + + # Get the file definition creator functions. + file_def_creator <- self$make_file_def_creator(dataset_uid, obj_i) + self$file_def_creators <- append(self$file_def_creators, file_def_creator) + + routes <- self$make_routes(dataset_uid, obj_i) + self$routes <- c(self$routes, routes) + }, + #' @description + #' Create a list representing the server routes. + #' @param dataset_uid The ID for this dataset. + #' @param obj_i The index of this data object within the dataset. + #' @return A list of server route objects. + #' @keywords internal + make_routes = function(dataset_uid, obj_i) { + if(self$is_remote) { + return(list()) + } else { + routes <- list() + if(is.na(self$base_dir)) { + local_img_path <- self$img_path + local_img_route_path <- self$get_route_str(dataset_uid, obj_i, self$local_img_uid) + local_offsets_route_path <- self$get_route_str(dataset_uid, obj_i, self$local_offsets_uid) + } else { + local_img_path <- file.path(self$base_dir, self$img_path) + local_img_route_path <- file_path_to_url_path(self$img_path) + # Do not include offsets in base_dir mode + local_offsets_route_path <- NA + } + + img_route <- VitessceConfigServerRangeRoute$new( + local_img_route_path, + local_img_path + ) + routes <- append(routes, img_route) + + # TODO: Add offsets route when not in base_dir mode + # This would require implementing offsets generation logic + + return(routes) + } + }, + #' @description + #' Make the file definition creator function for the obs segmentations data type. + #' @param dataset_uid The ID for this dataset. + #' @param obj_i The index of this data object within the dataset. + #' @return A file definition creator function which takes a `base_url` parameter. + make_file_def_creator = function(dataset_uid, obj_i) { + get_obs_segmentations <- function(base_url) { + options <- obj_list() + if(!is_na(self$coordinate_transformations)) { + options[['coordinateTransformations']] <- self$coordinate_transformations + } + + if(!is_na(self$obs_types_from_channel_names)) { + options[['obsTypesFromChannelNames']] <- self$obs_types_from_channel_names + } + + offsets_url <- self$get_offsets_url(base_url, dataset_uid, obj_i) + if(!is.na(offsets_url) && is.na(self$base_dir)) { + # Do not include offsets in base_dir mode + options[['offsetsUrl']] <- offsets_url + } + + file_def <- list( + fileType = "obsSegmentations.ome-tiff", + url = self$get_img_url(base_url, dataset_uid, obj_i) + ) + + if(length(options) > 0) { + file_def[['options']] <- options + } + if(!is_na(self$coordination_values)) { + file_def[['coordinationValues']] <- self$coordination_values + } + return(file_def) + } + return(get_obs_segmentations) + }, + #' @description + #' Get the URL to the image file. + #' @param base_url The base URL for the server. + #' @param dataset_uid The ID for this dataset. + #' @param obj_i The index of this data object within the dataset. + #' @return A URL as a string. + get_img_url = function(base_url = "", dataset_uid = "", obj_i = "") { + if(self$is_remote) { + return(self$img_url) + } + if(!is.na(self$base_dir)) { + return(self$get_url_simple(base_url, file_path_to_url_path(self$img_path, prepend_slash = FALSE))) + } + return(self$get_url(base_url, dataset_uid, obj_i, self$local_img_uid)) + }, + #' @description + #' Get the URL to the offsets file. + #' @param base_url The base URL for the server. + #' @param dataset_uid The ID for this dataset. + #' @param obj_i The index of this data object within the dataset. + #' @return A URL as a string or NA. + get_offsets_url = function(base_url = "", dataset_uid = "", obj_i = "") { + if(!is.na(self$offsets_url) || self$is_remote) { + return(self$offsets_url) + } + if(!is.na(self$offsets_path)) { + return(self$get_url(base_url, dataset_uid, obj_i, self$local_offsets_uid)) + } + return(NA) + } + ), +) diff --git a/R/wrappers_json.R b/R/wrappers_json.R new file mode 100644 index 0000000..05777ca --- /dev/null +++ b/R/wrappers_json.R @@ -0,0 +1,141 @@ +#' JSON file wrapper class +#' @title JsonWrapper Class +#' @docType class +#' @description +#' Class representing a JSON file in a Vitessce dataset. +#' +#' @rdname JsonWrapper +#' @export +JsonWrapper <- R6::R6Class("JsonWrapper", + inherit = AbstractWrapper, + public = list( + #' @field json_path The path to a local JSON file. + #' @keywords internal + json_path = NULL, + #' @field json_url The URL to a remote JSON file. + #' @keywords internal + json_url = NULL, + #' @field local_json_uid The unique identifier for the local JSON file. + #' @keywords internal + local_json_uid = NULL, + #' @field data_type The Vitessce data type for this file. + #' @keywords internal + data_type = NULL, + #' @field options A list of options to pass to the Vitessce file definition. + #' @keywords internal + options = NULL, + #' @field coordination_values A list of coordination values to pass to the Vitessce file definition. + #' @keywords internal + coordination_values = NULL, + #' @field request_init A list of requestInit values to pass to fetch when loading the JSON over HTTP. + #' @keywords internal + request_init = NULL, + #' @description + #' Create a wrapper around a JSON file. + #' @param json_path The path to a local JSON file. + #' @param json_url The URL to a remote JSON file. + #' @param data_type The Vitessce data type for this file. + #' @param options A list of options to pass to the Vitessce file definition. + #' @param coordination_values A list of coordination values to pass to the Vitessce file definition. + #' @param request_init A list of requestInit values to pass to fetch when loading the JSON over HTTP. + #' @param ... Parameters inherited from `AbstractWrapper`. + #' @return A new `JsonWrapper` object. + initialize = function(json_path = NA, json_url = NA, data_type = NA, options = NA, coordination_values = NA, request_init = NA, ...) { + super$initialize(...) + self$json_path <- json_path + self$json_url <- json_url + + if(is_na(data_type)) { + stop("Expected data_type to be provided.") + } + + if(!is.na(json_url) && !is.na(json_path)) { + stop("Did not expect json_url to be provided with json_path.") + } + + if(is.na(json_url) && is.na(json_path)) { + stop("Expected either json_url or json_path to be provided.") + } + + if(!is.na(json_path)) { + self$is_remote <- FALSE + } else { + self$is_remote <- TRUE + } + + self$local_json_uid <- make_unique_filename(".json") + + self$data_type <- data_type + self$options <- options + self$coordination_values <- coordination_values + self$request_init <- request_init + }, + #' @description + #' Create the JSON output files, web server routes, and file definition creators. + #' @param dataset_uid The ID for this dataset. + #' @param obj_i The index of this data object within the dataset. + #' @param base_dir A base directory for local data. + convert_and_save = function(dataset_uid, obj_i, base_dir = NA) { + if(!self$is_remote) { + super$convert_and_save(dataset_uid, obj_i, base_dir = base_dir) + } + + # Get the file definition creator functions. + file_def_creator <- self$make_file_def_creator(dataset_uid, obj_i) + + # Append the new file definition creators functions to the main list. + self$file_def_creators <- append(self$file_def_creators, file_def_creator) + + # Create a web server route object for the directory of JSON files. + new_routes <- self$make_routes(dataset_uid, obj_i) + for(route in new_routes) { + self$routes <- append(self$routes, route) + } + }, + #' @description + #' Get a list of server route objects. + #' @param dataset_uid The ID for this dataset. + #' @param obj_i The index of this data object within the dataset. + make_routes = function(dataset_uid, obj_i) { + return(self$get_local_file_route(dataset_uid, obj_i, self$json_path, self$local_json_uid)) + }, + #' @description + #' Get the URL to the JSON file, to fill in the file URL in the file definitions. + #' @param base_url The base URL, on which the route will be served. + #' @param dataset_uid The ID for this dataset. + #' @param obj_i The index of this data object within the dataset. + #' @keywords internal + #' @return A URL as a string. + get_json_url = function(base_url, dataset_uid, obj_i) { + if(self$is_remote) { + return(self$json_url) + } else { + return(self$get_local_file_url(base_url, dataset_uid, obj_i, self$json_path, self$local_json_uid)) + } + }, + #' @description + #' Make the file definition creator function for the JSON data type. + #' @param dataset_uid The ID for this dataset. + #' @param obj_i The index of this data object within the dataset. + #' @return A file definition creator function which takes a `base_url` parameter. + make_file_def_creator = function(dataset_uid, obj_i) { + get_json <- function(base_url) { + file_def <- list( + fileType = paste0(self$data_type, ".json"), + url = self$get_json_url(base_url, dataset_uid, obj_i) + ) + if(!is_na(self$options)) { + file_def[['options']] <- self$options + } + if(!is_na(self$request_init)) { + file_def[['requestInit']] <- self$request_init + } + if(!is_na(self$coordination_values)) { + file_def[['coordinationValues']] <- self$coordination_values + } + return(file_def) + } + return(get_json) + } + ), +) \ No newline at end of file diff --git a/R/wrappers_spatialdata.R b/R/wrappers_spatialdata.R new file mode 100644 index 0000000..c784a37 --- /dev/null +++ b/R/wrappers_spatialdata.R @@ -0,0 +1,267 @@ +#' SpatialData object wrapper class +#' @title SpatialDataWrapper Class +#' @docType class +#' @description +#' Class representing a SpatialData object in a Vitessce dataset. +#' +#' @rdname SpatialDataWrapper +#' @export +SpatialDataWrapper <- R6::R6Class("SpatialDataWrapper", + inherit = AnnDataWrapper, + public = list( + #' @field sdata_path The path to a local SpatialData Zarr store. + #' @keywords internal + sdata_path = NULL, + #' @field sdata_url The URL to a remote SpatialData Zarr store. + #' @keywords internal + sdata_url = NULL, + #' @field image_path Path to the image element of interest. + #' @keywords internal + image_path = NULL, + #' @field region The region to use. + #' @keywords internal + region = NULL, + #' @field coordinate_system Name of a target coordinate system. + #' @keywords internal + coordinate_system = NULL, + #' @field obs_spots_path Location of shapes that should be interpreted as spot observations. + #' @keywords internal + obs_spots_path = NULL, + #' @field obs_segmentations_path Path to a labels or shapes element. + #' @keywords internal + obs_segmentations_path = NULL, + #' @field table_path The path to the table within the SpatialData store. + #' @keywords internal + table_path = NULL, + #' @field is_zip Boolean indicating whether the Zarr store is in a zipped format. + #' @keywords internal + is_zip = NULL, + #' @description + #' Create a wrapper around a SpatialData object. + #' @param sdata_path SpatialData path, exclusive with other sdata_xxxx arguments. + #' @param sdata_url SpatialData url, exclusive with other sdata_xxxx arguments. + #' @param image_path Path to the image element of interest. + #' @param region The region to use. + #' @param coordinate_system Name of a target coordinate system. + #' @param obs_spots_path Location of shapes that should be interpreted as spot observations. + #' @param obs_segmentations_path Path to a labels or shapes element (segmentation bitmask label image or segmentation polygon shapes). + #' @param table_path The path to the table within the SpatialData store. Default is "tables/table". + #' @param is_zip Boolean indicating whether the Zarr store is in a zipped format. + #' @param coordination_values Coordination values for the file definition. + #' @param ... Parameters inherited from `AnnDataWrapper`. + #' @return A new `SpatialDataWrapper` object. + initialize = function(sdata_path = NA, sdata_url = NA, image_path = NA, region = NA, coordinate_system = NA, obs_spots_path = NA, obs_segmentations_path = NA, table_path = "tables/table", is_zip = NA, coordination_values = NA, ...) { + + # Check that exactly one of sdata_path or sdata_url is provided + num_inputs <- sum(!is.na(c(sdata_path, sdata_url))) + if(num_inputs != 1) { + stop("Expected one of sdata_path or sdata_url to be provided") + } + + # Initialize parent class with sdata parameters mapped to adata parameters + super$initialize(adata_path = sdata_path, adata_url = sdata_url, coordination_values = coordination_values, ...) + + self$sdata_path <- sdata_path + self$sdata_url <- sdata_url + self$image_path <- image_path + self$region <- region + self$coordinate_system <- coordinate_system + self$obs_spots_path <- obs_spots_path + self$obs_segmentations_path <- obs_segmentations_path + self$table_path <- table_path + self$is_zip <- is_zip + + # Update the local_dir_uid for SpatialData + self$local_dir_uid <- make_unique_filename(".sdata.zarr") + + # Update zarr_folder if using local path + if(!is.na(sdata_path)) { + self$zarr_folder <- 'spatialdata.zarr' + } + }, + #' @description + #' Make the file definition creator function for the SpatialData data type. + #' @param dataset_uid The ID for this dataset. + #' @param obj_i The index of this data object within the dataset. + #' @return A file definition creator function which takes a `base_url` parameter. + make_file_def_creator = function(dataset_uid, obj_i) { + get_spatialdata_zarr <- function(base_url) { + options <- obj_list() + + # Generate options for SpatialData-specific schema + options <- self$gen_sdata_obs_locations_schema(options) + options <- self$gen_sdata_obs_segmentations_schema(options) + options <- self$gen_sdata_obs_spots_schema(options) + options <- self$gen_sdata_image_schema(options) + options <- self$gen_sdata_obs_feature_matrix_schema(options) + options <- self$gen_sdata_obs_sets_schema(options) + + # Add feature labels if specified + if(!is_na(self$feature_labels_path)) { + options[['featureLabels']] <- obj_list() + options[['featureLabels']][['path']] <- self$feature_labels_path + } + + # Add obs labels if specified + if(!is_na(self$obs_labels_paths)) { + options[['obsLabels']] <- list() + for(i in seq_len(length(self$obs_labels_paths))) { + obs_labels_path <- self$obs_labels_paths[i] + if(!is_na(self$obs_labels_names)) { + obs_labels_name <- self$obs_labels_names[i] + } else { + segments <- stringr::str_split(obs_labels_path, "/")[[1]] + obs_labels_name <- segments[-1] + } + options[['obsLabels']] <- append(options[['obsLabels']], list(obj_list( + path = obs_labels_path, + obsLabelsType = obs_labels_name + ))) + } + } + + if(length(options) > 0) { + file_type <- if(!is.na(self$is_zip) && self$is_zip) "spatialdata.zarr.zip" else "spatialdata.zarr" + + file_def <- list( + fileType = file_type, + url = self$get_zarr_url(base_url, dataset_uid, obj_i), + options = options + ) + + if(!is_na(self$request_init)) { + file_def[['requestInit']] <- self$request_init + } + if(!is_na(self$coordination_values)) { + file_def[['coordinationValues']] <- self$coordination_values + } + + return(file_def) + } + return(NULL) + } + return(get_spatialdata_zarr) + }, + #' @description + #' Generate obs locations schema for SpatialData. + #' @param options The options object to modify. + #' @return The modified options object. + gen_sdata_obs_locations_schema = function(options) { + if(!is_na(self$obs_locations_path)) { + options[['obsLocations']] <- obj_list() + options[['obsLocations']][['path']] <- self$obs_locations_path + if(!is_na(self$table_path)) { + options[['obsLocations']][['tablePath']] <- self$table_path + } + if(!is_na(self$region)) { + options[['obsLocations']][['region']] <- self$region + } + if(!is_na(self$coordinate_system)) { + options[['obsLocations']][['coordinateSystem']] <- self$coordinate_system + } + } + return(options) + }, + #' @description + #' Generate obs segmentations schema for SpatialData. + #' @param options The options object to modify. + #' @return The modified options object. + gen_sdata_obs_segmentations_schema = function(options) { + if(!is_na(self$obs_segmentations_path)) { + options[['obsSegmentations']] <- obj_list() + options[['obsSegmentations']][['path']] <- self$obs_segmentations_path + if(!is_na(self$table_path)) { + options[['obsSegmentations']][['tablePath']] <- self$table_path + } + if(!is_na(self$coordinate_system)) { + options[['obsSegmentations']][['coordinateSystem']] <- self$coordinate_system + } + } + return(options) + }, + #' @description + #' Generate obs spots schema for SpatialData. + #' @param options The options object to modify. + #' @return The modified options object. + gen_sdata_obs_spots_schema = function(options) { + if(!is_na(self$obs_spots_path)) { + options[['obsSpots']] <- obj_list() + options[['obsSpots']][['path']] <- self$obs_spots_path + if(!is_na(self$table_path)) { + options[['obsSpots']][['tablePath']] <- self$table_path + } + if(!is_na(self$region)) { + options[['obsSpots']][['region']] <- self$region + } + if(!is_na(self$coordinate_system)) { + options[['obsSpots']][['coordinateSystem']] <- self$coordinate_system + } + } + return(options) + }, + #' @description + #' Generate image schema for SpatialData. + #' @param options The options object to modify. + #' @return The modified options object. + gen_sdata_image_schema = function(options) { + if(!is_na(self$image_path)) { + options[['image']] <- obj_list() + options[['image']][['path']] <- self$image_path + if(!is_na(self$coordinate_system)) { + options[['image']][['coordinateSystem']] <- self$coordinate_system + } + } + return(options) + }, + #' @description + #' Generate obs feature matrix schema for SpatialData. + #' @param options The options object to modify. + #' @return The modified options object. + gen_sdata_obs_feature_matrix_schema = function(options) { + if(!is_na(self$obs_feature_matrix_path)) { + options[['obsFeatureMatrix']] <- obj_list() + options[['obsFeatureMatrix']][['path']] <- self$obs_feature_matrix_path + if(!is_na(self$feature_filter_path)) { + options[['obsFeatureMatrix']][['featureFilterPath']] <- self$feature_filter_path + } + if(!is_na(self$initial_feature_filter_path)) { + options[['obsFeatureMatrix']][['initialFeatureFilterPath']] <- self$initial_feature_filter_path + } + if(!is_na(self$region)) { + options[['obsFeatureMatrix']][['region']] <- self$region + } + } + return(options) + }, + #' @description + #' Generate obs sets schema for SpatialData. + #' @param options The options object to modify. + #' @return The modified options object. + gen_sdata_obs_sets_schema = function(options) { + if(!is_na(self$obs_set_paths)) { + options[['obsSets']] <- list() + for(i in seq_len(length(self$obs_set_paths))) { + set_path <- self$obs_set_paths[i] + if(!is_na(self$obs_set_names)) { + set_name <- self$obs_set_names[i] + } else { + segments <- stringr::str_split(set_path, "/")[[1]] + set_name <- segments[-1] + } + set_obj <- obj_list( + path = set_path, + name = set_name + ) + if(!is_na(self$table_path)) { + set_obj[['tablePath']] <- self$table_path + } + if(!is_na(self$region)) { + set_obj[['region']] <- self$region + } + options[['obsSets']] <- append(options[['obsSets']], list(set_obj)) + } + } + return(options) + } + ), +) \ No newline at end of file diff --git a/R/wrappers_zarr.R b/R/wrappers_zarr.R new file mode 100644 index 0000000..f983078 --- /dev/null +++ b/R/wrappers_zarr.R @@ -0,0 +1,263 @@ +#' OME-Zarr object wrapper classes +#' Classes representing OME-NGFF Zarr stores in a Vitessce dataset. + +#' Image OME-Zarr object wrapper class +#' @title ImageOmeZarrWrapper Class +#' @docType class +#' @description +#' Class representing an OME-NGFF Zarr store in a Vitessce dataset. Intended to be used with the spatialBeta and layerControllerBeta views. +#' +#' @rdname ImageOmeZarrWrapper +#' @export +ImageOmeZarrWrapper <- R6::R6Class("ImageOmeZarrWrapper", + inherit = AbstractWrapper, + public = list( + #' @field img_path A local filepath to an OME-NGFF Zarr store. + #' @keywords internal + img_path = NULL, + #' @field img_url A remote URL of an OME-NGFF Zarr store. + #' @keywords internal + img_url = NULL, + #' @field coordinate_transformations A list of coordinate transformations. + #' @keywords internal + coordinate_transformations = NULL, + #' @field coordination_values A list of coordination values. + #' @keywords internal + coordination_values = NULL, + #' @field is_remote Whether or not this image is remote. + #' @keywords internal + is_remote = NULL, + #' @field local_dir_uid + #' @keywords internal + local_dir_uid = NULL, + #' @description + #' Create a wrapper around an OME-NGFF Zarr store. + #' @param img_path A local filepath to an OME-NGFF Zarr store. + #' @param img_url A remote URL of an OME-NGFF Zarr store. + #' @param coordinate_transformations A list of coordinate transformations. + #' @param coordination_values A list of coordination values. + #' @param ... Parameters inherited from `AbstractWrapper`. + #' @return A new `ImageOmeZarrWrapper` object. + initialize = function(img_path = NA, img_url = NA, coordinate_transformations = NA, coordination_values = NA, ...) { + super$initialize(...) + + # Check that exactly one of img_path or img_url is provided + num_inputs <- sum(!is.na(c(img_path, img_url))) + if(num_inputs != 1) { + stop("Expected one of img_path or img_url to be provided") + } + + self$img_path <- img_path + self$img_url <- img_url + self$coordinate_transformations <- coordinate_transformations + self$coordination_values <- coordination_values + self$is_remote <- !is.na(img_url) + + self$local_dir_uid <- make_unique_filename(".ome.zarr") + }, + #' @description + #' Create the web server routes and file definition creators. + #' @param dataset_uid The ID for this dataset. + #' @param obj_i The index of this data object within the dataset. + #' @param base_dir A base directory to pass into the convert_and_save function. + convert_and_save = function(dataset_uid, obj_i, base_dir = NA) { + if(!self$is_remote) { + super$convert_and_save(dataset_uid, obj_i, base_dir = base_dir) + } + + # Get the file definition creator functions. + file_def_creator <- self$make_file_def_creator(dataset_uid, obj_i) + self$file_def_creators <- append(self$file_def_creators, file_def_creator) + + routes <- self$make_routes(dataset_uid, obj_i) + self$routes <- c(self$routes, routes) + }, + #' @description + #' Create a list representing the server routes. + #' @param dataset_uid The ID for this dataset. + #' @param obj_i The index of this data object within the dataset. + #' @return A list of server route objects. + #' @keywords internal + make_routes = function(dataset_uid, obj_i) { + if(self$is_remote) { + return(list()) + } else { + return(self$get_local_dir_route(dataset_uid, obj_i, self$img_path, self$local_dir_uid)) + } + }, + #' @description + #' Make the file definition creator function for the image data type. + #' @param dataset_uid The ID for this dataset. + #' @param obj_i The index of this data object within the dataset. + #' @return A file definition creator function which takes a `base_url` parameter. + make_file_def_creator = function(dataset_uid, obj_i) { + get_image <- function(base_url) { + options <- obj_list() + if(!is_na(self$coordinate_transformations)) { + options[['coordinateTransformations']] <- self$coordinate_transformations + } + + file_def <- list( + fileType = "image.ome-zarr", + url = self$get_img_url(base_url, dataset_uid, obj_i) + ) + + if(length(options) > 0) { + file_def[['options']] <- options + } + if(!is_na(self$coordination_values)) { + file_def[['coordinationValues']] <- self$coordination_values + } + return(file_def) + } + return(get_image) + }, + #' @description + #' Get the URL to the Zarr store. + #' @param base_url The base URL for the server. + #' @param dataset_uid The ID for this dataset. + #' @param obj_i The index of this data object within the dataset. + #' @return A URL as a string. + get_img_url = function(base_url = "", dataset_uid = "", obj_i = "") { + if(self$is_remote) { + return(self$img_url) + } + return(self$get_local_dir_url(base_url, dataset_uid, obj_i, self$img_path, self$local_dir_uid)) + } + ), +) + +#' Observation Segmentations OME-Zarr object wrapper class +#' @title ObsSegmentationsOmeZarrWrapper Class +#' @docType class +#' @description +#' Class representing an OME-NGFF Zarr store containing observation segmentations in a Vitessce dataset. Intended to be used with the spatialBeta and layerControllerBeta views. +#' +#' @rdname ObsSegmentationsOmeZarrWrapper +#' @export +ObsSegmentationsOmeZarrWrapper <- R6::R6Class("ObsSegmentationsOmeZarrWrapper", + inherit = AbstractWrapper, + public = list( + #' @field img_path A local filepath to an OME-NGFF Zarr store. + #' @keywords internal + img_path = NULL, + #' @field img_url A remote URL of an OME-NGFF Zarr store. + #' @keywords internal + img_url = NULL, + #' @field coordinate_transformations A list of coordinate transformations. + #' @keywords internal + coordinate_transformations = NULL, + #' @field coordination_values A list of coordination values. + #' @keywords internal + coordination_values = NULL, + #' @field obs_types_from_channel_names Whether to use the channel names to determine the obs types. + #' @keywords internal + obs_types_from_channel_names = NULL, + #' @field is_remote Whether or not this image is remote. + #' @keywords internal + is_remote = NULL, + #' @field local_dir_uid + #' @keywords internal + local_dir_uid = NULL, + #' @description + #' Create a wrapper around an OME-NGFF Zarr segmentation store. + #' @param img_path A local filepath to an OME-NGFF Zarr store. + #' @param img_url A remote URL of an OME-NGFF Zarr store. + #' @param coordinate_transformations A list of coordinate transformations. + #' @param coordination_values A list of coordination values. + #' @param obs_types_from_channel_names Whether to use the channel names to determine the obs types. + #' @param ... Parameters inherited from `AbstractWrapper`. + #' @return A new `ObsSegmentationsOmeZarrWrapper` object. + initialize = function(img_path = NA, img_url = NA, coordinate_transformations = NA, coordination_values = NA, obs_types_from_channel_names = NA, ...) { + super$initialize(...) + + # Check that exactly one of img_path or img_url is provided + num_inputs <- sum(!is.na(c(img_path, img_url))) + if(num_inputs != 1) { + stop("Expected one of img_path or img_url to be provided") + } + + self$img_path <- img_path + self$img_url <- img_url + self$coordinate_transformations <- coordinate_transformations + self$obs_types_from_channel_names <- obs_types_from_channel_names + self$coordination_values <- coordination_values + self$is_remote <- !is.na(img_url) + + self$local_dir_uid <- make_unique_filename(".ome.zarr") + }, + #' @description + #' Create the web server routes and file definition creators. + #' @param dataset_uid The ID for this dataset. + #' @param obj_i The index of this data object within the dataset. + #' @param base_dir A base directory to pass into the convert_and_save function. + convert_and_save = function(dataset_uid, obj_i, base_dir = NA) { + if(!self$is_remote) { + super$convert_and_save(dataset_uid, obj_i, base_dir = base_dir) + } + + # Get the file definition creator functions. + file_def_creator <- self$make_file_def_creator(dataset_uid, obj_i) + self$file_def_creators <- append(self$file_def_creators, file_def_creator) + + routes <- self$make_routes(dataset_uid, obj_i) + self$routes <- c(self$routes, routes) + }, + #' @description + #' Create a list representing the server routes. + #' @param dataset_uid The ID for this dataset. + #' @param obj_i The index of this data object within the dataset. + #' @return A list of server route objects. + #' @keywords internal + make_routes = function(dataset_uid, obj_i) { + if(self$is_remote) { + return(list()) + } else { + return(self$get_local_dir_route(dataset_uid, obj_i, self$img_path, self$local_dir_uid)) + } + }, + #' @description + #' Make the file definition creator function for the obs segmentations data type. + #' @param dataset_uid The ID for this dataset. + #' @param obj_i The index of this data object within the dataset. + #' @return A file definition creator function which takes a `base_url` parameter. + make_file_def_creator = function(dataset_uid, obj_i) { + get_obs_segmentations <- function(base_url) { + options <- obj_list() + if(!is_na(self$coordinate_transformations)) { + options[['coordinateTransformations']] <- self$coordinate_transformations + } + + if(!is_na(self$obs_types_from_channel_names)) { + options[['obsTypesFromChannelNames']] <- self$obs_types_from_channel_names + } + + file_def <- list( + fileType = "obsSegmentations.ome-zarr", + url = self$get_img_url(base_url, dataset_uid, obj_i) + ) + + if(length(options) > 0) { + file_def[['options']] <- options + } + if(!is_na(self$coordination_values)) { + file_def[['coordinationValues']] <- self$coordination_values + } + return(file_def) + } + return(get_obs_segmentations) + }, + #' @description + #' Get the URL to the Zarr store. + #' @param base_url The base URL for the server. + #' @param dataset_uid The ID for this dataset. + #' @param obj_i The index of this data object within the dataset. + #' @return A URL as a string. + get_img_url = function(base_url = "", dataset_uid = "", obj_i = "") { + if(self$is_remote) { + return(self$img_url) + } + return(self$get_local_dir_url(base_url, dataset_uid, obj_i, self$img_path, self$local_dir_uid)) + } + ), +) \ No newline at end of file diff --git a/tests/testthat/test-wrappers-json.R b/tests/testthat/test-wrappers-json.R new file mode 100644 index 0000000..7e45189 --- /dev/null +++ b/tests/testthat/test-wrappers-json.R @@ -0,0 +1,77 @@ +library(vitessceR) + +test_that("JsonWrapper can be created with required parameters", { + w <- JsonWrapper$new(json_path = "test.json", data_type = "cells") + + expect_equal(w$json_path, "test.json") + expect_equal(w$data_type, "cells") + expect_false(w$is_remote) + expect_true(grepl("\\.json$", w$local_json_uid)) +}) + +test_that("JsonWrapper requires data_type", { + expect_error(JsonWrapper$new(json_path = "test.json"), "Expected data_type to be provided") +}) + +test_that("JsonWrapper doesn't allow both json_path and json_url", { + expect_error(JsonWrapper$new(json_path = "test.json", json_url = "http://example.com/test.json", data_type = "cells"), + "Did not expect json_url to be provided with json_path") +}) + +test_that("JsonWrapper requires either json_path or json_url", { + expect_error(JsonWrapper$new(data_type = "cells"), "Expected either json_url or json_path to be provided") +}) + +test_that("JsonWrapper creates remote instance with json_url", { + w <- JsonWrapper$new(json_url = "http://example.com/test.json", data_type = "cells") + + expect_equal(w$json_url, "http://example.com/test.json") + expect_equal(w$data_type, "cells") + expect_true(w$is_remote) +}) + +test_that("JsonWrapper get_json_url works for remote", { + w <- JsonWrapper$new(json_url = "http://example.com/test.json", data_type = "cells") + + url <- w$get_json_url("http://localhost:8000", "dataset1", 1) + expect_equal(url, "http://example.com/test.json") +}) + +test_that("JsonWrapper get_json_url works for local", { + w <- JsonWrapper$new(json_path = "test.json", data_type = "cells") + + url <- w$get_json_url("http://localhost:8000", "dataset1", 1) + expected_url <- paste0("http://localhost:8000/dataset1/1/", w$local_json_uid) + expect_equal(url, expected_url) +}) + +test_that("JsonWrapper make_file_def_creator creates correct file definition", { + w <- JsonWrapper$new(json_path = "test.json", data_type = "cells") + + creator <- w$make_file_def_creator("dataset1", 1) + file_def <- creator("http://localhost:8000") + + expect_equal(file_def$fileType, "cells.json") + expect_true(grepl("http://localhost:8000/dataset1/1/", file_def$url)) + expect_true(grepl("\\.json$", file_def$url)) +}) + +test_that("JsonWrapper make_file_def_creator includes options when provided", { + options <- list(delimiter = ",", header = TRUE) + w <- JsonWrapper$new(json_path = "test.json", data_type = "cells", options = options) + + creator <- w$make_file_def_creator("dataset1", 1) + file_def <- creator("http://localhost:8000") + + expect_equal(file_def$options, options) +}) + +test_that("JsonWrapper make_file_def_creator includes coordination_values when provided", { + coord_values <- list(obsType = "cell") + w <- JsonWrapper$new(json_path = "test.json", data_type = "cells", coordination_values = coord_values) + + creator <- w$make_file_def_creator("dataset1", 1) + file_def <- creator("http://localhost:8000") + + expect_equal(file_def$coordinationValues, coord_values) +}) \ No newline at end of file diff --git a/tests/testthat/test-wrappers-new-images.R b/tests/testthat/test-wrappers-new-images.R new file mode 100644 index 0000000..c70421c --- /dev/null +++ b/tests/testthat/test-wrappers-new-images.R @@ -0,0 +1,117 @@ +library(vitessceR) + +test_that("ImageOmeTiffWrapper can be created with required parameters", { + w <- ImageOmeTiffWrapper$new(img_path = "test.ome.tif") + + expect_equal(w$img_path, "test.ome.tif") + expect_false(w$is_remote) + expect_true(grepl("\\.ome\\.tif$", w$local_img_uid)) + expect_true(grepl("\\.offsets\\.json$", w$local_offsets_uid)) +}) + +test_that("ImageOmeTiffWrapper requires exactly one of img_path or img_url", { + expect_error(ImageOmeTiffWrapper$new(), "Expected one of img_path or img_url to be provided") + expect_error(ImageOmeTiffWrapper$new(img_path = "test.ome.tif", img_url = "http://example.com/test.ome.tif"), + "Expected one of img_path or img_url to be provided") +}) + +test_that("ImageOmeTiffWrapper allows at most one offsets parameter", { + expect_error(ImageOmeTiffWrapper$new(img_path = "test.ome.tif", + offsets_path = "offsets.json", + offsets_url = "http://example.com/offsets.json"), + "Expected zero or one of offsets_path or offsets_url to be provided") +}) + +test_that("ImageOmeTiffWrapper creates remote instance with img_url", { + w <- ImageOmeTiffWrapper$new(img_url = "http://example.com/test.ome.tif") + + expect_equal(w$img_url, "http://example.com/test.ome.tif") + expect_true(w$is_remote) +}) + +test_that("ImageOmeTiffWrapper get_img_url works for remote", { + w <- ImageOmeTiffWrapper$new(img_url = "http://example.com/test.ome.tif") + + url <- w$get_img_url("http://localhost:8000", "dataset1", 1) + expect_equal(url, "http://example.com/test.ome.tif") +}) + +test_that("ImageOmeTiffWrapper get_img_url works for local", { + w <- ImageOmeTiffWrapper$new(img_path = "test.ome.tif") + + url <- w$get_img_url("http://localhost:8000", "dataset1", 1) + expected_url <- paste0("http://localhost:8000/dataset1/1/", w$local_img_uid) + expect_equal(url, expected_url) +}) + +test_that("ImageOmeTiffWrapper get_offsets_url returns NA when no offsets provided", { + w <- ImageOmeTiffWrapper$new(img_path = "test.ome.tif") + + url <- w$get_offsets_url("http://localhost:8000", "dataset1", 1) + expect_true(is.na(url)) +}) + +test_that("ImageOmeTiffWrapper get_offsets_url works with remote offsets", { + w <- ImageOmeTiffWrapper$new(img_url = "http://example.com/test.ome.tif", + offsets_url = "http://example.com/offsets.json") + + url <- w$get_offsets_url("http://localhost:8000", "dataset1", 1) + expect_equal(url, "http://example.com/offsets.json") +}) + +test_that("ImageOmeTiffWrapper make_file_def_creator creates correct file definition", { + w <- ImageOmeTiffWrapper$new(img_path = "test.ome.tif") + + creator <- w$make_file_def_creator("dataset1", 1) + file_def <- creator("http://localhost:8000") + + expect_equal(file_def$fileType, "image.ome-tiff") + expect_true(grepl("http://localhost:8000/dataset1/1/", file_def$url)) + expect_true(grepl("\\.ome\\.tif$", file_def$url)) +}) + +test_that("ImageOmeTiffWrapper make_file_def_creator includes coordinate_transformations when provided", { + transformations <- list(matrix = c(1, 0, 0, 0, 1, 0, 0, 0, 1)) + w <- ImageOmeTiffWrapper$new(img_path = "test.ome.tif", coordinate_transformations = transformations) + + creator <- w$make_file_def_creator("dataset1", 1) + file_def <- creator("http://localhost:8000") + + expect_equal(file_def$options$coordinateTransformations, transformations) +}) + +test_that("ImageOmeTiffWrapper make_file_def_creator includes coordination_values when provided", { + coord_values <- list(spatialImageLayer = "image") + w <- ImageOmeTiffWrapper$new(img_path = "test.ome.tif", coordination_values = coord_values) + + creator <- w$make_file_def_creator("dataset1", 1) + file_def <- creator("http://localhost:8000") + + expect_equal(file_def$coordinationValues, coord_values) +}) + +test_that("ObsSegmentationsOmeTiffWrapper can be created with required parameters", { + w <- ObsSegmentationsOmeTiffWrapper$new(img_path = "segmentations.ome.tif") + + expect_equal(w$img_path, "segmentations.ome.tif") + expect_false(w$is_remote) +}) + +test_that("ObsSegmentationsOmeTiffWrapper make_file_def_creator creates correct file definition", { + w <- ObsSegmentationsOmeTiffWrapper$new(img_path = "segmentations.ome.tif") + + creator <- w$make_file_def_creator("dataset1", 1) + file_def <- creator("http://localhost:8000") + + expect_equal(file_def$fileType, "obsSegmentations.ome-tiff") + expect_true(grepl("http://localhost:8000/dataset1/1/", file_def$url)) +}) + +test_that("ObsSegmentationsOmeTiffWrapper includes obs_types_from_channel_names when provided", { + w <- ObsSegmentationsOmeTiffWrapper$new(img_path = "segmentations.ome.tif", obs_types_from_channel_names = TRUE) + + creator <- w$make_file_def_creator("dataset1", 1) + file_def <- creator("http://localhost:8000") + + expect_true(file_def$options$obsTypesFromChannelNames) +}) \ No newline at end of file diff --git a/tests/testthat/test-wrappers-spatialdata.R b/tests/testthat/test-wrappers-spatialdata.R new file mode 100644 index 0000000..bd7d3da --- /dev/null +++ b/tests/testthat/test-wrappers-spatialdata.R @@ -0,0 +1,130 @@ +library(vitessceR) + +test_that("SpatialDataWrapper can be created with required parameters", { + w <- SpatialDataWrapper$new(sdata_path = "test.sdata.zarr") + + expect_equal(w$sdata_path, "test.sdata.zarr") + expect_false(w$is_remote) + expect_true(grepl("\\.sdata\\.zarr$", w$local_dir_uid)) + expect_equal(w$table_path, "tables/table") +}) + +test_that("SpatialDataWrapper requires exactly one of sdata_path or sdata_url", { + expect_error(SpatialDataWrapper$new(), "Expected one of sdata_path or sdata_url to be provided") + expect_error(SpatialDataWrapper$new(sdata_path = "test.sdata.zarr", sdata_url = "http://example.com/test.sdata.zarr"), + "Expected one of sdata_path or sdata_url to be provided") +}) + +test_that("SpatialDataWrapper creates remote instance with sdata_url", { + w <- SpatialDataWrapper$new(sdata_url = "http://example.com/test.sdata.zarr") + + expect_equal(w$sdata_url, "http://example.com/test.sdata.zarr") + expect_true(w$is_remote) +}) + +test_that("SpatialDataWrapper get_zarr_url works for remote", { + w <- SpatialDataWrapper$new(sdata_url = "http://example.com/test.sdata.zarr") + + url <- w$get_zarr_url("http://localhost:8000", "dataset1", 1) + expect_equal(url, "http://example.com/test.sdata.zarr") +}) + +test_that("SpatialDataWrapper get_zarr_url works for local", { + w <- SpatialDataWrapper$new(sdata_path = "test.sdata.zarr") + + url <- w$get_zarr_url("http://localhost:8000", "dataset1", 1) + expected_url <- paste0("http://localhost:8000/dataset1/1/", w$local_dir_uid) + expect_equal(url, expected_url) +}) + +test_that("SpatialDataWrapper can be created with all optional parameters", { + w <- SpatialDataWrapper$new( + sdata_path = "test.sdata.zarr", + image_path = "images/image1", + region = "region1", + coordinate_system = "global", + obs_spots_path = "shapes/spots", + obs_segmentations_path = "labels/segmentation", + table_path = "tables/custom_table", + is_zip = TRUE, + coordination_values = list(obsType = "spot") + ) + + expect_equal(w$image_path, "images/image1") + expect_equal(w$region, "region1") + expect_equal(w$coordinate_system, "global") + expect_equal(w$obs_spots_path, "shapes/spots") + expect_equal(w$obs_segmentations_path, "labels/segmentation") + expect_equal(w$table_path, "tables/custom_table") + expect_true(w$is_zip) +}) + +test_that("SpatialDataWrapper gen_sdata_image_schema works", { + w <- SpatialDataWrapper$new(sdata_path = "test.sdata.zarr", image_path = "images/image1", coordinate_system = "global") + + options <- obj_list() + options <- w$gen_sdata_image_schema(options) + + expect_equal(options$image$path, "images/image1") + expect_equal(options$image$coordinateSystem, "global") +}) + +test_that("SpatialDataWrapper gen_sdata_obs_spots_schema works", { + w <- SpatialDataWrapper$new(sdata_path = "test.sdata.zarr", + obs_spots_path = "shapes/spots", + table_path = "tables/table", + region = "region1", + coordinate_system = "global") + + options <- obj_list() + options <- w$gen_sdata_obs_spots_schema(options) + + expect_equal(options$obsSpots$path, "shapes/spots") + expect_equal(options$obsSpots$tablePath, "tables/table") + expect_equal(options$obsSpots$region, "region1") + expect_equal(options$obsSpots$coordinateSystem, "global") +}) + +test_that("SpatialDataWrapper gen_sdata_obs_segmentations_schema works", { + w <- SpatialDataWrapper$new(sdata_path = "test.sdata.zarr", + obs_segmentations_path = "labels/segmentation", + table_path = "tables/table", + coordinate_system = "global") + + options <- obj_list() + options <- w$gen_sdata_obs_segmentations_schema(options) + + expect_equal(options$obsSegmentations$path, "labels/segmentation") + expect_equal(options$obsSegmentations$tablePath, "tables/table") + expect_equal(options$obsSegmentations$coordinateSystem, "global") +}) + +test_that("SpatialDataWrapper make_file_def_creator creates correct file definition", { + w <- SpatialDataWrapper$new(sdata_path = "test.sdata.zarr", image_path = "images/image1") + + creator <- w$make_file_def_creator("dataset1", 1) + file_def <- creator("http://localhost:8000") + + expect_equal(file_def$fileType, "spatialdata.zarr") + expect_true(grepl("http://localhost:8000/dataset1/1/", file_def$url)) + expect_equal(file_def$options$image$path, "images/image1") +}) + +test_that("SpatialDataWrapper make_file_def_creator creates correct zip file definition", { + w <- SpatialDataWrapper$new(sdata_path = "test.sdata.zarr", image_path = "images/image1", is_zip = TRUE) + + creator <- w$make_file_def_creator("dataset1", 1) + file_def <- creator("http://localhost:8000") + + expect_equal(file_def$fileType, "spatialdata.zarr.zip") +}) + +test_that("SpatialDataWrapper make_file_def_creator includes coordination_values when provided", { + coord_values <- list(obsType = "spot") + w <- SpatialDataWrapper$new(sdata_path = "test.sdata.zarr", coordination_values = coord_values) + + creator <- w$make_file_def_creator("dataset1", 1) + file_def <- creator("http://localhost:8000") + + expect_equal(file_def$coordinationValues, coord_values) +}) \ No newline at end of file diff --git a/tests/testthat/test-wrappers-zarr.R b/tests/testthat/test-wrappers-zarr.R new file mode 100644 index 0000000..4a8969b --- /dev/null +++ b/tests/testthat/test-wrappers-zarr.R @@ -0,0 +1,110 @@ +library(vitessceR) + +test_that("ImageOmeZarrWrapper can be created with required parameters", { + w <- ImageOmeZarrWrapper$new(img_path = "test.ome.zarr") + + expect_equal(w$img_path, "test.ome.zarr") + expect_false(w$is_remote) + expect_true(grepl("\\.ome\\.zarr$", w$local_dir_uid)) +}) + +test_that("ImageOmeZarrWrapper requires exactly one of img_path or img_url", { + expect_error(ImageOmeZarrWrapper$new(), "Expected one of img_path or img_url to be provided") + expect_error(ImageOmeZarrWrapper$new(img_path = "test.ome.zarr", img_url = "http://example.com/test.ome.zarr"), + "Expected one of img_path or img_url to be provided") +}) + +test_that("ImageOmeZarrWrapper creates remote instance with img_url", { + w <- ImageOmeZarrWrapper$new(img_url = "http://example.com/test.ome.zarr") + + expect_equal(w$img_url, "http://example.com/test.ome.zarr") + expect_true(w$is_remote) +}) + +test_that("ImageOmeZarrWrapper get_img_url works for remote", { + w <- ImageOmeZarrWrapper$new(img_url = "http://example.com/test.ome.zarr") + + url <- w$get_img_url("http://localhost:8000", "dataset1", 1) + expect_equal(url, "http://example.com/test.ome.zarr") +}) + +test_that("ImageOmeZarrWrapper get_img_url works for local", { + w <- ImageOmeZarrWrapper$new(img_path = "test.ome.zarr") + + url <- w$get_img_url("http://localhost:8000", "dataset1", 1) + expected_url <- paste0("http://localhost:8000/dataset1/1/", w$local_dir_uid) + expect_equal(url, expected_url) +}) + +test_that("ImageOmeZarrWrapper make_file_def_creator creates correct file definition", { + w <- ImageOmeZarrWrapper$new(img_path = "test.ome.zarr") + + creator <- w$make_file_def_creator("dataset1", 1) + file_def <- creator("http://localhost:8000") + + expect_equal(file_def$fileType, "image.ome-zarr") + expect_true(grepl("http://localhost:8000/dataset1/1/", file_def$url)) + expect_true(grepl("\\.ome\\.zarr$", file_def$url)) +}) + +test_that("ImageOmeZarrWrapper make_file_def_creator includes coordinate_transformations when provided", { + transformations <- list(matrix = c(1, 0, 0, 0, 1, 0, 0, 0, 1)) + w <- ImageOmeZarrWrapper$new(img_path = "test.ome.zarr", coordinate_transformations = transformations) + + creator <- w$make_file_def_creator("dataset1", 1) + file_def <- creator("http://localhost:8000") + + expect_equal(file_def$options$coordinateTransformations, transformations) +}) + +test_that("ImageOmeZarrWrapper make_file_def_creator includes coordination_values when provided", { + coord_values <- list(spatialImageLayer = "image") + w <- ImageOmeZarrWrapper$new(img_path = "test.ome.zarr", coordination_values = coord_values) + + creator <- w$make_file_def_creator("dataset1", 1) + file_def <- creator("http://localhost:8000") + + expect_equal(file_def$coordinationValues, coord_values) +}) + +test_that("ObsSegmentationsOmeZarrWrapper can be created with required parameters", { + w <- ObsSegmentationsOmeZarrWrapper$new(img_path = "segmentations.ome.zarr") + + expect_equal(w$img_path, "segmentations.ome.zarr") + expect_false(w$is_remote) +}) + +test_that("ObsSegmentationsOmeZarrWrapper requires exactly one of img_path or img_url", { + expect_error(ObsSegmentationsOmeZarrWrapper$new(), "Expected one of img_path or img_url to be provided") + expect_error(ObsSegmentationsOmeZarrWrapper$new(img_path = "seg.ome.zarr", img_url = "http://example.com/seg.ome.zarr"), + "Expected one of img_path or img_url to be provided") +}) + +test_that("ObsSegmentationsOmeZarrWrapper make_file_def_creator creates correct file definition", { + w <- ObsSegmentationsOmeZarrWrapper$new(img_path = "segmentations.ome.zarr") + + creator <- w$make_file_def_creator("dataset1", 1) + file_def <- creator("http://localhost:8000") + + expect_equal(file_def$fileType, "obsSegmentations.ome-zarr") + expect_true(grepl("http://localhost:8000/dataset1/1/", file_def$url)) +}) + +test_that("ObsSegmentationsOmeZarrWrapper includes obs_types_from_channel_names when provided", { + w <- ObsSegmentationsOmeZarrWrapper$new(img_path = "segmentations.ome.zarr", obs_types_from_channel_names = TRUE) + + creator <- w$make_file_def_creator("dataset1", 1) + file_def <- creator("http://localhost:8000") + + expect_true(file_def$options$obsTypesFromChannelNames) +}) + +test_that("ObsSegmentationsOmeZarrWrapper includes coordinate_transformations when provided", { + transformations <- list(matrix = c(1, 0, 0, 0, 1, 0, 0, 0, 1)) + w <- ObsSegmentationsOmeZarrWrapper$new(img_path = "segmentations.ome.zarr", coordinate_transformations = transformations) + + creator <- w$make_file_def_creator("dataset1", 1) + file_def <- creator("http://localhost:8000") + + expect_equal(file_def$options$coordinateTransformations, transformations) +}) \ No newline at end of file