ISA DeepData

Extracting occurrence data

Let’s first create a new ID column, this will be used later to link together the measurements and occurrences, and to select records by dataset. We cannot use occurrenceID here because these are not unique within the dataset.

library(uuid)

records$id <- UUIDgenerate(use.time = NA, n = nrow(records))
stopifnot(length(unique(records$id)) == nrow(records))

Now we can select and process the columns that will go into the occurrence table.

extract_occurrences <- function(df) {
    df %>%
      select("id", "dataset_id", "Occurrence", "Event", "Location", "Identification", "Record-level", "Taxon") %>%
      jsonlite::flatten() %>%
      rename_all(~str_replace(., ".*\\.", "")) %>%
      as_tibble()
}

occ <- extract_occurrences(records)

Initial cleanup of occurrence data

First clean up any escaped newlines, empty strings, and placeholder values. Also fix basisOfRecord and convert coordinates to numeric values:

library(stringr)

occ <- occ %>%
  mutate_all(~gsub("\\n", "", .)) %>%
  mutate_all(~na_if(., "")) %>%
  mutate(across(where(is.character), str_squish)) %>%
  mutate_all(~replace(., . %in% c("indet", "Not Reported", "indet."), NA)) %>%
  mutate(basisOfRecord = "HumanObservation") %>%
  mutate(
    decimalLongitude = as.numeric(decimalLongitude),
    decimalLatitude = as.numeric(decimalLatitude)
  )

Let’s check for coordinates issues:

robis::map_ggplot(occ)

Let’s take a look at scientificName and scientificNameID.

occ %>%
  group_by(scientificName) %>%
  summarize(records = n()) %>%
  arrange(desc(records)) %>%
  rmarkdown::paged_table()

occ %>%
  group_by(scientificNameID) %>%
  summarize(records = n()) %>%
  arrange(desc(records)) %>%
  rmarkdown::paged_table()

So at least in the current version at the time of writing (June 2021) there are some quality issues for scientificName.

Fixing taxonomy

Let’s try to clean up the scientific names before we do taxon matching with WoRMS. Here I’m using the gni_parse() function from the taxize package, which connects to the GNI name parser. If a name cannot be parsed, I’m keeping the original.

The first step is to create a list of all distinct names in the taxonomy columns.

taxonomy <- occ %>%
  select(phylum, class, order, family, genus, scientificName)
names <- na.omit(unique(unlist(taxonomy)))

Then pass through the name parser:

library(taxize)

clean_name <- function(name) {
  parsed <- tryCatch({
    res <- gni_parse(name)
    stopifnot(nrow(res) == 1)
    return(res$canonical[1])
  },
  error = function(cond){
    return(name)
  })
}

names_clean <- sapply(names, clean_name)  

Now use the cleaned names for taxon matching:

library(worrms)

match_name <- function(name) {
  lsid <- tryCatch({
    res <- wm_records_names(name)
    matches <- res[[1]] %>%
      filter(match_type == "exact" | match_type == "exact_genus")
    if (nrow(matches) > 1) {
      message(paste0("Multiple exact matches for ", name))
    }
    return(matches$lsid[1])
  }, error = function(cond) {
    return(NA)
  })
}

lsids <- sapply(names_clean, match_name)

Now we need to find the lowest taxonomic level at which we find a name. Note that this will result in records with less taxonomic resolution than intended. Ideally we would only match on scientificName. First translate the taxonomy columns to LSIDs:

taxonomy_clean <- taxonomy %>%
  mutate_all(~names_clean[.]) %>%
  mutate_all(~lsids[.])

taxonomy_clean

