Fix filtering of QualityCurrentID column

R/import_bbs_data.R

@@ -33,7 +33,7 @@ ObsN <- RTENO <- Date <- TotalSpp  <- NULL # bind variable to avoid CMD CHK WARN
         fns.50stop[stringr::str_detect(tolower(fns.50stop), pattern = ".zip")] # to remove the dir that isnt a .zip
 
     fns.routes <- list.files(path = paste0(bbs_dir),
-                             pattern = "routes.zip",
+                             pattern = "outes.zip",
                              full.names = TRUE)
     fns.vehicle <- list.files(path = paste0(bbs_dir),
                               pattern = "ehicle",

R/import_species_list.R

@@ -8,9 +8,18 @@
 #' @export import_species_list
 import_species_list <- function(bbs_dir){
     fn <- list.files(bbs_dir, full.names=TRUE, pattern="SpeciesList")
-    species_list <- readr::read_fwf(fn, skip=c(9))## currently the best function for guessing the fixed widths...
+
+    # read first 50 lines to determine n linse to skip
+    species_list <- readr::read_fwf(fn, n_max = 50, show_col_types = FALSE)
+
+    # newest version has different n rows of text at the top so use line row to
+    # find start of table
+    ln_row <- stringr::str_which(species_list[[1]], "---")
+
+    species_list <- readr::read_fwf(fn, skip = ln_row - 2, show_col_types = FALSE)## currently the best function for guessing the fixed widths...
     ## unfortunately, need to manually assign row 1 as header and remove the "line" row
     # names=as.vector(c(species_list[1,]))
+
     temp <- lapply(species_list[1, ], as.character)
     species_list <- species_list[-c(1:2),]
 
@@ -19,7 +28,11 @@ import_species_list <- function(bbs_dir){
     species_list$AOU <- as.integer(as.character(species_list$AOU))
 
     ## Join this species list with the package data list
-    species_list <- dplyr::left_join(species_list, bbsAssistant::species_list)
+    species_list <- dplyr::left_join(species_list,
+                                     bbsAssistant::species_list %>% select(-Seq),
+                                     by = dplyr::join_by(AOU, English_Common_Name,
+                                                  Spanish_Common_Name, ORDER, Family,
+                                                  Genus, Species))
 
     return(species_list)
 }

R/munge_bbs_data.R

@@ -89,6 +89,9 @@ munge_bbs_data <-
       CountryNum <- RPID <-
       iso_a2 <- ObsFirstYearOnRTENO <- ObsFirstYearOnBBS  <- NULL
 
+    # Change name that matches column to avoid confusion
+    QualityCurrentIDIn <- QualityCurrentID
+
     # SPATIOTEMPORAL SUBSETTING -----------------------------------------------
     ## SPATIAL SUBSETTING OBSERVATIONS ---------------------------------------------------
     # grab region codes
@@ -141,7 +144,7 @@ munge_bbs_data <-
     ## the last code in this chunk (.remove.rtenos) should allow only one filter on either
     ### weather or vehicle_data to take place, but needs to be tested.
     myweather <-
-      bbs_list$weather %>% dplyr::filter(QualityCurrentID %in% QualityCurrentID &
+      bbs_list$weather %>% dplyr::filter(QualityCurrentID %in% QualityCurrentIDIn &
                                            RPID %in% rpid)
     mycars <- bbs_list$vehicle_data <- bbs_list$vehicle_data %>% dplyr::filter(RPID %in% rpid)
 

R/update_sb_items.R

@@ -0,0 +1,40 @@
+update_sb_items <- function(bbs_par_id = "52b1dfa8e4b0d9b325230cd9",
+                            res_par_id = "5ea835e082cefae35a1fada7"){
+  bbs_ch <- sbtools::item_list_children(bbs_par_id)
+
+  bbs_ch_hist <- sbtools::item_list_children(bbs_ch[[2]]$id)
+
+  res_ch <- sbtools::item_list_children(res_par_id)
+
+  make_df <- function(x){
+    df <- data.frame(sb_parent = x$parentId, sb_item = x$id,
+                     sb_title = x$title, sb_link = x$link$url)
+
+    df %>%
+      dplyr::mutate(
+        release_year = stringr::str_extract(sb_title, "(\\d\\d\\d\\d.*) Release", group = 1),
+        year_start = stringr::str_extract(sb_title, "(\\d\\d\\d\\d).?-.?\\d\\d\\d\\d", group = 1),
+        year_end = stringr::str_extract(sb_title, "\\d\\d\\d\\d.?-.?(\\d\\d\\d\\d)", group = 1),
+        data_type = ifelse(stringr::str_detect(sb_title, "esults"), "results", "observations"),
+        legacy_format = ifelse(stringr::str_detect(sb_title, "legacy"), "y", "n")
+      )
+  }
+
+  lst_items <- c(list(bbs_ch[[1]]), bbs_ch_hist, res_ch)
+
+  new_sb_items <- lapply(lst_items, make_df) %>% dplyr::bind_rows()
+
+  if(is.null(sb_items)){
+    sb_items <- data.frame(sb_item = letters[1:10])
+  }
+
+  add_rows <- dplyr::anti_join(new_sb_items, sb_items, by = "sb_item")
+
+  if(nrow(add_rows) > 0){
+    message("returning sb_items with", nrow(add_rows), " new rows")
+
+   return(new_sb_items)
+  } else {
+    return(sb_items)
+  }
+}