try catch

worldbank · Nov 26, 2024 · 7b6617d · 7b6617d
1 parent e939bd3
commit 7b6617d
Show file tree

Hide file tree

Showing 7 changed files with 141 additions and 123 deletions.
diff --git a/.github/workflows/R-CMD-check.yaml b/.github/workflows/R-CMD-check.yaml
@@ -4,9 +4,10 @@ on:
   push:
     branches: [main, master]
   pull_request:
-    branches: [main, master]
 
-name: R-CMD-check
+name: R-CMD-check.yaml
+
+permissions: read-all
 
 jobs:
   R-CMD-check:
@@ -29,7 +30,7 @@ jobs:
       R_KEEP_PKG_SOURCE: yes
 
     steps:
-      - uses: actions/checkout@v3
+      - uses: actions/checkout@v4
 
       - uses: r-lib/actions/setup-pandoc@v2
 
@@ -47,3 +48,4 @@ jobs:
       - uses: r-lib/actions/check-r-package@v2
         with:
           upload-snapshots: true
+          build_args: 'c("--no-manual","--compact-vignettes=gs+qpdf")'
diff --git a/R/blackmarbler.R b/R/blackmarbler.R
@@ -760,131 +760,131 @@ bm_extract <- function(roi_sf,
     # Download data --------------------------------------------------------------
     r_list <- lapply(date, function(date_i){
 
-      #out <- tryCatch(
-      #  {
-
-      #### Make name for raster based on date
-      date_name_i <- define_date_name(date_i, product_id)
-
-      #### If save to file
-      if(output_location_type == "file"){
-
-        out_name_end <- paste0("_", date_name_i, ".Rds")
-        out_name <- paste0(out_name_begin, out_name_end)
-        out_path <- file.path(file_dir, out_name)
-
-        make_raster <- TRUE
-        if(file_skip_if_exists & file.exists(out_path)) make_raster <- FALSE
-
-        if(make_raster){
+      out <- tryCatch(
+        {
 
-          #### Make raster
-          r <- bm_raster_i(roi_sf = roi_sf,
-                           product_id = product_id,
-                           date = date_i,
-                           bearer = bearer,
-                           variable = variable,
-                           quality_flag_rm = quality_flag_rm,
-                           check_all_tiles_exist = check_all_tiles_exist,
-                           h5_dir = h5_dir,
-                           quiet = quiet,
-                           temp_dir = temp_dir)
-          names(r) <- date_name_i
+          #### Make name for raster based on date
+          date_name_i <- define_date_name(date_i, product_id)
 
-          #### Extract
-          r_agg <- exact_extract(x = r, y = roi_sf, fun = aggregation_fun, 
-                                 progress = !quiet)
-          roi_df <- roi_sf
-          roi_df$geometry <- NULL
-
-          if(length(aggregation_fun) > 1){
-            names(r_agg) <- paste0("ntl_", names(r_agg))
-            r_agg <- bind_cols(r_agg, roi_df)
+          #### If save to file
+          if(output_location_type == "file"){
+
+            out_name_end <- paste0("_", date_name_i, ".Rds")
+            out_name <- paste0(out_name_begin, out_name_end)
+            out_path <- file.path(file_dir, out_name)
+
+            make_raster <- TRUE
+            if(file_skip_if_exists & file.exists(out_path)) make_raster <- FALSE
+
+            if(make_raster){
+
+              #### Make raster
+              r <- bm_raster_i(roi_sf = roi_sf,
+                               product_id = product_id,
+                               date = date_i,
+                               bearer = bearer,
+                               variable = variable,
+                               quality_flag_rm = quality_flag_rm,
+                               check_all_tiles_exist = check_all_tiles_exist,
+                               h5_dir = h5_dir,
+                               quiet = quiet,
+                               temp_dir = temp_dir)
+              names(r) <- date_name_i
+
+              #### Extract
+              r_agg <- exact_extract(x = r, y = roi_sf, fun = aggregation_fun, 
+                                     progress = !quiet)
+              roi_df <- roi_sf
+              roi_df$geometry <- NULL
+
+              if(length(aggregation_fun) > 1){
+                names(r_agg) <- paste0("ntl_", names(r_agg))
+                r_agg <- bind_cols(r_agg, roi_df)
+              } else{
+                roi_df[[paste0("ntl_", aggregation_fun)]] <- r_agg
+                r_agg <- roi_df
+              }
+
+              if(add_n_pixels){
+
+                r_n_obs <- exact_extract(r, roi_sf, function(values, coverage_fraction)
+                  sum(!is.na(values)),
+                  progress = !quiet)
+
+                r_n_obs_poss <- exact_extract(r, roi_sf, function(values, coverage_fraction)
+                  length(values),
+                  progress = !quiet)
+
+                r_agg$n_pixels           <- r_n_obs_poss
+                r_agg$n_non_na_pixels    <- r_n_obs
+                r_agg$prop_non_na_pixels <- r_agg$n_non_na_pixels / r_agg$n_pixels 
+              }
+
+              r_agg$date <- date_i
+
+              #### Export
+              saveRDS(r_agg, out_path)
+
+            } else{
+              warning(paste0('"', out_path, '" already exists; skipping.\n'))
+            }
+
+            r_out <- NULL # Saving as file, so output from function should be NULL
+
           } else{
-            roi_df[[paste0("ntl_", aggregation_fun)]] <- r_agg
-            r_agg <- roi_df
-          }
-
-          if(add_n_pixels){
+            r_out <- bm_raster_i(roi_sf = roi_sf,
+                                 product_id = product_id,
+                                 date = date_i,
+                                 bearer = bearer,
+                                 variable = variable,
+                                 quality_flag_rm = quality_flag_rm,
+                                 check_all_tiles_exist = check_all_tiles_exist,
+                                 h5_dir = h5_dir,
+                                 quiet = quiet,
+                                 temp_dir = temp_dir)
+            names(r_out) <- date_name_i
+
+            if(add_n_pixels){
+
+              r_n_obs <- exact_extract(r_out, roi_sf, function(values, coverage_fraction)
+                sum(!is.na(values)),
+                progress = !quiet)
+
+              r_n_obs_poss <- exact_extract(r_out, roi_sf, function(values, coverage_fraction)
+                length(values),
+                progress = !quiet)
+
+              roi_sf$n_pixels           <- r_n_obs_poss
+              roi_sf$n_non_na_pixels    <- r_n_obs
+              roi_sf$prop_non_na_pixels <- roi_sf$n_non_na_pixels / roi_sf$n_pixels 
+            }
+
+            r_out <- exact_extract(x = r_out, y = roi_sf, fun = aggregation_fun,
+                                   progress = !quiet)
 
-            r_n_obs <- exact_extract(r, roi_sf, function(values, coverage_fraction)
-              sum(!is.na(values)),
-              progress = !quiet)
+            roi_df <- roi_sf
+            roi_df$geometry <- NULL
 
-            r_n_obs_poss <- exact_extract(r, roi_sf, function(values, coverage_fraction)
-              length(values),
-              progress = !quiet)
+            if(length(aggregation_fun) > 1){
+              names(r_out) <- paste0("ntl_", names(r_out))
+              r_out <- bind_cols(r_out, roi_df)
+            } else{
+
+              roi_df[[paste0("ntl_", aggregation_fun)]] <- r_out
+              r_out <- roi_df
+            }
 
-            r_agg$n_pixels           <- r_n_obs_poss
-            r_agg$n_non_na_pixels    <- r_n_obs
-            r_agg$prop_non_na_pixels <- r_agg$n_non_na_pixels / r_agg$n_pixels 
+            r_out$date <- date_i
           }
 
-          r_agg$date <- date_i
+          return(r_out)
 
-          #### Export
-          saveRDS(r_agg, out_path)
-
-        } else{
-          warning(paste0('"', out_path, '" already exists; skipping.\n'))
+          # HERE
+        },
+        error=function(e) {
+          return(NULL)
         }
-
-        r_out <- NULL # Saving as file, so output from function should be NULL
-
-      } else{
-        r_out <- bm_raster_i(roi_sf = roi_sf,
-                             product_id = product_id,
-                             date = date_i,
-                             bearer = bearer,
-                             variable = variable,
-                             quality_flag_rm = quality_flag_rm,
-                             check_all_tiles_exist = check_all_tiles_exist,
-                             h5_dir = h5_dir,
-                             quiet = quiet,
-                             temp_dir = temp_dir)
-        names(r_out) <- date_name_i
-
-        if(add_n_pixels){
-
-          r_n_obs <- exact_extract(r_out, roi_sf, function(values, coverage_fraction)
-            sum(!is.na(values)),
-            progress = !quiet)
-
-          r_n_obs_poss <- exact_extract(r_out, roi_sf, function(values, coverage_fraction)
-            length(values),
-            progress = !quiet)
-
-          roi_sf$n_pixels           <- r_n_obs_poss
-          roi_sf$n_non_na_pixels    <- r_n_obs
-          roi_sf$prop_non_na_pixels <- roi_sf$n_non_na_pixels / roi_sf$n_pixels 
-        }
-
-        r_out <- exact_extract(x = r_out, y = roi_sf, fun = aggregation_fun,
-                               progress = !quiet)
-
-        roi_df <- roi_sf
-        roi_df$geometry <- NULL
-
-        if(length(aggregation_fun) > 1){
-          names(r_out) <- paste0("ntl_", names(r_out))
-          r_out <- bind_cols(r_out, roi_df)
-        } else{
-
-          roi_df[[paste0("ntl_", aggregation_fun)]] <- r_out
-          r_out <- roi_df
-        }
-
-        r_out$date <- date_i
-      }
-
-      return(r_out)
-
-      ## HERE
-      #  },
-      #  error=function(e) {
-      #    return(NULL)
-      #  }
-      #)
+      )
 
     })
 

diff --git a/README.md b/README.md
@@ -7,7 +7,7 @@
 [![GitHub Repo stars](https://img.shields.io/github/stars/worldbank/blackmarbler)](https://github.com/worldbank/blackmarbler)
 [![activity](https://img.shields.io/github/commit-activity/m/worldbank/blackmarbler)](https://github.com/worldbank/blackmarbler/graphs/commit-activity)
 [![License: MIT](https://img.shields.io/badge/License-MIT-yellow.svg)](https://opensource.org/license/mit)
-
+[![R-CMD-check](https://github.com/worldbank/blackmarbler/actions/workflows/R-CMD-check.yaml/badge.svg)](https://github.com/worldbank/blackmarbler/actions/workflows/R-CMD-check.yaml)
 <!-- badges: end -->
 
 **BlackMarbleR** is a R package that provides a simple way to use nighttime lights data from NASA's Black Marble. [Black Marble](https://blackmarble.gsfc.nasa.gov) is a [NASA Earth Science Data Systems (ESDS)](https://www.earthdata.nasa.gov) project that provides a product suite of daily, monthly and yearly global [nighttime lights](https://www.earthdata.nasa.gov/topics/human-dimensions/nighttime-lights). This package automates the process of downloading all relevant tiles from the [NASA LAADS DAAC](https://ladsweb.modaps.eosdis.nasa.gov/) to cover a region of interest, converting and mosaicing the raw files (in HDF5 format) to georeferenced rasters.
@@ -336,6 +336,6 @@ If `output_location_type = "file"`, the following arguments can be used:
 
 For more information on NASA Black Marble, see:
 
-* [Academic paper](https://pdf.sciencedirectassets.com/271745/1-s2.0-S0034425718X00054/1-s2.0-S003442571830110X/am.pdf?X-Amz-Security-Token=IQoJb3JpZ2luX2VjEHEaCXVzLWVhc3QtMSJIMEYCIQDArjfr5uSMpM5mQ3cJsNon%2FoLp8Ja8Y9fMXzOKSRTPzwIhAOiZ1vPs4kAYZsWYZF%2BLDQnpqWROIr65WPpEx4AuIVfxKrMFCBkQBRoMMDU5MDAzNTQ2ODY1IgxhyDy7tYJXVUSG9VEqkAWtazYKcwJfrw5bEYNUT7kQyaPJeqsd3Ez33YZAXD9WQ7q8Grsa8xhgfTxwCoPe4fSkxY3juJejdDsEtaXCGWwI6ZOpPstQE29Nkf1fUKBcLPEC0v0Gp5EqPFqJv89HvSYRXEIioqky%2BhAlR0QoVcTsy95v%2BATl%2BY4xIsOpbiRg%2F7nCNx7BGFETK50lsmMUjFeIOVQ8MqBICtUvHbvBl5Xf0Q5cho4Kczji79oo0aTvF35jIl9W0DSuaPpn4Gl%2B2MjwO39Y%2Bt51c9bFe%2F09Ze2drSqzg5i1iT1%2FAPqCcwT4W4FEqg2juiFLOvzXkM404u7J7yFAOnwHi6zg0z97Et77Ucm%2FE6f4%2Fwz9u2A9m9i84d9g2IvLUn9QL22A4QvoFjr5Nc%2BUQTV7j7pyICduk0Bb9gR%2BQrKv%2FRBgaUbgxD8bxM7GLkH0QqBBNVqRctmAIh2x%2F6dEhfXDw08wpnt2sNgH65NvCFQKvQZslo65aZ%2F42qieqs2UvJWycgpAbz6ZczMHN8%2FwjAkQnBF15BZkC2AsW5Xs%2BtXc3%2Fn2rU6TIkGfituf%2B%2F6mtpN1J4migVO6zbV5v2eUFyl26xilNaHV9m0Fse9lD41oQ8Nd3OdrL1fgtGvEzNDjD9tX15B4vZaPqgttfZa0UfFB6pgN1hh4aca0WCwjOgYQzA2Zcaq9RFfeDFNimIqS%2FO78lGzrfQL02ZxfL1E3uOFhD4G4TLoSXU258ik6JUxgy5t91JTHqLL5WlRmp5Q2XdA6g3yj%2F1qnAzz%2FjSXNH8moYEo6vM5MKodUmfIyQos2QChiD65bv0OJi%2BaGM%2Fquenhrkzq4OCtgR7tKDS%2FIxu%2FgdjdzHqlJghx4h9MirQR%2FXacQsbZ0VZMF4DCHx5K6BjqwAe1jQA%2Bu5VqWcrWNf%2BdW%2FFYNxIIiThd22VDZwtwWmgw62g7FaUA%2Bfm7p9MQiXFgVKumiGWuUS6HjUwdpMHU5xZ2M4FW%2FTV8eaIi8jqUwxNyBDdwrMi%2FvlfODzC8xRppZKPflzolxf5doSsEZxcaBVGfmoaep0rK4fYVssKhc3uLbHXSpnxyZqntTv78MXsp1wglcdKj9AIji4RUWDVCyNQaaeXAG8XXF%2BxaY2q5fNyml&X-Amz-Algorithm=AWS4-HMAC-SHA256&X-Amz-Date=20241125T172622Z&X-Amz-SignedHeaders=host&X-Amz-Expires=300&X-Amz-Credential=ASIAQ3PHCVTYWHTYLA6J%2F20241125%2Fus-east-1%2Fs3%2Faws4_request&X-Amz-Signature=6703c42a66a14f6bd39b67e40a399f11da2e87467a341381b25853a27127de05&hash=859f116b3c45db6bb47bfc9cc540cc3176dce2b2017448034740575ee68d2ca5&host=68042c943591013ac2b2430a89b270f6af2c76d8dfd086a07176afe7c76c2c61&pii=S003442571830110X&tid=pdf-ac1c6031-531b-4e32-b9e2-9038901e496b&sid=e4ed55ea7138924ddf8b61e7e34b10874ac3gxrqa&type=client)
+* [Academic paper](https://doi.org/10.1016/j.rse.2018.03.017)
 * [Substack Post](https://www.spatialedge.co/p/not-all-nightlight-datasets-are-the)
 * [Webinar](https://appliedsciences.nasa.gov/get-involved/training/english/arset-introduction-nasas-black-marble-night-lights-data)
diff --git a/man/bm_extract.Rd b/man/bm_extract.Rd
diff --git a/man/bm_raster.Rd b/man/bm_raster.Rd
diff --git a/readme_figures/testing.R b/readme_figures/testing.R
@@ -1,5 +1,20 @@
 # Testing
 
+#### Basic
+library(blackmarbler)
+library(sf)
+bearer <- read.csv("~/Dropbox/bearer_bm.csv")$token
+
+roi_sf <- data.frame(lat = -1.943889, lon = 30.059444, id = 1) |>
+  st_as_sf(coords = c("lon", "lat"),
+           crs = 4326) |>
+  st_buffer(dist = 20000)
+
+r_20210205 <- bm_raster(roi_sf = roi_sf,
+                        product_id = "VNP46A3",
+                        date = "2021-02-05",
+                        bearer = bearer)
+
 library(readr)
 library(hdf5r)
 library(dplyr)

diff --git a/vignettes/assess-quality.Rmd b/vignettes/assess-quality.Rmd
@@ -64,7 +64,8 @@ bearer <- "BEARER-TOKEN-HERE"
 
 ```{r bearer, include = FALSE}
 #bearer <- read.csv("~/Desktop/bearer_bm.csv")$token
-bearer <- read.csv("https://www.dropbox.com/scl/fi/pipze9nvak5qo7pedvwb4/bearer_bm.csv?rlkey=bkpv62s657c5w9jbchpg2vvr7&dl=1")$token
+bearer <- read.csv("https://www.dropbox.com/scl/fi/u8ixf74zxqfkwn2trv2ty/bearer_bm.csv?rlkey=zbvco8rarlzedil9kw5ybkkou&st=23me404b&dl=1")$token
+#bearer <- Sys.getenv("BEARER_NASA_TOKEN")
 ```
 
 ```{r}