## # A tibble: 132,928 × 6
##    phylum                                class order family genus scientificName
##    <chr>                                 <chr> <chr> <chr>  <chr> <chr>         
##  1 urn:lsid:marinespecies.org:taxname:2… <NA>  <NA>  <NA>   <NA>  urn:lsid:mari…
##  2 urn:lsid:marinespecies.org:taxname:8… urn:… <NA>  <NA>   <NA>  <NA>          
##  3 urn:lsid:marinespecies.org:taxname:8… urn:… <NA>  <NA>   <NA>  urn:lsid:mari…
##  4 urn:lsid:marinespecies.org:taxname:8… urn:… <NA>  <NA>   <NA>  <NA>          
##  5 urn:lsid:marinespecies.org:taxname:8… urn:… <NA>  <NA>   <NA>  urn:lsid:mari…
##  6 urn:lsid:marinespecies.org:taxname:8… urn:… <NA>  <NA>   <NA>  urn:lsid:mari…
##  7 urn:lsid:marinespecies.org:taxname:8… urn:… <NA>  <NA>   <NA>  <NA>          
##  8 urn:lsid:marinespecies.org:taxname:8… urn:… <NA>  <NA>   <NA>  urn:lsid:mari…
##  9 urn:lsid:marinespecies.org:taxname:8… urn:… <NA>  <NA>   <NA>  urn:lsid:mari…
## 10 urn:lsid:marinespecies.org:taxname:8… urn:… <NA>  <NA>   <NA>  <NA>          
## # ℹ 132,918 more rows

The find the most specific one for each row:

taxonomy_clean <- taxonomy_clean %>%
  mutate(best = coalesce(scientificName, genus, family, order, class))

I’ll use the resulting LSIDs to replace the provided scientificNameIDs.

occ$scientificNameID <- taxonomy_clean$best

Let’s take another look at the top scientificName and scientificNameID after mathing:

occ %>%
  group_by(scientificName, scientificNameID) %>%
  summarize(records = n()) %>%
  arrange(desc(records)) %>%
  head(30) %>%
  knitr::kable()

Extracting MeasurementOrFact data

extract_mof <- function(df) {
    df %>%
      select("id", "dataset_id", "MeasurementOrFact") %>%
      jsonlite::flatten() %>%
      rename_all(~str_replace(., ".*\\.", "")) %>%
      mutate(across(where(is.character), str_squish)) %>%
      mutate_all(~na_if(., "")) %>%
      filter(!is.na(measurementType) & !is.na(measurementValue)) %>%
      as_tibble()
}

mof <- extract_mof(records)
mof

## # A tibble: 14,360 × 6
##    id                  dataset_id measurementID measurementType measurementValue
##    <chr>               <chr>      <chr>         <chr>           <chr>           
##  1 7085c2c3-e5a9-4118… bgrpmn120… BD12421641988 Relative abund… 1.8             
##  2 107d43f2-227e-45aa… bgrpmn120… BD12761642022 Relative abund… 0.72            
##  3 ccba49e6-0746-4f88… bgrpmn120… BD12771642023 Relative abund… 3.14            
##  4 c35699df-1c7f-4c79… bgrpmn120… BD12781642024 Relative abund… 0.72            
##  5 5d94738f-8c6b-445a… bgrpmn120… BD12791642025 Relative abund… 0.45            
##  6 0e859e7d-2618-4164… bgrpmn120… BD12801642026 Relative abund… 0.18            
##  7 788eb9b6-4b47-4020… bgrpmn120… BD12811642027 Relative abund… 13.66           
##  8 4db4b13a-cd63-443a… bgrpmn120… BD12821642028 Relative abund… 0.09            
##  9 9d7fb500-08f9-431e… bgrpmn120… BD12831642029 Relative abund… 5.12            
## 10 44aa97a6-e7aa-4810… bgrpmn120… BD12841642030 Relative abund… 31.81           
## # ℹ 14,350 more rows
## # ℹ 1 more variable: measurementUnit <chr>

A number of records appear to have empty values. To demonstrate this, let’s take a look at the most common combinations of measurementType and measurementValue:

mof %>%
  group_by(measurementType, measurementValue) %>%
  summarize(records = n()) %>%
  arrange(desc(records)) %>%
  head(10) %>%
  knitr::kable()

Generating EML

For demonstration purposes, I’m working with the dataset pertaining to the first record here. The EML template is read from templates/eml.xml:

library(readr)
library(glue)

