code edits to match and retrieve only bold BCDM fields

code changes in external and helper functions to retrieve only core BCDM fields
boldsystems-central · Oct 2, 2024 · 597e7fd · 597e7fd
1 parent bf35e4d
commit 597e7fd
Show file tree

Hide file tree

Showing 6 changed files with 25 additions and 22 deletions.
diff --git a/DESCRIPTION b/DESCRIPTION
@@ -29,9 +29,10 @@ Imports:
     ggplot2(>= 3.3.2),
     httr(>= 1.4.2),
     jsonlite(>= 1.7),
+    maps(>= 3.3),
     methods,
     reshape2,
-    maps(>= 3.3),
+    rnaturalearth,
     sf(>= 0.9.4),
     skimr(>= 2.1.2),
     tidyr(>= 1.1.1),

diff --git a/NAMESPACE b/NAMESPACE
@@ -73,6 +73,7 @@ importFrom(httr,upload_file)
 importFrom(jsonlite,fromJSON)
 importFrom(maps,map)
 importFrom(reshape2,dcast)
+importFrom(rnaturalearth,ne_countries)
 importFrom(sf,st_as_sf)
 importFrom(sf,st_as_sfc)
 importFrom(sf,st_bbox)

diff --git a/R/external.bold.fetch.R b/R/external.bold.fetch.R
@@ -155,11 +155,7 @@ bold.fetch<-function(get_by,
              data.input = input_data,
              query_param = get_by)
 
-             json.df = json.df%>%
-               dplyr::select(-tidyr::starts_with('specimendetails'),
-                             -tidyr::starts_with('location.'))
-
-         },
+          },
 
 
          "dataset_codes" =,
@@ -182,15 +178,17 @@ bold.fetch<-function(get_by,
              json.df = fetch.bold.id(data.input = processids,
                                      query_param = "processid")
 
-             json.df = json.df%>%
-               dplyr::select(-tidyr::starts_with('specimendetails'),
-                             -tidyr::starts_with('location.'))
-           },
+             },
 
          # Default case for invalid input
          stop("Input params can only be processid, sampleid, dataset_codes, project_codes, or bin_uris")
   )
 
+
+  # Select only the core BCDM fields
+
+  json.df = json.df[,intersect(names(json.df),bold.fields.info()$field)]
+
  # a separate filter function is used to filter the retrieved data
 
   json.df = bold.connectr.filters(bold.df = json.df,

diff --git a/R/external.bold.fields.info.R b/R/external.bold.fields.info.R
@@ -32,6 +32,7 @@ bold.fields.info<-function (print.output=FALSE) {
   bold.fields.data= suppressMessages(data.table::fread("https://github.com/DNAdiversity/BCDM/raw/main/field_definitions.tsv",
                                                        sep = '\t',
                                                        quote = "",
+                                                       check.names = FALSE,
                                                        verbose = FALSE,
                                                        showProgress = FALSE,
                                                        data.table = FALSE,
@@ -41,13 +42,15 @@ bold.fields.info<-function (print.output=FALSE) {
                   dplyr::matches("definition",ignore.case=TRUE),
                   dplyr::matches("data_type",ignore.case=TRUE))%>%
     dplyr::mutate(R_field_types=dplyr::case_when(data_type=="string"~"character",
-                                          data_type %in% c("char","array") ~"character",
-                                          data_type=="float"~"numeric",
-                                          data_type=="number"~"numeric",
-                                          data_type=="integer"~"integer",
-                                          data_type=="string:date"~"Date"))%>%
-    dplyr::select(-dplyr::matches("data_type",ignore.case=TRUE))
-
+                                                 data_type %in% c("char","array") ~"character",
+                                                 data_type=="float"~"numeric",
+                                                 data_type=="number"~"numeric",
+                                                 data_type=="integer"~"integer",
+                                                 data_type=="string:date"~"Date"))%>%
+    dplyr::select(-dplyr::matches("data_type",ignore.case=TRUE))%>%
+    dplyr::mutate(field=case_when(field=='country/ocean'~'country.ocean',
+                                  field=='province/state'~'province.state',
+                                  TRUE~field))
 
 
   if(print.output==TRUE)

diff --git a/R/helper.POSTapi_download_w_json2df.R b/R/helper.POSTapi_download_w_json2df.R
@@ -62,7 +62,8 @@ fetch.data<-function(result)
   #4. Convert the cleaned list to data.frame. Records have differences in the information that is available and filled for the different fields. This would result in rows having varying number of elements. To ensure a consistency, 'fill' argument has a default TRUE value here so that all such empty cells will be converted to NA's
 
   suppressWarnings(json.df<-data.table::rbindlist(edited.json.w.multi.entries,
-                                      fill=TRUE)%>%
+                                      fill=TRUE,
+                                      use.names = TRUE)%>%
                      data.frame())
 
 

diff --git a/R/helper.gen.comm.mat.R b/R/helper.gen.comm.mat.R
@@ -41,6 +41,7 @@
 #' @importFrom ggplot2 geom_sf_text
 #' @importFrom ggplot2 labs
 #' @importFrom stats as.formula
+#' @importFrom rnaturalearth ne_countries
 #'
 #' @keywords internal
 #'
@@ -374,16 +375,14 @@ gen.comm.mat<-function(bold.df,
 
     {
 
-      overview_map <-sf::st_as_sf(maps::map('world',
-                                            plot = FALSE,
-                                            fill = TRUE))
+      overview_map <- rnaturalearth::ne_countries(scale = 110)
 
       overview_map<-st_transform(overview_map,crs = st_crs(grids_final))
 
       #centroids_for_mapping = suppressWarnings(st_centroid(grids_final))
 
       grid_plot=ggplot(data=overview_map) +
-        geom_sf(linewidth=0.3,
+        geom_sf(linewidth=0.1,
                 col='black',
                 fill='white') +
         geom_sf(data = grids_final,