R: Failure to skip request failed [500] errors in loop using tryCatch()-CodePudding

I have looked at a few different related questions:

Use tryCatch skip to next value of loop upon error?
How to use Trycatch to skip errors in data downloading in R (this one is probably the most similar to my question)

I want to loop through coordinates in a dataframe and use the discover_nhdplus_id() function from the USGS nhdplustools package to search for the nearest downhill stream and record that stream's ID number (COMID) in a matrix. If an error is encountered, I want the loop to record 'NA' and move on to the next coordinate.

Example dataframe (there are two pairs of coordinates that fail to return results here: 0,0 and -111.2395, 36.5396):

# Minimal example dataframe

y <- c(38.27691,
       38.440779,
       37.784306,
       0,
       36.5396,
       38.293296,
       36.5375
)
x <- c(-112.64105,
       -111.643221,
       -111.633194,
       0,
       -111.2395,
       -111.550817,
       -111.2371
)

test_df <- data.frame(x, y)

Ideally, the output would look like this:

[1] 1215201
[1] 4900445
[1] 3277825
[1] NA
[1] NA
[1] 944070011
[1] 3528735

However, when I implement tryCatch(), the loop still crashes when errors are encountered. These tend to be "Request failed [500]" errors. Here's my tryCatch() attempt:

library(nhdplusTools)

output <- matrix(NA, nrow=nrow(test_df), ncol=1)
colnames(output) <- c("COMID_raindrop")

for (i in 1:nrow(test_df)){
  
  latitude <- test_df$y[i]
  longitude <- test_df$x[i]
  
  start_point <- st_sfc(st_point(c(longitude, latitude)), crs = 4269)
  
  raindrop_trace <- tryCatch(
      {
        discover_nhdplus_id(start_point)
      },
      error = function(e) {
        NA
      }
    )
  
  output[i] <- raindrop_trace
  print(raindrop_trace)
  
}

[1] 1215201
[1] 4900445
[1] 3277825
No data returned for: https://labs.waterdata.usgs.gov/api/nldi/linked-data/comid/position?coords=POINT(0 0)FALSE
Request failed [500]. Retrying in 1.2 seconds...
Request failed [500]. Retrying in 1 seconds...
Error in: https://labs.waterdata.usgs.gov/api/nldi/linked-data/comid/NULL/
Error in output[i] <- raindrop_trace : replacement has length zero

In looking up information about this, I saw purrr::possibly recommended, but that returns a different error when I try to implement:

output <- matrix(NA, nrow=nrow(test_df), ncol=1)
colnames(output) <- c("COMID_raindrop")

for (i in 1:nrow(test_df)){
  
  latitude <- test_df$y[i]
  longitude <- test_df$x[i]
  
  start_point <- st_sfc(st_point(c(longitude, latitude)), crs = 4269)
  
  get_data <- discover_nhdplus_id(start_point)
  raindrop_trace <- purrr::possibly(get_data, otherwise = NA) 
  
  output[i] <- raindrop_trace
  print(raindrop_trace) 
  
}

Error in output[i] <- raindrop_trace : 
  incompatible types (from closure to logical) in subassignment type fix

This error I thought might be related to assigning 'NA' (a non-numeric value), but I get the same error when assigning otherwise = 0.

Any help is greatly appreciated.

CodePudding user response：

You need to add the NA with a return function to write it to your output.

EDIT:

You can just scan for messages and create an error based on them with withCallingHandlers. I added your problematic coordinates (comments) to test it.

library(nhdplusTools)
library(sf)
    
y <- c(38.27691,
       38.440779,
       37.784306,
       0,
       0,
       38.293296,
       36.5375,
       36.5396)

x <- c(-112.64105,
       -111.643221,
       -111.633194,
       0,
       0,
       -111.550817,
       -111.2371,
       -111.2395)

test_df <- data.frame(x, y)
test_df <- st_as_sf(x = test_df, coords = c("x", "y"), crs = 4269)

output <- matrix(NA, nrow=nrow(test_df), ncol=1)
colnames(output) <- c("COMID_raindrop")

for (i in seq_along(test_df[[1]])){
  start_point <- test_df[i,]
  
  raindrop_trace <- tryCatch(
    {
      withCallingHandlers(discover_nhdplus_id(point = start_point), message = function(c) if (inherits(c, "message")){stop("")})
      discover_nhdplus_id(point = start_point)
    },
    error = function(e) {
      return(NA)
    }
  )
  output[i] <- raindrop_trace
  print(raindrop_trace)
}

[1] 1215201
[1] 4900445
[1] 3277825
[1] NA
[1] NA
[1] 944070011
[1] 3528735
[1] NA