context("term finding and info APIs")
test_that("Test term details", {
skip_on_cran()
b <- phenotypic_quality_term_info("shape")
c <- anatomy_term_info("basihyal bone")
g <- gene_info("socs5")
gg <- gene_info("socs5", "Danio rerio")
expect_is(b, 'data.frame')
expect_equal(nrow(b), 1)
expect_false(any(is.na(b)))
expect_is(c, 'data.frame')
expect_equal(nrow(c), 1)
expect_false(any(is.na(c)))
expect_warning(bb <- phenotypic_quality_term_info("shape tt"))
expect_warning(cc <- anatomy_term_info("fin tt"))
expect_true(is.na(bb))
expect_true(is.na(cc))
expect_is(g, "data.frame")
expect_gte(length(unique(g$taxon.label)), 2)
expect_setequal(unique(g$matchType), c("exact", "partial"))
expect_is(gg, "data.frame")
expect_length(unique(gg$taxon.label), 1)
expect_length(unique(gg$label), 2)
})
test_that("Test deprecated term details", {
skip_on_cran()
expect_warning(b <- pk_phenotype_detail("shape"))
expect_warning(c <- pk_anatomical_detail("basihyal bone"))
expect_warning(g <- pk_gene_detail("socs5"))
expect_warning(gg <- pk_gene_detail("socs5", "Danio rerio"))
expect_is(b, 'data.frame')
expect_equal(nrow(b), 1)
expect_false(any(is.na(b)))
expect_is(c, 'data.frame')
expect_equal(nrow(c), 1)
expect_false(any(is.na(c)))
})
test_that("taxon details works", {
skip_on_cran()
a <- taxon_info("Coralliozetus")
expect_is(a, 'data.frame')
expect_gt(nrow(a), 0)
expect_setequal(colnames(a),
c("id", "label", "extinct", "rank.id", "rank.label", "common_name"))
expect_warning(aa <- taxon_info("coral tt"))
expect_warning(bb <- taxon_info("http://foobar.com/taxon"))
expect_warning(cc <- taxon_info(c("coral tt", "Danio rerio")))
expect_true(is.na(aa))
expect_true(is.na(bb))
expect_true(any(is.na(cc)))
expect_false(all(is.na(cc)))
expect_equal(nrow(cc), 2)
expect_true(all(is.na(cc[1,])))
dd <- taxon_info(c("Danio", "Danio rerio"))
expect_equal(nrow(dd), 2)
expect_true(any(is.na(dd$common_name)))
expect_false(all(is.na(dd$common_name)))
})
test_that("taxon info can use includeRelatedSynonyms", {
expect_warning(d <- taxon_info("Chrosomus eos"))
expect_true(is.na(d))
expect_warning(d2 <- taxon_info("Chrosomus eos", includeRelatedSynonyms = FALSE))
expect_true(is.na(d2))
expect_warning(d3 <- taxon_info("Chrosomus eos", includeRelatedSynonyms = TRUE))
expect_equal(nrow(d3), 1)
expect_equal(d3$id, "http://purl.obolibrary.org/obo/VTO_0040309")
})
test_that("Test deprecated taxon details", {
skip_on_cran()
expect_warning(a <- pk_taxon_detail("Coralliozetus"))
expect_is(a, 'data.frame')
expect_gt(nrow(a), 0)
expect_setequal(colnames(a),
c("id", "label", "extinct", "rank.id", "rank.label", "common_name"))
})
test_that("is_extinct works", {
skip_on_cran()
ext <- is_extinct("Fisherichthys")
expect_is(ext, "logical")
expect_equal(names(ext), c("Fisherichthys"))
# make one an unresolvable typo
expect_warning(ext <- is_extinct(c("Fisheririchthys", "Tiktaalik")))
expect_is(ext, "logical")
expect_length(ext, 2)
expect_true(any(is.na(ext)))
expect_false(all(is.na(ext)))
expect_equal(names(ext), c("Fisheririchthys", "Tiktaalik"))
})
test_that("Test deprecated is extinct", {
skip_on_cran()
expect_warning(ext <- pk_is_extinct("Fisherichthys"))
expect_is(ext, "logical")
expect_equal(names(ext), c("Fisherichthys"))
})
test_that("Test retrieving IRI", {
skip_on_cran()
i <- get_term_iri("Coralliozetus", "vto")
expect_equal(i, "http://purl.obolibrary.org/obo/VTO_0042955")
expect_warning(ii <- get_term_iri("Coralliozetus TT", "vto"))
expect_warning(iii <- get_term_iri("Coralliozetus", "pato"))
expect_true(is.na(ii))
expect_true(is.na(iii))
tiris <- find_term("pelvic fin", definedBy = NA, matchTypes = c("exact"))
expect_gte(nrow(tiris), 1)
expect_silent(tiri <- get_term_iri("pelvic fin", as = NA, exactOnly = TRUE))
expect_equal(tiri, "http://purl.obolibrary.org/obo/UBERON_0000152")
tiris <- find_term("part_of", definedBy = NA)
expect_true("isDefinedBy" %in% colnames(tiris))
expect_true(all(is.na(tiris$isDefinedBy)))
expect_warning(tiri <- get_term_iri("anatomical structure", as = NA, exactOnly = TRUE))
expect_is(tiri, "character")
expect_true(startsWith(tiri, "http://purl.obolibrary.org/obo/"))
})
test_that("Test retrieving IRI using includeRelatedSynonyms", {
expect_warning(IRI <- get_term_iri("Chrosomus eos", as="taxon"))
expect_equal(IRI, NA)
expect_warning(IRI <- get_term_iri("Chrosomus eos", as = "taxon", includeRelatedSynonyms = TRUE))
expect_equal(IRI, "http://purl.obolibrary.org/obo/VTO_0040309")
expect_warning(IRI <- get_term_iri("Chrosomus eos", as = "taxon", includeRelatedSynonyms = FALSE))
expect_equal(IRI, NA)
})
test_that("Test finding terms without a limit", {
# Ensure that we receive more than the default KB API limit (100)
expect_gt(nrow(find_term("fin", limit=NA)), 100)
})
test_that("Deprecated function forr retrieving IRI", {
skip_on_cran()
expect_warning(tt <- pk_get_iri("Coralliozetus", "vto"))
expect_equal(tt, "http://purl.obolibrary.org/obo/VTO_0042955")
expect_equal(tt, get_term_iri("Coralliozetus", "vto"))
expect_warning(tt <- pk_get_iri("pelvic fin", as = NA, exactOnly = TRUE))
expect_equal(tt, "http://purl.obolibrary.org/obo/UBERON_0000152")
expect_equal(tt, get_term_iri("pelvic fin", as = NA, exactOnly = TRUE))
})
test_that("Test getting labels", {
tt <- c("http://purl.obolibrary.org/obo/UBERON_0000981",
"http://purl.obolibrary.org/obo/UBERON_0002103",
"http://purl.obolibrary.org/obo/UBERON_0000976",
"http://purl.obolibrary.org/obo/UBERON_0002102")
lbls <- get_term_label(tt)
testthat::expect_equal(length(tt), nrow(lbls))
testthat::expect_false(any(is.na(lbls$label)))
testthat::expect_setequal(tt, lbls$id)
lbls <- get_term_label(tt, preserveOrder = TRUE)
testthat::expect_equal(tt, lbls$id)
testthat::expect_silent(lbls <- get_term_label(c(tt, "http://foo")))
testthat::expect_equal(sum(is.na(lbls$label)), 1)
testthat::expect_equal(lbls$id[is.na(lbls$label)], "http://foo")
lbls <- get_term_label(tt[1])
testthat::expect_equal(nrow(lbls), 1)
testthat::expect_false(is.na(lbls$label))
lbls <- get_term_label("http://foobar")
testthat::expect_equal(nrow(lbls), 1)
testthat::expect_equal(lbls$id, "http://foobar")
testthat::expect_true(is.na(lbls$label))
})
test_that("labels for pre-generated post-comps", {
phen <- sample(get_phenotypes("basihyal bone")$id, size = 1)
subs <- sample(rownames(subsumer_matrix(phen)), size = 30)
subs.l <- get_term_label(subs, preserveOrder = TRUE)
testthat::expect_lte(sum(is.na(subs.l$label)), 1)
subs <- sample(rownames(subsumer_matrix(c("femur"))), 30)
subs.l <- get_term_label(subs, preserveOrder = TRUE)
# Unfortunately, there are some regular ontologies for which the database
# does not consistently have labels. Filter those out.
ontFilter <- Reduce(
function(v1, v2) v1 | startsWith(subs.l$id, v2),
paste0("http://purl.obolibrary.org/obo/", c("CARO"), "_"),
init = rep(FALSE, times = length(subs.l$id))
)
subs.l <- subs.l[! (is.na(subs.l$label) & ontFilter),]
testthat::expect_lte(sum(is.na(subs.l$label)), 1)
})
test_that("creating terminfo objects and extracting properties", {
terms = find_term("basihyal bone")
# not a terminfo object
testthat::expect_false(is.terminfo(terms))
testthat::expect_false(is.terminfo(terms[1,]))
testthat::expect_false(is.terminfo(terms$id[1]))
# create one terminfo object
obj <- as.terminfo(terms[1, "id"])
testthat::expect_is(obj, "terminfo")
testthat::expect_true(is.terminfo(obj))
testthat::expect_true(is_valid_terminfo(obj))
# the current api automatically supplies classification data
testthat::expect_true("classification" %in% names(obj))
testthat::expect_equal(length(obj$classification), 3)
# robust to unresolving IRIs
testthat::expect_warning(obj <- as.terminfo("foo"))
testthat::expect_is(obj, "terminfo")
testthat::expect_true(is.terminfo(obj))
testthat::expect_false(is_valid_terminfo(obj))
# robust to unresolving IRIs including classification
testthat::expect_warning(obj <- as.terminfo("foo", withClassification = TRUE))
testthat::expect_is(obj, "terminfo")
testthat::expect_true(is.terminfo(obj))
testthat::expect_false(is_valid_terminfo(obj))
# also works with data.frame as input
obj <- as.terminfo(terms[1,])
testthat::expect_is(obj, "terminfo")
testthat::expect_true(is.terminfo(obj))
testthat::expect_true(is_valid_terminfo(obj))
# can run vectorized
testthat::expect_gt(length(terms$id), 1)
objs <- as.terminfo(terms$id)
testthat::expect_length(objs, nrow(terms))
testthat::expect_is(objs, "list")
testthat::expect_true(all(sapply(objs, is.terminfo)))
testthat::expect_length(is_valid_terminfo(objs), length(objs))
testthat::expect_true(all(is_valid_terminfo(objs)))
l <- sapply(objs, function(p) p$label)
testthat::expect_true(all(l == terms$label))
# filter out ZP terms because they do not have synonyms
non_zp_terms <- terms[terms$isDefinedBy != ontology_iri("ZP"),]
objs <- as.terminfo(non_zp_terms$id)
testthat::expect_true(all(sapply(objs, function(p) nrow(p$synonyms)) > 0))
})
test_that("pretty-printing terminfo objects", {
# find term iri
term_iri <- find_term("basihyal bone", limit = 1)
# create terminfo object
ti <- as.terminfo(term_iri)
# check print output
expect_output(print(ti), "terminfo 'basihyal bone' http.*Definition:.*Synonyms:.*Relationships:.*")
# create terminfo object with classification
ti <- as.terminfo(term_iri, withClassification = TRUE)
# check print output including classification sections
expect_output(print(ti), "terminfo 'basihyal bone' http.*Definition:.*Synonyms:.*Relationships:.*Subclass of:.*Superclass of::*")
# find taxon term iri
term_iri <- find_term('Coralliozetus angelicus', limit = 1)
# create terminfo object
ti <- as.terminfo(term_iri)
# check print output including taxon specific sections
expect_output(print(ti), "terminfo 'Coralliozetus angelicus' http.*Synonyms:.*Extinct:.*Rank:.*Common Name:.*")
})
test_that("as.terminfo withClassification can be controlled via an option", {
# find term iri
term_iri <- find_term("basihyal bone", limit = 1)
# create terminfo object
ti <- as.terminfo(term_iri)
# classification is filled in by default
testthat::expect_true("classification" %in% names(ti))
# turn on the option to default withClassification to TRUE
options(rphenoscape.fetch.classification = TRUE)
# create terminfo object
ti <- as.terminfo(term_iri)
# classification should be filled in
testthat::expect_true("classification" %in% names(ti))
testthat::expect_equal(length(ti$classification), 3)
# setting the option to FALSE should return to the default behavior
options(rphenoscape.fetch.classification = FALSE)
# create terminfo object
ti <- as.terminfo(term_iri)
# classification is filled in by default
testthat::expect_true("classification" %in% names(ti))
})
test_that("as.terminfo can add classification to terminfo objects", {
# find term iri
term_iri <- find_term("basihyal bone", limit = 1)
# create terminfo object
ti <- as.terminfo(term_iri)
# classification is filled in by default
testthat::expect_true("classification" %in% names(ti))
# run as.terminfo on a terminfo object requesting classification data
ti <- as.terminfo(ti, withClassification = TRUE)
# classification should be filled in
testthat::expect_true("classification" %in% names(ti))
})
Add the following code to your website.
For more information on customizing the embed code, read Embedding Snippets.