From 043c27ab23882a5e254a7f403d7113901b57316a Mon Sep 17 00:00:00 2001
From: Hilmar Lapp <hlapp@drycafe.net>
Date: Sun, 23 Feb 2020 12:54:32 -0500
Subject: [PATCH] Improves recovery of labels for pregenerated post-comps

Due to an issue in the KB API (phenoscape/phenoscape-kb-services#199)
the /term/labels endpoint fails for most (all?) post-compositions.
This works around this bug for now by trying /term/classification for
those IDs for which /term/labels fails.

Includes tests.
---
 R/pk_terms.R             | 19 ++++++++++++++++---
 tests/testthat/test-pk.R | 14 ++++++++++++--
 2 files changed, 28 insertions(+), 5 deletions(-)

diff --git a/R/pk_terms.R b/R/pk_terms.R
index e87386a..d78c3ba 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 (is.na(clInfo) || length(clInfo) == 0 || 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 547f1d1..fb78f13 100644
--- a/tests/testthat/test-pk.R
+++ b/tests/testthat/test-pk.R
@@ -114,11 +114,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", {