#' List materials
#'
#' Materials in openBIS can represent a variety of objects. For the InfectX
#' HTS setup, this is mainly limited to either compounds such as oligos or
#' small molecule drugs and targeted genes. Three different objects are used to
#' identify a material: `MaterialGeneric`, `MaterialIdentifierGeneric` and
#' `MaterialIdentifierScreening`. Converting to id object types can be
#' achieved with `as_generic_mat_id()` and `as_screening_mat_id()` while
#' listing materials as `MaterialGeneric` objects is possible with
#' `list_material()`.
#'
#' Unfortunately in this version of the openBIS JSON-RPC API, there is no
#' possibility for listing all available materials for a project or
#' experiment. Methods that return `MaterialGeneric` objects include
#' `list_material()`, which can be dispatched on material id objects and
#' objects representing plates, and [search_openbis()] with the target selector
#' `target_object` set to `material`. Coercing `MaterialGeneric` objects to
#' material id objects is possible with `as_generic_mat_id()` and
#' `as_screening_mat_id()` which do not incur an API call.
#'
#' Instantiating material id objects is either done manually by calling
#' `material_id()` or by querying openBIS for `MaterialGeneric` objects and
#' converting to `MaterialIdentifierGeneric` or `MaterialIdentifierScreening`.
#' A material id object is defined by a material code and a material type.
#' Available types depend on whether generic or screening material objects are
#' of interest. For generic material objects, possible ids are
#' * compound
#' * control
#' * esirna
#' * gene
#' * mirna
#' * mirna_inhibitor
#' * mirna_mimic
#' * pooled_sirna
#' * sirna
#'
#' and for screening materials, ids can be
#' * compound
#' * gene
#' * oligo
#'
#' Material type objects can be instantiated by calling
#' `list_material_types()`, where the `mode` argument acts as a switch to
#' choose between generic and screening objects. If only a subset of types
#' are relevant, the output of `list_material_types()` can be limited by
#' passing a character vector with type names as `types` argument. The second
#' piece of information for constructing material id objects, material codes,
#' depends on material type. Genes, for example are identified with Entrez
#' gene ids (e.g. 2475 for MTOR), while for compounds, a manufacturer name is
#' used (e.g. for Ambion and MTOR, AMBION_S602, AMBION_S603 and AMBION_S604).
#'
#' Whenever `list_material()` is dispatched on a (set of) material id
#' object(s), a (set of) `MaterialGeneric` object(s) is returned. However if
#' the dispatch occurs on plate objects (`Plate`, `PlateIdentifier` or
#' `PlateMetadata`), a (set of) `PlateWellMaterialMapping` objects is returned.
#' If `material_type` is not specified (i.e. `NULL`), the `mapping` field in
#' the returned object will contain `NULL` for each well. When passing a set
#' of `MaterialTypeIdentifierScreening` objects, as returned by
#' `list_material_types()`, the `mapping` fields will contain material type
#' information where available. The convenience function
#' `extract_well_material()` can be applied to a `PlateWellMaterialMapping`
#' object and will return the selected `MaterialIdentifierScreening` object.
#'
#' @inheritParams logout_openbis
#' @param x A (vector of) `MaterialIdentifier` object(s).
#' @param code The material code for which an id object is created.
#' @param type The material type (possible values depend on mode).
#' @param mode Switch between generic and screening material id objects.
#' @param material_type A `MaterialTypeIdentifierScreening` object to restrict
#' the material listing to a certain type of materials.
#' @param ... Generic compatibility. Extra arguments will be passed to
#' [make_requests()].
#'
#' @family object listing functions
#'
#' @section openBIS:
#' * \Sexpr[results=rd]{infx::docs_link("gis", "getMaterialByCodes")}
#' * \Sexpr[results=rd]{infx::docs_link("sas", "listPlateMaterialMapping")}
#'
#' @return Depending on the number of resulting objects, either a
#' [`json_class`] (single object) or a [`json_vec`] (multiple objects), is
#' returned. For `list_material()` and `extract_well_material()`, the
#' additional class attribute `MaterialGeneric` is added and the utility
#' functions `as_generic_mat_id()` and `as_screening_mat_id()` return
#' `MaterialIdentifierGeneric` and `MaterialIdentifierScreening` objects,
#' respectively, while `material_id()` can return either, depending on the
#' `mode` argument. Finally, `list_material_types()` returns
#' `MaterialTypeIdentifierGeneric` or `MaterialTypeIdentifierScreening`, again
#' depending on the `mode` argument.
#'
#' @examples
#' \donttest{
#' tok <- login_openbis()
#'
#' # search for a sample object corresponding to plate KB2-03-1I
#' samp <- search_openbis(tok,
#' search_criteria(
#' attribute_clause("code",
#' "/INFECTX_PUBLISHED/KB2-03-1I")
#' ),
#' target_object = "sample")
#'
#' # list all material types
#' types <- list_material_types()
#' print(types)
#'
#' # list all gene targets on plate KB2-03-1I
#' mat_map <- list_material(tok, samp, types[[2L]])
#' print(mat_map, depth = 5, length = 20L)
#' # there are maximally width x height entries arranged in a linear,
#' # row-major fashion; missing entries are omitted, but original indices
#' # are accessible as original_index attributes
#' length(mat_map[["mapping"]])
#' attr(mat_map[["mapping"]][[42L]], "original_index")
#' # well A24 does not have a gene target as it is a MOCK control well
#' extract_well_material(mat_map, "A", 24)
#' # well A22 however has a gene target
#' a_22 <- extract_well_material(mat_map, "A", 22)
#' print(a_22, depth = 2L)
#'
#' # search for a material with material code 3480
#' igf1r <- search_openbis(tok,
#' search_criteria(attribute_clause("code", 3480)),
#' target_object = "material")
#'
#' all.equal(as_screening_mat_id(igf1r), a_22, check.attributes = FALSE)
#' identical(igf1r, list_material(tok, a_22))
#' identical(igf1r,
#' search_openbis(tok,
#' search_criteria(
#' property_clause("gene_symbol", "IGF1R")
#' ),
#' target_object = "material"))
#'
#' # search for an experiment object corresponding to plate KB2-03-1I
#' exp <- search_openbis(tok,
#' search_criteria(
#' attribute_clause(
#' "code",
#' samp[["experimentIdentifierOrNull"]]
#' )
#' ),
#' target_object = "experiment")
#'
#' # list all wells for the current material within the selected experiment
#' wells <- list_wells(tok, a_22, experiment = exp)
#' # this yields 3 plates, one of which is KB2-03-1I
#' get_field(get_field(wells, "experimentPlateIdentifier"), "plateCode")
#' # and the material of interest is in well A22 in each one
#' unique(get_field(wells, "wellPosition"))
#'
#' logout_openbis(tok)
#' }
#'
#' @export
#'
list_material <- function(token, x, ...)
UseMethod("list_material", x)
#' @rdname list_material
#' @export
#'
list_material.MaterialIdentifierGeneric <- function(token, x, ...)
make_request(api_url("gis", attr(token, "host_url"), ...),
"getMaterialByCodes",
list(token, as_json_vec(x)),
...)
#' @rdname list_material
#' @export
#'
list_material.MaterialIdentifierScreening <- function(token, x, ...)
list_material(token, as_generic_mat_id(x), ...)
list_plate_mat_map <- function(token, x, material_type = NULL, ...) {
x <- as_json_vec(as_plate_id(x))
if (!is.null(material_type)) {
material_type <- as_json_vec(material_type)
assert_that(has_subclass(material_type, "MaterialTypeIdentifierScreening"))
} else
material_type <- list(NULL)
params <- lapply(material_type, function(y) list(token, x, y))
res <- make_requests(api_url("sas", attr(token, "host_url"), ...),
"listPlateMaterialMapping",
params,
...)
res <- lapply(res, as_json_vec)
as_json_vec(
Map(set_attr,
unlist(res, recursive = FALSE),
rep(material_type, vapply(res, length, integer(1L))),
MoreArgs = list(attr_name = "mat_type")),
simplify = TRUE
)
}
#' @rdname list_material
#' @export
#'
list_material.PlateIdentifier <- list_plate_mat_map
#' @rdname list_material
#' @export
#'
list_material.PlateMetadata <- list_plate_mat_map
#' @rdname list_material
#' @export
#'
list_material.Plate <- list_plate_mat_map
#' @rdname list_material
#' @export
#'
list_material.Sample <- function(token, x, material_type = NULL, ...)
list_plate_mat_map(token, as_json_vec(as_plate_id(x)), material_type, ...)
#' @rdname list_material
#' @export
#'
material_id <- function(code,
type = "gene",
mode = c("screening", "generic")) {
mode <- match.arg(mode)
if (length(type) == 1L)
mat_type <- rep(list_material_types(mode, type), length(code))
else {
mat_type <- lapply(type, function(x) list_material_types(mode, x))
mat_type <- as_json_vec(do.call(c, mat_type))
}
assert_that(length(mat_type) == length(code))
class <- switch(mode,
generic = "MaterialIdentifierGeneric",
screening = "MaterialIdentifierScreening")
as_json_vec(
Map(json_class,
materialTypeIdentifier = mat_type,
materialCode = code,
class = rep(class, length(code))),
simplify = TRUE
)
}
#' @param types Select one or several material types for which to return the
#' type id objects. NULL returns all available.
#'
#' @rdname list_material
#' @export
#'
list_material_types <- function(mode = c("screening", "generic"),
types = NULL) {
mode <- match.arg(mode)
all_types <- switch(mode,
generic = c("compound",
"control",
"esirna",
"gene",
"mirna",
"mirna_inhibitor",
"mirna_mimic",
"pooled_sirna",
"sirna"),
screening = c("compound",
"gene",
"oligo"))
if (!is.null(types)) {
assert_that(is.character(types),
all(toupper(types) %in% toupper(all_types)))
} else
types <- all_types
class <- switch(mode,
generic = "MaterialTypeIdentifierGeneric",
screening = "MaterialTypeIdentifierScreening")
as_json_vec(
Map(json_class,
materialTypeCode = toupper(types),
class = rep(class, length(types)),
USE.NAMES = FALSE),
simplify = TRUE
)
}
as_mat_id <- function(x, mode) {
x <- as_json_vec(x)
as_json_vec(
Map(material_id,
code = get_field(x, "materialCode"),
type = get_field(get_field(x, "materialTypeIdentifier"),
"materialTypeCode"),
MoreArgs = list(mode = mode)),
simplify = TRUE
)
}
as_screening <- function(x, ...)
as_mat_id(x, "screening")
as_generic <- function(x, ...)
as_mat_id(x, "generic")
#' @rdname list_material
#' @export
#'
as_screening_mat_id <- function(x, ...)
UseMethod("as_screening_mat_id", x)
#' @rdname list_material
#' @export
#'
as_screening_mat_id.MaterialGeneric <- as_screening
#' @rdname list_material
#' @export
#'
as_screening_mat_id.MaterialScreening <- as_screening
#' @rdname list_material
#' @export
#'
as_screening_mat_id.MaterialIdentifierGeneric <- as_screening
#' @rdname list_material
#' @export
#'
as_screening_mat_id.MaterialIdentifierScreening <- function(x, ...)
as_json_vec(x, simplify = TRUE)
#' @rdname list_material
#' @export
#'
as_generic_mat_id <- function(x, ...)
UseMethod("as_generic_mat_id", x)
#' @rdname list_material
#' @export
#'
as_generic_mat_id.MaterialGeneric <- as_generic
#' @rdname list_material
#' @export
#'
as_generic_mat_id.MaterialScreening <- as_generic
#' @rdname list_material
#' @export
#'
as_generic_mat_id.MaterialIdentifierGeneric <- function(x, ...)
as_json_vec(x, simplify = TRUE)
#' @rdname list_material
#' @export
#'
as_generic_mat_id.MaterialIdentifierScreening <- as_generic
#' @param row Either a single integer or a single character specifying a
#' plate row.
#' @param col A single integer specifying a plate column.
#'
#' @rdname list_material
#' @export
#'
extract_well_material <- function(x, row, col) {
x <- as_json_class(x)
if (is.character(row))
row <- match(toupper(row), LETTERS)
assert_that(has_subclass(x, "PlateWellMaterialMapping"),
is.count(row), is.count(col),
row <= get_field(get_field(x, "plateGeometry"), "height"),
col <= get_field(get_field(x, "plateGeometry"), "width"))
ind <- (row - 1L) * get_field(get_field(x, "plateGeometry"), "width") + col
mapping <- get_field(x, "mapping")
if (all(vapply(mapping, has_attr, logical(1L), "original_index"))) {
hit <- ind == vapply(mapping, attr, integer(1L), "original_index")
assert_that(sum(hit) <= 1L)
if (sum(hit) == 0L)
list()
else
mapping[[which(hit)]]
} else
mapping[[ind]]
}
Add the following code to your website.
For more information on customizing the embed code, read Embedding Snippets.