Merge pull request #11 from dfo-mar-odis/opendata-parsing

Opendata parsing and RR objects

.gitignore

@@ -27,6 +27,8 @@ renv/
 tests/temp/*
 tests/*.RData
 !tests/temp/.gitkeep
+dataprocessing/temp/*
+!dataprocessing/temp/.gitkeep
 # History files
 .Rhistory
 .Rapp.history

app/R/dataFunctions.R

@@ -0,0 +1,61 @@
+
+copy_rdata_files <- function() {
+
+  rDataDir <- "\\\\ent.dfo-mpo.ca\\ATLShares\\Science\\BIODataSvc\\IN\\MSP\\Data\\Rdata\\data"
+  rStrDir <- gsub("\\\\", "\\\\\\\\", rDataDir) # backslash escaping nonsense
+
+  localDataDir <- here::here("app/data")
+  localStrDir <- gsub("\\\\", "\\\\\\\\", localDataDir) # backslash escaping nonsense
+
+
+  remoteInfo <- file.info(list.files(rDataDir, recursive = TRUE, full.names = TRUE))
+  remoteInfo["filenames"] <- sub(rStrDir, "", rownames(remoteInfo))
+
+  localInfo <- file.info(list.files(localDataDir, recursive = TRUE, full.names = TRUE))
+  localInfo["filenames"] <- sub(localStrDir, "", rownames(localInfo))
+
+  missingList <- !(remoteInfo$filenames %in% localInfo$filenames) 
+  if (any(missingList)) {
+    missingFileList <- filter(remoteInfo, missingList)$filenames
+    missingFilePath <- rownames(filter(remoteInfo, remoteInfo$filename %in% missingFileList))
+    destList <- file.path(localDataDir, missingFileList)
+    copyResults <- file.copy(missingFilePath, destList, overwrite = TRUE)
+  }
+
+  allInfo <- merge(remoteInfo, localInfo, by="filenames")
+  updateList <- allInfo$mtime.x > allInfo$mtime.y
+  if (any(updateList)) {
+    updateFileList <- filter(allInfo, updateList)$filenames
+    updateFilePath <- rownames(filter(remoteInfo, remoteInfo$filename %in% updateFileList))
+    destList <- file.path(localDataDir, updateFileList)
+    copyResults <- file.copy(updateFilePath, destList, overwrite = TRUE)
+  }
+
+  return("Data files up to date :)")  
+
+}
+
+
+load_rdata <- function(rdataNames, regionStr, env=globalenv()){
+  regionDir <- here::here("app/data", regionStr)
+  lapply(rdataNames, find_and_load, regionDir = regionDir, env = env)
+}
+
+
+find_and_load <- function(rdataStr, regionDir, env=globalenv()){
+  fileName <- paste(rdataStr, ".RData", sep="")
+  fileList <- list.files(regionDir, fileName, recursive=TRUE, full.names=TRUE, include.dirs=FALSE)
+  if (length(fileList) == 1) {
+    load(fileList, envir = env)
+    return(TRUE)
+  } else if(length(fileList) == 0) {
+    errMessage <- paste("R data file", fileName, "not found in", regionDir, ".")
+    warning(errMessage)
+    return(NULL)
+  } else {
+    errMessage <- paste("Duplicates of R data file", fileName, "found in", regionDir, ".")
+    warning(errMessage)
+    return(NULL)
+  }
+}
+

app/R/plotFunctions.R

@@ -281,6 +281,11 @@ plot_cetaceans_4grid<-function(fin_whale_sf, harbour_porpoise_sf,
 
   land <- sf::st_crop(landLayer, bboxBuf)
   bound <- sf::st_crop(bounds_sf, bboxBuf)
+  fin_whale_sf <- sf::st_crop(fin_whale_sf, bboxBuf)
+  harbour_porpoise_sf <- sf::st_crop(harbour_porpoise_sf, bboxBuf)
+  humpback_whale_sf <- sf::st_crop(humpback_whale_sf, bboxBuf)
+  sei_whale_sf <- sf::st_crop(sei_whale_sf, bboxBuf)
+
 
   #Fin Whale
   finWhalePlot <- whale_ggplot(fin_whale_sf, bound, land, studyArea,

app/R/tableFunctions.R

@@ -56,7 +56,7 @@ rockweedStats<- function(rockweed_sf) {
 # 1. allSpeciesData: datatable of all species found within the studyArea
 # 2. sarData: datatable of only listed species found within the studyArea
 
-create_table_RV <- function(data_sf, sarTable, speciesTable) {
+create_table_RV <- function(data_sf, sarTable) {
 
   if (is.null(data_sf)) {
     return(list("allSpecies" = NULL, "sarData" = NULL))
@@ -66,19 +66,18 @@ create_table_RV <- function(data_sf, sarTable, speciesTable) {
   Samples_study_no <- dim(unique(data_sf[, c("geometry")]))[1]
   # calculate a table of all species caught and
   # the total number of individuals caught.
-  # Join to the species lookup table to get
-  # species names
   individualCounts <- aggregate(
     x = list(Individuals = data_sf$TOTNO),
-    by = list(CODE = data_sf$CODE),
+    by = list(CODE = data_sf$CODE, "Scientific Name" = data_sf$`Scientific Name`, 
+              "Common Name" = data_sf$`Common Name`),
     FUN = sum)
 
   recordCounts <- aggregate(
     x = list(Records = data_sf$CODE),
     by = list(CODE = data_sf$CODE),
     FUN = length)
+
   allSpeciesData <- merge(individualCounts, recordCounts, by = 'CODE')
-  allSpeciesData <- merge(allSpeciesData, speciesTable, by = 'CODE')
   # add a field for the number of samples
   allSpeciesData$Samples <- Samples_study_no
   # combine the number of species records with number of samples
@@ -298,20 +297,33 @@ sfcoords_as_cols <- function(data_sf, names = c("long","lat")) {
 # Outputs:
 # distTable: table used in the report
 #
-table_dist <- function(clippedSardist_sf) {
+table_dist <- function(clippedSardist_sf, lang) {
 
   if (is.null(clippedSardist_sf)) {
     return(NULL)
   }
+
+  if (lang == "EN") {
+    clippedSardist_sf <- dplyr::mutate(clippedSardist_sf, Common_Name_EN = str_replace(Common_Name_EN, "`", "'"))
+    distTable <- dplyr::select(clippedSardist_sf, Scientific_Name, Common_Name_EN,
+                               Population_EN, SARA_Status, Species_Link)
+    tableNames <-  c("Scientific Name", "Common Name", "Population", "SARA Status", "Species Link")
+  } else if(lang =="FR") {
+    clippedSardist_sf <- dplyr::mutate(clippedSardist_sf, Common_Name_FR = str_replace(Common_Name_FR, "`", "'"))
+    clippedSardist_sf <- dplyr::mutate(clippedSardist_sf, Population_FR = str_replace(Population_FR, "`", "'"))
+
+    distTable <- dplyr::select(clippedSardist_sf, Scientific_Name, Common_Name_FR,
+                               Population_FR, SARA_Status, Species_Link)
+    tableNames <-  c("Nom Scientific", "Nom Commun", "Population", "Statut LEP", "Lien d'espèce")
+  } else {
+    stop("Specify language choice (EN/FR)")
+  }
 
-
-  clippedSardist_sf$Common_Nam[clippedSardist_sf$Common_Nam == "Sowerby`s Beaked Whale"] <- "Sowerby's Beaked Whale"
-  distTable <- dplyr::select(clippedSardist_sf, Scientific, Common_Nam, Population, SARA_Statu, Species_Li)
   sf::st_geometry(distTable) <- NULL
   row.names(distTable) <- NULL
   distTable <- unique(distTable)
-  distTable$Scientific <- italicize_col(distTable$Scientific)
-  names(distTable) <- c("Scientific Name", "Common Name", "Population", "SARA Status", "Species Link")
+  distTable$Scientific_Name <- italicize_col(distTable$Scientific)
+  names(distTable) <- tableNames
 
   return(distTable)
 }
@@ -337,21 +349,32 @@ italicize_col <- function(tableCol) {
 # Outputs:
 # critTable: table used in the report
 #
-table_crit <- function(CCH_sf, LB_sf) {
+table_crit <- function(CCH_sf, LB_sf, lang) {
 
+  if (lang == "EN"){
+    critTableCols <- c("Common_Name_EN", "Population_EN", "Waterbody", "SARA_Status")
+    critTableNames <- c("Common Name", "Population", "Area", "SARA status")
+    leatherbackRow <- data.frame("Leatherback Sea Turtle", NA, paste(LB_sf$AreaName, collapse=', ' ), "Endangered" )
+  } else if (lang =="FR") {
+    critTableCols <- c("Common_Name_FR", "Population_FR", "Waterbody", "SARA_Status")
+    critTableNames <- c("Nom Commun", "Population", "Region", "Statut LEP")
+    leatherbackRow <- data.frame("Tortue Luth", NA, paste(LB_sf$AreaName, collapse=', ' ), "En voie de disparition" )
+  } else {
+    stop("Specify Critical Habitat Table language choice (EN/FR)")
+  }
+
   if (!is.null(CCH_sf)){
-    critTable <- dplyr::select(CCH_sf, c("Common_Nam", "Population", "Waterbody", "SARA_Statu"))
-    critTable$geometry <- NULL
-    names(critTable) <- c("Common Name", "Population", "Area", "SARA status")
+    critTable <- dplyr::select(CCH_sf, all_of(critTableCols))
+    critTable <- sf::st_drop_geometry(critTable)
+    names(critTable) <- critTableNames
   } else {
     # only set names after init to preserve spaces etc.
     critTable <- data.frame("a"=NA, "b"=NA, "c"=NA, "d"=NA)
-    names(critTable) <- c("Common Name", "Population", "Area", "SARA status")
+    names(critTable) <- critTableNames
   }
 
   if (!is.null(LB_sf)){
-    leatherbackRow <- data.frame("Leatherback Sea Turtle", NA, paste(LB_sf$AreaName, collapse=', ' ), "Endangered" )
-    names(leatherbackRow) <- names(critTable)
+    names(leatherbackRow) <- critTableNames
     critTable <- bind_rows(critTable, leatherbackRow)
   }
 
@@ -378,24 +401,22 @@ table_crit <- function(CCH_sf, LB_sf) {
 # Directly writes table
 #
 EBSA_report <- function(EBSA_sf, lang="EN") {
-
-  EBSAreport <-  if (lang=="EN" & !is.null(EBSA_sf)) {
-    c(paste("Report: ", EBSA_sf$Report),
-      paste("Report URL:", EBSA_sf$Report_URL),
-      paste("Location: ", EBSA_sf$Name),
-      paste("Bioregion: ", EBSA_sf$Bioregion)
-    )
+  EBSATable <- NULL
+  if (lang=="EN" & !is.null(EBSA_sf)) {
+    EBSATable <- st_drop_geometry(dplyr::select(EBSA_sf, c(Report, Report_URL,
+                                                           Name, Bioregion)))
+    EBSATable <- unique(EBSATable)
+    row.names(EBSATable) <- NULL
+    names(EBSATable) <- c("Report", "Report URL", "Location", "Bioreigon")
   } else if (lang=="FR" & !is.null(EBSA_sf)) {
-    c(paste("Report: ", EBSA_sf$Rapport),
-      paste("Report URL:", EBSA_sf$RapportURL),
-      paste("Location: ", EBSA_sf$Nom),
-      paste("Bioregion: ", EBSA_sf$Bioregion)
-    )
-  } else {
-    ""
+    EBSATable <- st_drop_geometry(dplyr::select(EBSA_sf, c(Rapport, RapportURL,
+                                                           Nom, Bioregion)))
+    EBSATable <- unique(EBSATable)
+    names(EBSATable) <- c("Report", "Report URL", "Location", "Bioreigon")
+    row.names(EBSATable) <- NULL
+
   }
-  uniqueEBSAreport <- unique(noquote(EBSAreport))
-  writeLines(uniqueEBSAreport, sep="\n\n")
+  return(EBSATable)
 }
 
 # ---------MPA_REPPRT-------
@@ -426,7 +447,7 @@ mpa_table <- function(mpa_sf, lang="EN") {
   mpaTable <- distinct(mpaTable)
   return(mpaTable)
 }
-  
+
 # ---------add_col_to_whale_summary-------
 # Adds a column with number of records to the cetacean summary table
 # Inputs:

app/R/textHelpers.R

@@ -1,10 +1,30 @@
-write_meta <- function(rr) {
-  outText <- c(
-    paste("Contact: ", rr$contact),
-    paste("Last retrieved on: ", rr$accessedOn),
-    paste("Quality Tier: ", rr$qualityTier),
-    paste("Security level: ", rr$securityLevel), 
-    paste("Data use constraints: ", rr$constraints, "  \n"))
+write_meta <- function(rr, lang) {
+  metadata <- rr$metadata
+  outText <- ""
+  if (lang == "EN"){
+    outText <- c(
+      paste("Contact:", metadata$contact),
+      ifelse("url" %in% names(metadata), paste("URL:", metadata$url$en), NA),
+      paste("Last retrieved on:", metadata$accessedOnStr$en),
+      ifelse("searchYears" %in% names(metadata), paste("Search Years:", metadata$searchYears), NA),
+      paste("Quality Tier:", metadata$qualityTier$en),
+      paste("Security level:", metadata$securityLevel$en), 
+      paste("Data use constraints:", metadata$constraints$en),
+      ifelse("reference" %in% names(metadata), paste("Reference:", metadata$reference$en), NA)
+    )
+  } else if (lang == "FR") {
+    outText <- c(
+      paste("Personne-ressource:", metadata$contact),
+      ifelse("url" %in% names(metadata), paste("LIEN:", metadata$url$fr), NA),
+      paste("Consulté le:", metadata$accessedOnStr$fr),
+      ifelse("searchYears" %in% names(metadata), paste("Année de recherche:", metadata$searchYears), NA),
+      paste("Niveau de qualité:", metadata$qualityTier$fr),
+      paste("Niveau de sécurité:", metadata$securityLevel$fr), 
+      paste("Contraintes d'usage:", metadata$constraints$fr),
+      ifelse("reference" %in% names(metadata), paste("Reference:", metadata$reference$fr), NA)
+    )
+  }
+  outText <- outText[!is.na(outText)]
   writeLines(noquote(outText), sep="  \n")
 }