generate_eml <- function(df) {
  eml <- read_file("templates/eml.xml")
  metadata <- df$Metadata[1,]

  firstname <- strsplit(metadata$Creator$name, " ")[[1]][1]
  lastname <- strsplit(metadata$Creator$name, " ")[[1]][2]
  organization <- metadata$Creator$organisation
  email <- metadata$Creator$email
  position <- metadata$Creator$position

  creator_firstname <- ""
  creator_lastname <- ""
  creator_organization <- metadata$Contact$organisation
  creator_email <- ""
  creator_position <- ""

  abstract <- metadata$abstract
  title <- metadata$title
  citation <- metadata$citation
  packageid <- "https://datasets.obis.org/deepdata"
  pubdate <- format(Sys.time(), "%Y-%m-%d")
  datestamp <- format(Sys.time(), "%Y-%m-%dT%H:%M:%S%z")
  glue(eml)
}

generate_eml(records)

## <eml:eml xmlns:eml="eml://ecoinformatics.org/eml-2.1.1"
##   xmlns:dc="http://purl.org/dc/terms/"
##   xmlns:xsi="http://www.w3.org/2001/XMLSchema-instance"
##   xsi:schemaLocation="eml://ecoinformatics.org/eml-2.1.1 http://rs.gbif.org/schema/eml-gbif-profile/1.1/eml.xsd"
##   packageId="https://datasets.obis.org/deepdata" system="http://gbif.org" scope="system"
##   xml:lang="eng">
## 
## <dataset>
##   <title xml:lang="eng">BGRPMN12017 Biodiveristy</title>
##   <pubDate>2023-06-14</pubDate>
##   <language>eng</language>
##   <abstract>
##     <para>Sampling data captured in Oceanic Exploration Research Based on geochemical and physical data we identified differences in the polymetallic nodule facies within the eastern German license area. Nodules in Prospective Areas # 1 are generally larger and show significantly higher contents of Ni and Cu as compared to the nodules in Prospective Area #2 which are smaller and are characterised by higher contents of Co. Furthermore, our study shows that sediment, which mainly consists of Si and Al oxides, contributes 13 % to the dry weight of the nodules on average. The method we used is quantitative and can thus be used for habitat mapping and be related to biodiversity and other environmental parameters</para>
##   </abstract>
##   <keywordSet>
##     <keyword>Occurrence</keyword>
##     <keywordThesaurus>GBIF Dataset Type Vocabulary: http://rs.gbif.org/vocabulary/gbif/dataset_type.xml</keywordThesaurus>
##   </keywordSet>
##   <intellectualRights>
##     <para>This work is licensed under a <ulink url="http://creativecommons.org/licenses/by/4.0/legalcode"><citetitle>Creative Commons Attribution (CC-BY) 4.0 License</citetitle></ulink>.</para>
##   </intellectualRights>
##   <maintenance>
##     <description>
##       <para></para>
##     </description>
##     <maintenanceUpdateFrequency>unkown</maintenanceUpdateFrequency>
##   </maintenance>
##   <creator>
##     <individualName>
##     <givenName></givenName>
##     <surName></surName>
##     </individualName>
##     <organizationName>Federal Institute for Geosciences and Natural Resources of Germany</organizationName>
##     <positionName></positionName>
##     <electronicMailAddress></electronicMailAddress>
##   </creator>
##   <metadataProvider>
##     <individualName>
##     <givenName>Sheldon</givenName>
##     <surName>Carter</surName>
##     </individualName>
##     <organizationName>International Seabed Authority</organizationName>
##     <positionName>Database Manager</positionName>
##     <electronicMailAddress>scarter@isa.org.jm</electronicMailAddress>
##   </metadataProvider>
##   <contact>
##     <individualName>
##     <givenName>Sheldon</givenName>
##     <surName>Carter</surName>
##     </individualName>
##     <organizationName>International Seabed Authority</organizationName>
##     <positionName>Database Manager</positionName>
##     <electronicMailAddress>scarter@isa.org.jm</electronicMailAddress>
##   </contact>
## </dataset>
## <additionalMetadata>
## <metadata>
## <gbif>
##   <dateStamp>2023-06-14T12:43:17+0200</dateStamp>
##   <hierarchyLevel>dataset</hierarchyLevel>
##   <citation>Federal Institute for Geosciences and Natural Resources of Germany, (2017). BGRPMN12017 Biodiveristy. Available : DeepData, International Seabed Authority https://data.isa.org.jm/ Accessed: [YYYY-MM-DD].</citation>
## </gbif>
## </metadata>
## </additionalMetadata>
## </eml:eml>

