MOSAiC helper function improvements

R/mosaic.R

@@ -1,5 +1,6 @@
 
 
+
 #' Add a MOSAiC (https://mosaic-expedition.org/) attribute annotation (the returned object does not include the id slot)
 #'
 #' @param eventLabel (character) the event ID provided by the researcher
@@ -71,66 +72,79 @@ mosaic_annotate_attribute <- function(eventLabel) {
 #' #multiple campaigns
 #' mosaic_annotate_dataset(c("PS122/2", "PS122/1"))
 mosaic_annotate_dataset <- function(campaign) {
-  check_ps <-
-    purrr::map(campaign, ~ stringr::str_detect(.x, "PS", negate = T))
-
-  if (all(unlist(check_ps))) {
-    warning("Event id does not start with PS. Check if the basis is correct")
-  }
-
   mosaic <- read_ontology("mosaic")
 
   #get the possible campaigns
   query <-
     "PREFIX rdf: <http://www.w3.org/1999/02/22-rdf-syntax-ns#>
-   PREFIX rdfs: <http://www.w3.org/2000/01/rdf-schema#>
-
-   SELECT ?campaign_iri ?label
-   WHERE {
-     ?campaign_iri rdf:type <https://purl.dataone.org/odo/MOSAIC_00000001> .
-     ?campaign_iri rdfs:label ?label .
-   }"
+    PREFIX rdfs: <http://www.w3.org/2000/01/rdf-schema#>
+    PREFIX ssn: <http://www.w3.org/ns/ssn/>
+
+    SELECT ?campaign_iri ?label ?basis_iri ?blabel
+    WHERE {
+    ?campaign_iri rdf:type <https://purl.dataone.org/odo/MOSAIC_00000001> .
+    ?campaign_iri rdfs:label ?label .
+    OPTIONAL {
+    ?campaign_iri <https://purl.dataone.org/odo/MOSAIC_00000034> ?basis_iri .
+    ?basis_iri rdfs:label ?blabel .
+    }
+  }"
 
   df_campaign <- suppressMessages(rdflib::rdf_query(mosaic, query))
 
   stopifnot(campaign %in% df_campaign$label)
 
   campaign_iri <- dplyr::filter(df_campaign, label %in% campaign)
 
-  construct_campaign <- function(label, uri) {
-    # Campaign
-    list(
-      propertyURI = list(label = "isPartOfCampaign",
-                         propertyURI = "https://purl.dataone.org/odo/MOSAIC_00000032"),
-      valueURI = list(label = label,
-                      valueURI = uri)
-    )
+  construct_annotation <- function(label, uri, type) {
+    if (type == "Campaign") {
+      # Campaign
+      list(
+        propertyURI = list(label = "isPartOfCampaign",
+                           propertyURI = "https://purl.dataone.org/odo/MOSAIC_00000032"),
+        valueURI = list(label = label,
+                        valueURI = uri)
+      )
+    } else{
+      # Basis
+      if(is.na(label) | label == "Polarstern"){
+        list(
+          propertyURI = list(label = "hasBasis",
+                             propertyURI = "https://purl.dataone.org/odo/MOSAIC_00000034"),
+          valueURI = list(label = "Polarstern",
+                          valueURI = "https://purl.dataone.org/odo/MOSAIC_00000030")
+        )
+      } else{
+        list(
+          propertyURI = list(label = "hasBasis",
+                             propertyURI = "https://purl.dataone.org/odo/MOSAIC_00000034"),
+          valueURI = list(label = label,
+                          valueURI = uri)
+        )
+      }
+    }
   }
 
   campaigns <-
     purrr::map2(campaign_iri$label,
                 campaign_iri$campaign_iri,
-                construct_campaign)
+                ~construct_annotation(.x, .y, type = "Campaign"))
+
+  basis <-
+    purrr::map2(unique(campaign_iri$blabel),
+                unique(campaign_iri$basis_iri),
+                ~construct_annotation(.x, .y, type = "Basis"))
 
   #construct annotation
-  standard_annotations <- list(
-    # Basis
-    list(
-      propertyURI = list(label = "hasBasis",
-                         propertyURI = "https://purl.dataone.org/odo/MOSAIC_00000034"),
-      valueURI = list(label = "Polarstern",
-                      valueURI = "https://purl.dataone.org/odo/MOSAIC_00000030")
-    ),
-    # Project
-    list(
-      propertyURI = list(label = "hasProjectLabel",
-                         propertyURI = "https://purl.dataone.org/odo/MOSAIC_00000025"),
-      valueURI = list(label = "MOSAiC20192020",
-                      valueURI = "https://purl.dataone.org/odo/MOSAIC_00000023")
-    )
+  # Project
+  project <- list(
+    propertyURI = list(label = "hasProjectLabel",
+                       propertyURI = "https://purl.dataone.org/odo/MOSAIC_00000025"),
+    valueURI = list(label = "MOSAiC20192020",
+                    valueURI = "https://purl.dataone.org/odo/MOSAIC_00000023")
   )
 
-  append(standard_annotations, campaigns)
+  c(basis, list(project), campaigns)
 }
 
 #just the concepts
@@ -154,7 +168,6 @@ query_class <-
 #'
 #' mosaic_portal_filter("Campaign")
 mosaic_portal_filter <- function(class) {
-
   #find the class IRI
   mosaic <- read_ontology("mosaic")
 
@@ -171,7 +184,7 @@ mosaic_portal_filter <- function(class) {
    SELECT ?iri ?label
    WHERE {
      ?iri rdf:type <",
-     df_uri$Concept[1],
+      df_uri$Concept[1],
       "> .
      ?iri rdfs:label ?label .
    }"
@@ -182,7 +195,6 @@ mosaic_portal_filter <- function(class) {
 
   #for method/devices, filter the list based on existing annotations
   if (df_uri$Concept[1] == "https://purl.dataone.org/odo/MOSAIC_00000036") {
-
     cn <- dataone::CNode('PROD')
     adc <- dataone::getMNode(cn, 'urn:node:ARCTIC')
 

R/ontology.R

@@ -1,4 +1,6 @@
 
+
+
 #' Get an owl file from github
 #'
 #' @param ontology_name the name of the onotology to read; one of mosaic or ecso
@@ -11,12 +13,12 @@
 #' read_ontology("ecso")
 read_ontology <- function(ontology_name) {
   # get the owl file from github
-  if(ontology_name == "mosaic"){
+  if (ontology_name == "mosaic") {
     mosaic_url <-
       "https://raw.githubusercontent.com/DataONEorg/sem-prov-ontologies/main/MOSAiC/MOSAiC.owl"
     mosaic <- rdflib::rdf_parse(pins::pin(mosaic_url),
                                 format = "rdfxml")
-  } else if(ontology_name == "ecso"){
+  } else if (ontology_name == "ecso") {
     mosaic_url <-
       "https://raw.githubusercontent.com/DataONEorg/sem-prov-ontologies/ECSO8-add_non-carbon_measurements/observation/ECSO8.owl"
     mosaic <- rdflib::rdf_parse(pins::pin(mosaic_url),
@@ -39,7 +41,7 @@ read_ontology <- function(ontology_name) {
 #'
 #' mosaic <- read_ontology("mosaic")
 #' get_ontology_concepts(mosaic)
-get_ontology_concepts <- function(ontology){
+get_ontology_concepts <- function(ontology) {
   #find the class IRI
   query_class <-
     'PREFIX rdfs: <http://www.w3.org/2000/01/rdf-schema#>
@@ -64,12 +66,11 @@ get_ontology_concepts <- function(ontology){
 #' @export
 #'
 #' @examples eml_ecso_annotation("latitude coordinate")
-eml_ecso_annotation <- function(valueLabel){
-
+eml_ecso_annotation <- function(valueLabel) {
   ecso <- read_ontology("ecso")
 
   query <-
-      "PREFIX rdf: <http://www.w3.org/1999/02/22-rdf-syntax-ns#>
+    "PREFIX rdf: <http://www.w3.org/1999/02/22-rdf-syntax-ns#>
    PREFIX rdfs: <http://www.w3.org/2000/01/rdf-schema#>
 
    SELECT ?iri ?label
@@ -82,7 +83,19 @@ eml_ecso_annotation <- function(valueLabel){
 
   stopifnot(valueLabel %in% df$label)
 
-  annotations <- dplyr::filter(df, label == valueLabel)
+  annotations <-
+    dplyr::filter(df,
+                  stringr::str_to_lower(label) == stringr::str_to_lower(valueLabel))
+
+  if (nrow(annotations) > 1) {
+    warning(
+      paste0(
+        "More than one annotation found for ",
+        valueLabel,
+        ". Please check the ontology on which one would be more appropriate."
+      )
+    )
+  }
 
   list(
     propertyURI = list(label = "contains measurements of type",

tests/testthat/test_eml.R

@@ -298,8 +298,9 @@ test_that('eml_nsf_to_project fails gracefully', {
 test_that('eml_nsf_to_project parses two-word last names correctly', {
   proj <- eml_nsf_to_project("1822406", eml_version = "2.2")
 
-  expect_equal(proj$personnel[[1]]$individualName$givenName, "Maria")
-  expect_equal(proj$personnel[[1]]$individualName$surName, "Val Martin")
+  expect_true("Maria" %in% eml_get_simple(proj$personnel, "givenName"))
+  expect_true("Val Martin" %in% eml_get_simple(proj$personnel, "surName"))
+
 })
 
 test_that('Data object physical created for an EML', {

tests/testthat/test_mosaic.R

@@ -42,8 +42,56 @@ test_that("multiple campaigns work", {
   expect_equal(length(annotations), 4)
 })
 
-test_that("warns users if it isn't a PS attribute", {
-  expect_warning(mosaic_annotate_dataset("AF-MOSAiC-1"))
+test_that("multiple campaigns with different basis work", {
+  annotations <- mosaic_annotate_dataset(c("PS122/2", "AF-MOSAiC-1"))
+
+  example_annotation <- list(
+    list(
+      propertyURI = list(label = "hasBasis",
+                         propertyURI = "https://purl.dataone.org/odo/MOSAIC_00000034"),
+      valueURI = list(label = "Akademik Fedorov",
+                      valueURI = "https://purl.dataone.org/odo/MOSAIC_00000038")
+    ),
+    #Basis
+    list(
+      propertyURI = list(label = "hasBasis",
+                         propertyURI = "https://purl.dataone.org/odo/MOSAIC_00000034"),
+      valueURI = list(label = "Polarstern",
+                      valueURI = "https://purl.dataone.org/odo/MOSAIC_00000030")
+    ),
+    #Project
+    list(
+      propertyURI = list(label = "hasProjectLabel",
+                         propertyURI = "https://purl.dataone.org/odo/MOSAIC_00000025"),
+      valueURI = list(label = "MOSAiC20192020",
+                      valueURI = "https://purl.dataone.org/odo/MOSAIC_00000023")
+    ),
+    #Campaign
+    list(
+      propertyURI = list(label = "isPartOfCampaign",
+                         propertyURI = "https://purl.dataone.org/odo/MOSAIC_00000032"),
+      valueURI = list(label = "AF-MOSAiC-1",
+                      valueURI = "https://purl.dataone.org/odo/MOSAIC_00000020")
+    ),
+    list(
+      propertyURI = list(label = "isPartOfCampaign",
+                         propertyURI = "https://purl.dataone.org/odo/MOSAIC_00000032"),
+      valueURI = list(label = "PS122/2",
+                      valueURI = "https://purl.dataone.org/odo/MOSAIC_00000018")
+    )
+  )
+
+  expect_equal(length(annotations), 5)
+
+  expect_equal(
+    eml_get_simple(example_annotation, "label"),
+    eml_get_simple(annotations, "label")
+  )
+
+  expect_equal(
+    eml_get_simple(example_annotation, "propertyURI"),
+    eml_get_simple(annotations, "propertyURI")
+  )
 })
 
 test_that("mosaic attribute level annotations work", {

tests/testthat/test_ontology.R

@@ -18,3 +18,11 @@ test_that("fails if the annotation does not exist in ECSO", {
   expect_error(eml_ecso_annotation("Annotation does not exist"))
 
 })
+
+test_that("produces a warning if there are more than one annotation found", {
+
+  expect_warning(eml_ecso_annotation("thickness"))
+  expect_warning(eml_ecso_annotation("Depth"))
+
+})
+