diff --git a/R/pk_terms.R b/R/pk_terms.R index 577891f..9e6f3af 100644 --- a/R/pk_terms.R +++ b/R/pk_terms.R @@ -150,9 +150,22 @@ get_term_label <- function(term_iris, preserveOrder = FALSE, verbose = FALSE) { if (length(res) > 0) { names(res) <- sub("@", "", names(res)) } - if (preserveOrder && nrow(res) > 0) { - reordering <- match(term_iris, res$id) - res <- res[reordering,] + if (nrow(res) > 0) { + noLabel <- is.na(res$label) + if (any(noLabel)) { + res[noLabel, "label"] <- sapply(res$id[noLabel], function(iri) { + clInfo <- pk_class(iri, as = NA, verbose = verbose) + if (length(clInfo) <= 1 || clInfo$label == iri) + NA + else + clInfo$label + }, + USE.NAMES = FALSE) + } + if (preserveOrder) { + reordering <- match(term_iris, res$id) + res <- res[reordering,] + } } res diff --git a/tests/testthat/test-pk.R b/tests/testthat/test-pk.R index 84f5ccd..10c395a 100644 --- a/tests/testthat/test-pk.R +++ b/tests/testthat/test-pk.R @@ -126,11 +126,21 @@ test_that("Test getting labels", { testthat::expect_equal(nrow(lbls), 1) testthat::expect_false(is.na(lbls$label)) - lbls <- get_term_label("urn:foobar") + lbls <- get_term_label("http://foobar") testthat::expect_equal(nrow(lbls), 1) - testthat::expect_equal(lbls$id, "urn:foobar") + 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) + testthat::expect_lte(sum(is.na(subs.l$label)), 1) }) test_that("Test getting study information", {