Generating an archive descriptor file

The archive also needs to include a meta.xml file which describes the files in the archive and their relationships.

Let’s first get a list of terms including their qualName.

library(xml2)

get_terms <- function(url) {
  doc <- read_xml(url)
  terms <- doc %>%
    xml_ns_strip() %>%
    xml_find_all(".//property") %>% 
    map_df(function(x) {
      list(
        name = xml_attr(x, "name"),
        qual = xml_attr(x, "qualName")
      )
    })
}

occurrence_terms <- get_terms("https://rs.gbif.org/core/dwc_occurrence_2020-07-15.xml")
mof_terms <- get_terms("https://rs.gbif.org/extension/obis/extended_measurement_or_fact.xml")

Using these we can generate a list of terms to go into the meta.xml file for each table.

generate_meta <- function(occ, mof) {
  occurrence_fields <- tibble(name = names(occ)) %>%
    left_join(occurrence_terms, by = "name") %>%
    mutate(index = as.numeric(row.names(.)) - 1)
  
  occurrence_lines <- paste0("<field index=\"", occurrence_fields$index, "\" term=\"", occurrence_fields$qual, "\"/>")
  occurrence_lines[1] <- "<id index=\"0\" />"
  occurrence_lines <- paste0(occurrence_lines, collapse = "\n")

  mof_fields <- tibble(name = names(mof)) %>%
  left_join(mof_terms, by = "name") %>%
  mutate(index = as.numeric(row.names(.)) - 1)

  mof_lines <- paste0("<field index=\"", mof_fields$index, "\" term=\"", mof_fields$qual, "\"/>")
  mof_lines[1] <- "<coreid index=\"0\" />"
  mof_lines <- paste0(mof_lines, collapse = "\n")

  meta <- read_file("templates/meta.xml")
  glue(meta)
}

generate_meta(occ, mof)

