#' @title Check availability of an assay
#'
#' @description Checks if the provided object contains a specific assay.
#'
#' @inherit argument_dummy params
#'
#' @return Logical value.
#'
#' @seealso [`getAssayNames()`], [`MolecularAssay`]
#'
#' @export
<- (object, assay_name, error = ){
out <- assay_name %in% (object)
(::(error) & ::(out)){
(glue::glue("This SPATA2 object does not contain an assay of molecular modality '{assay_name}'."))
}
(out)
}
#' @title Check availability of capture area
#'
#' @description Checks if the object contains a capture area data.frame
#' as obtained by [`getCaptureArea()`].
#'
#' @inherit argument_dummy params
#'
#' @return Logical value.
#'
#' @export
( = "containsCaptureArea", def = (object, ){
standardGeneric(f = "containsCaptureArea")
})
#' @rdname containsCaptureArea
#' @export
(
f = "containsCaptureArea",
= "SPATA2",
definition = (object, error = ){
(object) %>%
(., error = error)
}
)
#' @rdname containsCaptureArea
#' @export
(
f = "containsCaptureArea",
= "SpatialData",
definition = (object, error = ){
out <- (object@capture_area) >= 3
((out) & (error)){
("No capture area in this object.")
}
(out)
}
)
#' @title Check availability of center to center distance
#'
#' @description Checks if the object contains a center to center
#' distance as obtained by [`getCCD()`].
#'
#' @inherit argument_dummy params
#'
#' @return Logical value.
#'
#' @export
( = "containsCCD", def = (object, ){
standardGeneric(f = "containsCCD")
})
#' @rdname containsCCD
#' @export
(
f = "containsCCD",
= "ANY",
definition = (object, error = ){
ccd <- (object)@method_specifics"ccd"]]
out <- !purrr::is_empty(ccd)
(::(out) & ::(error)){
("No center to center distance found. Use `setCCD()` or `computeCCD()`.")
}
(out)
}
)
#' @title Check availability of cells
#'
#' @description Checks if the object revolves around a spatial method
#' with single cells as the observational unit.
#'
#' @inherit argument_dummy params
#'
#' @return Logical value.
#'
#' @seealso [`containsSpots()`]
#'
#' @export
#'
( = "containsCells", def = (object, ){
standardGeneric(f = "containsCells")
})
#' @rdname containsCells
#' @export
(
f = "containsCells",
= "ANY",
definition = (object, error = ){
out <- (object)@observational_unit == "cell"
(::(out) && ::(error)){
("Object does not contain cells as observational units.")
}
(out)
}
)
#' @title Check availability CNV results
#'
#' @description Logical tests that check if content exists in the `SPATA2` object.
#'
#' @inherit argument_dummy params
#'
#' @return Logical value.
#'
#' @export
<- (object, error = ){
out <-
::({
ma <- (object, assay_name = "gene")
cnv <- ma@analysis$cnv
purrr::is_list(cnv) && !purrr::is_empty(cnv)
}, error = (error){
})
(::(out) & ::(error)){
("No CNV results found in this object. Use `runCNV()`.")
}
(out)
}
#' @title Check availability of image containers
#'
#' @description Checks if the input object contains any [`HistoImage`] objects.
#'
#' Note to confuse with [`containsImage()`].
#'
#' @inherit argument_dummy params
#'
#' @return Logical value.
#'
#' @export
( = "containsHistoImages", def = (object, ){
standardGeneric(f = "containsHistoImages")
})
#' @rdname containsHistoImages
#' @export
(
f = "containsHistoImages",
= "SPATA2",
definition = (object, error = , ){
(object) %>%
(object = ., error = error)
}
)
#' @rdname containsHistoImages
#' @export
(
f = "containsHistoImages",
= "SpatialData",
definition = (object, error = , ){
out <-
purrr::map_lgl(.x = object@images, .f = ~ ::(.x, class2 = "HistoImage")) %>%
::()
(::(out) & ::(error)){
("No images found in this object.")
}
(out)
}
)
#' @title Check availability of an image
#'
#' @description Checks if the input object has an image in the
#' respective slot or if the slot is empty.
#'
#' @inherit argument_dummy params
#'
#' @return Logical value.
#'
#' @export
( = "containsImage", def = (object, ){
standardGeneric(f = "containsImage")
})
#' @rdname containsImage
#' @export
(
f = "containsImage",
= "ANY",
definition = (object, img_name = (object), error = ){
out <- (object, error = error)
(::(out)){
out <-
(object, img_name = img_name) %>%
(object = ., error = error)
}
(out)
}
)
#' @rdname containsImage
#' @export
(
f = "containsImage",
= "SpatialAnnotation",
definition = (object, error = ){
out <- !::(x = object@, y = empty_image)
(::(out) & ::(error)){
("Input object contains no image.")
}
(out)
}
)
#' @rdname containsImage
#' @export
(
f = "containsImage",
= "HistoImage",
definition = (object, error = ){
out <-
!::(x = object@, y = empty_image) &
(object@) != 1
(::(out) & ::(error)){
("Input object contains no image.")
}
(out)
}
)
#' @title Check for inner borders in a spatial annotation
#'
#' @description Checks whether a `SpatialAnnotation` object contains any inner borders.
#'
#' @inherit getSpatialAnnotation params
#' @inherit argument_dummy params
#'
#' @seealso [`SpatialAnnotation`]
#'
#' @return Logical value.
#'
#' @export
#'
( = "containsInnerBorders", def = (object, ){
standardGeneric(f = "containsInnerBorders")
})
#' @rdname containsInnerBorders
#' @export
(
f = "containsInnerBorders",
= "SPATA2",
definition = (object, id, ){
(object, id = id) %>%
()
}
)
#' @rdname containsInnerBorders
#' @export
(
f = "containsInnerBorders",
= "SpatialAnnotation",
definition = (object, ){
stringr::str_detect(::(object@area), = "inner") %>%
::()
}
)
#' @rdname containsInnerBorders
#' @export
(
f = "containsInnerBorders",
= "data.frame",
definition = (object, ){
stringr::str_detect(object$border, = "inner") %>%
::()
}
)
#' @title Check availability of molecular modality
#'
#' @description Tests if the input object contains a molecular assay
#' of a certain modality.
#'
#' @inherit argument_dummy params
#'
#' @return Logical value.
#' @export
<- (object, modality, error = , ){
confuns::is_value(modality, = "character")
out <- modality %in% ::(object@assays)
(::(out) & ::(error)){
("SPATA2 object does not contain an assay of modality '{modality}'.")
}
(out)
}
#' @title Check availability of specific spatial methods (platforms)
#'
#' @description Tests if the input object is associated with
#' specific \link[=spatial_methods]{spatial methods / platforms}.
#'
#' @param method_name Character vector. The names of platforms to check.
#' @inherit argument_dummy params
#'
#' @return Logical value. TRUE if any of `method_name` is the name of the platform.
#' @export
#'
( = "containsMethod", def = (object, ){
standardGeneric(f = "containsMethod")
})
#' @rdname containsMethod
#' @export
(
f = "containsMethod",
= "SPATA2",
definition = (object, method_name, error = ){
sp_data <- (object)
(
object = sp_data,
method_name = method_name,
error = error
)
}
)
#' @rdname containsMethod
#' @export
(
f = "containsMethod",
= "SpatialData",
definition = (object, method_name, error = ){
test <-
purrr::map_lgl(
.x = method_name,
.f = ~ stringr::str_detect(object@method@, = .x)
)
res <- ::(test)
(!::(res) & ::(error)){
method_name <- confuns::scollapse(method_name, last = " or ")
(glue::glue("Input object does not contain a {method_name} set up."))
}
(res)
}
)
#' @title Check availability pixel content
#'
#' @description Checks if slot @@pxl_content of a `HistoImage` object
#' contains the results of `identifyPixelContent()`.
#'
#' @inherit argument_dummy params
#'
#' @return Logical value.
#'
#' @seealso [`identifyPixelContent()`]
#'
#' @export
( = "containsPixelContent", def = (object, ){
standardGeneric(f = "containsPixelContent")
})
#' @rdname containsPixelContent
#' @export
(
f = "containsPixelContent",
= "SpatialData",
definition = (object, img_name, error = ){
(object, img_name = img_name) %>%
(object = ., error = error)
}
)
#' @rdname containsPixelContent
#' @export
(
f = "containsPixelContent",
= "HistoImage",
definition = (object, error = ){
out <- !purrr::is_empty(object@pixel_content)
(::(out) && ::(error)){
(glue::glue("No pixel content found in HistoImage {object@name}."))
}
(out)
}
)
#' @title Check if the object contains only a pseudo image
#'
#' @description Tests if the object only contains a pseudo image which
#' makes it not suitable for image depending processes.
#'
#' @inherit argument_dummy params
#'
#' @return Logical value.
#' @keywords internal
( = "containsPseudoImage", def = (object, ){
( = "containsPseudoImage")
})
#' @rdname containsPseudoImage
(
f = "containsPseudoImage",
= "ANY",
definition = (object, error = ){
img_names <- (object)
out <- ::(img_names == "pseudo")
(::(out) & ::(error)){
("This object only contains a pseudo image. It is not suitable for image
related functions.")
}
(out)
})
#' @title Check availability of specific scale factors
#'
#' @description Tests if specifics scale factors are set or not.
#'
#' @param fct_name Character value. The name of the scale factor of interest.
#' E.g. *'pixel'* or *'coords'*.
#'
#' @inherit argument_dummy params
#'
#' @return Logical value.
#' @export
#'
( = "containsScaleFactor", def = (object, ){
standardGeneric(f = "containsScaleFactor")
})
#' @rdname containsScaleFactor
#' @export
(
f = "containsScaleFactor",
= "SPATA2",
definition = (object,
fct_name,
img_name = (object),
error = ){
sp_data <- (object)
(
object = sp_data,
fct_name = fct_name,
img_name = img_name,
error = error
)
}
)
#' @rdname containsScaleFactor
#' @export
(
f = "containsScaleFactor",
= "SpatialData",
definition = (object,
fct_name,
img_name = (object),
error = ){
out <- !::((object, fct_name = fct_name, img_name = img_name))
(::(out) & ::(error)){
(!::(img_name)){
img_name <- getHistoImageActive(object)@
}
ref <- confuns::make_pretty_name(string = fct_name)
(glue::glue("{ref} scale factor does not exist for image {img_name}."))
}
(out)
}
)
#' @title Checks availability of a SpatialData object
#'
#' @description Tests if the input object contains an object
#' of class `SpatialData`.
#'
#' @inherit argument_dummy params
#'
#' @return Logical value.
#' @export
#'
<- (object, error = ){
out <-
!purrr::is_empty(object@spatial) &
::(object@spatial, "SpatialData")
(out)
}
#' @title Check if spatial outliers exist
#'
#' @description Checks if [`identifySpatialOutliers()`] has identified any
#' spatial outliers.
#'
#' @inherit argument_dummy params
#'
#' @seealso [`removeSpatialOutliers()`] to exclude spatial outliers from further
#' analysis.
#'
#' @return Logical value.
#' @export
#'
<- (object, ){
(object, error = )
meta_df <- (object)
n_outlier <- ::(meta_df"sp_outlier"]])
out <- n_outlier >= 1
fdb_fn <- ()"fdb_fn"]]
(::(out) & ::(fdb_fn)){
confuns::give_feedback(
msg = "No spatial outliers in this object.",
fdb.fn = fdb_fn,
with.time =
)
}
(out)
}
#' @title Check availability of spots
#'
#' @description Checks if the object revolves around a spatial method
#' with grid based spots as the observational unit.
#'
#' @inherit argument_dummy params
#'
#' @return Logical value.
#'
#' @seealso [`containsCells()`]
#'
#' @export
#'
( = "containsSpots", def = (object, ){
standardGeneric(f = "containsSpots")
})
#' @rdname containsSpots
#' @export
(
f = "containsSpots",
= "ANY",
definition = (object, error = ){
out <- stringr::str_detect((object)@observational_unit, "spot")
(::(out) && ::(error)){
("Object does not contain spots as observational units.")
}
(out)
}
)
#' @title Check availability of tissue outline
#'
#' @description Tests if the object contains tissue outline
#' as identified by [`identifyTissueOutline()`].
#'
#' @inherit argument_dummy params
#'
#' @return Logical value.
#' @export
#'
( = "containsTissueOutline", def = (object, ){
standardGeneric(f = "containsTissueOutline")
})
#' @rdname containsTissueOutline
#' @export
(
f = "containsTissueOutline",
= "SPATA2",
definition = (object,
method = ,
img_name = (object),
error = ){
(object) %>%
(
object = .,
img_name = img_name,
method = method,
error = error
)
}
)
#' @rdname containsTissueOutline
#' @export
(
f = "containsTissueOutline",
= "SpatialData",
definition = (object,
method = ,
img_name = (object),
error = ){
(::(method)){
(!(object)){
out <- !purrr::is_empty(object@outline)
} {
out <-
(object, img_name = img_name) %>%
(object = ., error = )
(::(out)){
out <- !purrr::is_empty(object@outline)
}
}
} {
(method == "obs"){
out <- !purrr::is_empty(object@outline)
(::(out) & ::(error)){
("No tissue outline found for method 'obs' in this object.")
}
} {
((object)){
out <-
(object, img_name = img_name) %>%
(object = ., error = error)
} {
out <-
(::(error)){
("There are no images in this object. Choose different method for tissue outline.")
}
}
}
}
(::(method) & ::(out) & ::(error)){
("No tissue outline found in this object.")
}
(out)
}
)
#' @rdname containsTissueOutline
#' @export
(
f = "containsTissueOutline",
= "HistoImage",
definition = (object, img_name = (object), error = ){
out <- !purrr::is_empty(object@outline)
(::(out) & ::(error)){
(glue::glue("No tissue outline found for image {object@name}."))
}
(out)
}
)
#' @title Check availability of spatial annotations
#'
#' @description Tests if the object contains spatial annotations
#' as created by [`createGroupAnnotations`] [`createImageAnnotations`] and
#' [`createNumericAnnotations()`].
#'
#' @inherit argument_dummy params
#'
#' @return Logical value.
#' @export
( = "containsSpatialAnnotations", def = (object, ){
standardGeneric(f = "containsSpatialAnnotations")
})
#' @rdname containsSpatialAnnotations
#' @export
(
f = "containsSpatialAnnotations",
= "SPATA2",
definition = (object, error = ){
(object) %>%
(object = ., error = error)
}
)
#' @rdname containsSpatialAnnotations
#' @export
(
f = "containsSpatialAnnotations",
= "SpatialData",
definition = (object, error = ){
ids <- (object)
(::(ids) == 0){
out <-
(::(error)){
("Object does not contain any spatial annotations.")
}
} {
out <-
}
(out)
}
)
#' @title Checks availability of slot @@version
#'
#' @description Tests if slot @@version exists.
#'
#' @param check_not_empty Logical value. If `TRUE`, tests additionally if
#' the slot content is not empty.
#' @inherit argument_dummy params
#'
#' @return Logical value.
#' @keywords internal
#'
<- (object, check_not_empty = ){
contains_version <-
::({
out <- ::(object@)
(::(out) & ::(check_not_empty)){
out <- !purrr::is_empty(object@)
}
out
}, error = (error){
})
(contains_version)
}