## <archive xmlns="http://rs.tdwg.org/dwc/text/" metadata="eml.xml">
##   <core encoding="UTF-8" fieldsTerminatedBy="\t" linesTerminatedBy="\n" fieldsEnclosedBy="" ignoreHeaderLines="1" rowType="http://rs.tdwg.org/dwc/terms/Occurrence">
##     <files>
##       <location>occurrence.txt</location>
##     </files>
##     <id index="0" />
## <field index="1" term="NA"/>
## <field index="2" term="http://rs.tdwg.org/dwc/terms/occurrenceID"/>
## <field index="3" term="http://rs.tdwg.org/dwc/terms/catalogNumber"/>
## <field index="4" term="http://rs.tdwg.org/dwc/terms/individualCount"/>
## <field index="5" term="http://rs.tdwg.org/dwc/terms/organismQuantity"/>
## <field index="6" term="http://rs.tdwg.org/dwc/terms/organismQuantityType"/>
## <field index="7" term="http://rs.tdwg.org/dwc/terms/sex"/>
## <field index="8" term="http://rs.tdwg.org/dwc/terms/occurrenceStatus"/>
## <field index="9" term="http://rs.tdwg.org/dwc/terms/associatedSequences"/>
## <field index="10" term="http://rs.tdwg.org/dwc/terms/occurrenceRemarks"/>
## <field index="11" term="http://rs.tdwg.org/dwc/terms/eventID"/>
## <field index="12" term="http://rs.tdwg.org/dwc/terms/eventDate"/>
## <field index="13" term="http://rs.tdwg.org/dwc/terms/eventTime"/>
## <field index="14" term="http://rs.tdwg.org/dwc/terms/year"/>
## <field index="15" term="http://rs.tdwg.org/dwc/terms/month"/>
## <field index="16" term="http://rs.tdwg.org/dwc/terms/day"/>
## <field index="17" term="http://rs.tdwg.org/dwc/terms/habitat"/>
## <field index="18" term="http://rs.tdwg.org/dwc/terms/samplingProtocol"/>
## <field index="19" term="http://rs.tdwg.org/dwc/terms/eventRemarks"/>
## <field index="20" term="http://rs.tdwg.org/dwc/terms/locationID"/>
## <field index="21" term="http://rs.tdwg.org/dwc/terms/minimumDepthInMeters"/>
## <field index="22" term="http://rs.tdwg.org/dwc/terms/maximumDepthInMeters"/>
## <field index="23" term="http://rs.tdwg.org/dwc/terms/verbatimDepth"/>
## <field index="24" term="http://rs.tdwg.org/dwc/terms/decimalLatitude"/>
## <field index="25" term="http://rs.tdwg.org/dwc/terms/decimalLongitude"/>
## <field index="26" term="http://rs.tdwg.org/dwc/terms/verbatimCoordinateSystem"/>
## <field index="27" term="http://rs.tdwg.org/dwc/terms/verbatimSRS"/>
## <field index="28" term="http://rs.tdwg.org/dwc/terms/coordinateUncertaintyInMeters"/>
## <field index="29" term="http://rs.tdwg.org/dwc/terms/identificationID"/>
## <field index="30" term="http://rs.tdwg.org/dwc/terms/typeStatus"/>
## <field index="31" term="http://rs.tdwg.org/dwc/terms/dateIdentified"/>
## <field index="32" term="http://rs.tdwg.org/dwc/terms/identificationVerificationStatus"/>
## <field index="33" term="http://purl.org/dc/terms/type"/>
## <field index="34" term="http://purl.org/dc/terms/license"/>
## <field index="35" term="http://purl.org/dc/terms/rightsHolder"/>
## <field index="36" term="http://purl.org/dc/terms/accessRights"/>
## <field index="37" term="http://purl.org/dc/terms/bibliographicCitation"/>
## <field index="38" term="http://rs.tdwg.org/dwc/terms/institutionID"/>
## <field index="39" term="http://rs.tdwg.org/dwc/terms/basisOfRecord"/>
## <field index="40" term="http://rs.tdwg.org/dwc/terms/taxonID"/>
## <field index="41" term="http://rs.tdwg.org/dwc/terms/scientificName"/>
## <field index="42" term="http://rs.tdwg.org/dwc/terms/scientificNameID"/>
## <field index="43" term="http://rs.tdwg.org/dwc/terms/kingdom"/>
## <field index="44" term="http://rs.tdwg.org/dwc/terms/phylum"/>
## <field index="45" term="http://rs.tdwg.org/dwc/terms/class"/>
## <field index="46" term="http://rs.tdwg.org/dwc/terms/order"/>
## <field index="47" term="http://rs.tdwg.org/dwc/terms/family"/>
## <field index="48" term="http://rs.tdwg.org/dwc/terms/genus"/>
## <field index="49" term="http://rs.tdwg.org/dwc/terms/taxonRank"/>
## <field index="50" term="http://rs.tdwg.org/dwc/terms/taxonomicStatus"/>
## <field index="51" term="http://rs.tdwg.org/dwc/terms/taxonRemarks"/>
##   </core>
##   <extension encoding="UTF-8" fieldsTerminatedBy="\t" linesTerminatedBy="\n" fieldsEnclosedBy="" ignoreHeaderLines="1" rowType="http://rs.iobis.org/obis/terms/ExtendedMeasurementOrFact">
##     <files>
##       <location>extendedmeasurementorfact.txt</location>
##     </files>
##     <coreid index="0" />
## <field index="1" term="NA"/>
## <field index="2" term="http://rs.tdwg.org/dwc/terms/measurementID"/>
## <field index="3" term="http://rs.tdwg.org/dwc/terms/measurementType"/>
## <field index="4" term="http://rs.tdwg.org/dwc/terms/measurementValue"/>
## <field index="5" term="http://rs.tdwg.org/dwc/terms/measurementUnit"/>
##   </extension>
## </archive>

Bringing it all together

Now we can generate an archive for each dataset. While I’m generating datasets I’m also populating the RSS feed and creating dataset landing pages.

baseurl <- "https://datasets.obis.org/hosted/isa/"
item_template <- read_file("templates/rss_item.xml")
landing_template <- read_file("templates/index_dataset.html")
items <- list()
pubdate <- format(Sys.time(), "%a, %d %b %Y %H:%M:%S %z")

unlink("output", recursive = TRUE)
dir.create("output")

datasetids <- unique(records$dataset_id)

for (datasetid in datasetids) {
  
  dataset <- records %>%
    filter(dataset_id == datasetid) %>%
    head(1)

  dataset$Metadata$abstract <- dataset$Metadata$abstract %>%
    str_replace(., "&", "&amp;") %>%
    str_replace(., ">", "&gt;") %>%
    str_replace(., "<", "&lt;") %>%
    str_replace(., "'", "&apos;") %>%
    str_replace(., "\"", "&quot;")

  title <- dataset$Metadata$title
  abstract <- dataset$Metadata$abstract
  link <- paste0(baseurl, datasetid, "/index.html")
  dwca <- paste0(baseurl, datasetid, "/", datasetid, ".zip")

  # clear dataset directory
    
  unlink(paste0("output/", datasetid), recursive = TRUE)
  dir.create(paste0("output/", datasetid))

  # RSS feed items
  
  item <- glue(item_template)
  items[[datasetid]] <- item
  
  # dataset landing page
  
  landing <- glue(landing_template)
  writeLines(landing, paste0("output/", datasetid, "/index.html"))
  
  # archive  
  
  dataset_occ <- occ %>% filter(dataset_id == datasetid) 
  dataset_mof <- mof %>% filter(dataset_id == datasetid) 

  eml <- generate_eml(dataset)
  meta <- generate_meta(occ, mof)
  
  write.table(dataset_occ, file = paste0("output/", datasetid, "/occurrence.txt"), sep = "\t", row.names = FALSE, na = "", quote = FALSE)
  write.table(dataset_mof, file = paste0("output/", datasetid, "/extendedmeasurementorfact.txt"), sep = "\t", row.names = FALSE, na = "", quote = FALSE)
  writeLines(eml, paste0("output/", datasetid, "/eml.xml"))
  writeLines(meta, paste0("output/", datasetid, "/meta.xml"))
  
  files <- c("occurrence.txt", "extendedmeasurementorfact.txt", "eml.xml", "meta.xml")
  setwd(paste0("output/", datasetid))
  zip(glue("{datasetid}.zip"), files)
  for (f in files) {
    file.remove(f)
  }
  setwd("../..")

}

Generate RSS file

items <- paste0(items, collapse = "\n")
rss_template <- read_file("templates/rss.xml")

title <- "International Seabed Authority (ISA)"
description <- "International Seabed Authority (ISA)"
link <- paste0(baseurl, "index.html")

rss <- glue(rss_template)
writeLines(rss, "output/rss.xml")

Generate landing page

index_template <- read_file("templates/index.html")
content <- paste0(paste0("<li><a href=\"", datasetids, "/index.html\">", datasetids, "</a></li>"), collapse = "\n")
index <- glue(index_template)
writeLines(index, "output/index.html")

Uploading to S3

delete_object("hosted/isa/", bucket = "obis-datasets")
files <- list.files("output", full.names = TRUE, recursive = TRUE, include.dirs = FALSE)

for (file in files) {
  folder <- str_replace(dirname(file), "output", "hosted/isa")
  target <- str_replace(file, "output", "hosted/isa")
  message(target)
  put_object(file, object = target, bucket = "obis-datasets", acl = "public-read")
}