Fix filtering of QualityCurrentID column

.gitignore

@@ -24,5 +24,26 @@ data/readme.rtf
 
 
 # local download of the BBS dataset
-data-in/
-
+R/data-in/
+/data-in/
+data-raw/species_list.R 14-33-16-884.R
+data-raw/data-in/64ad9c3dd34e70357a292cee/50-StopData.zip
+data-raw/data-in/691cfb53d4be021d1d89b482/Weather.csv
+data-raw/data-in/691cfb53d4be021d1d89b482/VehicleData.csv
+data-raw/data-in/691cfb53d4be021d1d89b482/States.zip
+data-raw/data-in/691cfb53d4be021d1d89b482/SpeciesList.csv
+data-raw/data-in/691cfb53d4be021d1d89b482/RunType.pdf
+data-raw/data-in/691cfb53d4be021d1d89b482/Routes.csv
+data-raw/data-in/691cfb53d4be021d1d89b482/North American Breeding Bird Survey Dataset (1966-2024).xml
+data-raw/data-in/691cfb53d4be021d1d89b482/MigrantNonBreeder.zip
+data-raw/data-in/691cfb53d4be021d1d89b482/Completeness_Report_NABBS_Dataset_1966-2024.pdf
+data-raw/data-in/691cfb53d4be021d1d89b482/50-StopData.zip
+data-raw/data-in/64ad9c3dd34e70357a292cee/weather.csv
+data-raw/data-in/64ad9c3dd34e70357a292cee/VehicleData.csv
+data-raw/data-in/64ad9c3dd34e70357a292cee/States.zip
+data-raw/data-in/64ad9c3dd34e70357a292cee/SpeciesList.txt
+data-raw/data-in/64ad9c3dd34e70357a292cee/RunType.pdf
+data-raw/data-in/64ad9c3dd34e70357a292cee/routes.csv
+data-raw/data-in/64ad9c3dd34e70357a292cee/North American Breeding Bird Survey Dataset (1966-2022).xml
+data-raw/data-in/64ad9c3dd34e70357a292cee/MigrantNonBreeder.zip
+data-raw/data-in/64ad9c3dd34e70357a292cee/Completeness_Report_NABBS_Dataset_1966-2022.pdf

DESCRIPTION

@@ -15,9 +15,9 @@ Encoding: UTF-8
 URL: https://github.com/trashbirdecology/bbsAssistant/
 LazyData: true
 Roxygen: list(markdown = TRUE)
-RoxygenNote: 7.1.2
+RoxygenNote: 7.2.3
 Depends: 
-    R (>= 2.10)
+    R (>= 3.5)
 Imports: 
     lubridate,
     dplyr,

R/datasets.R

@@ -21,6 +21,7 @@
 #' A lookup table that is manually updated by the package maintainers.
 #'   The table can be used as a reference for identifying BBS data availability on USGS ScienceBase and is called internally when downloading datasets.
 #'
+#'
 #' \describe{
 #'   \item{sb_parent}{unique identifier associated with a ScienceBase parent item (often the project identifier).}
 #'   \item{sb_item}{ScienceBase unique identifier associated with each dataset release.}

R/grab_bbs_data.R

@@ -12,7 +12,7 @@ grab_bbs_data <- function(sb_id=NULL, bbs_dir=NULL, overwrite=FALSE){
 if(is.null(sb_id)){
   sb_items <- bbsAssistant::sb_items
     sb_id=sb_items[which.max(sb_items$release_year),]$sb_item
-    message("Argument `sb_id` not specified.\ Using the ScienceBase identifier (sb_id) associated with the ",
+    cat("Argument `sb_id` not specified.\ Using the ScienceBase identifier (sb_id) associated with the ",
             sb_items$release_year[sb_items$sb_item==sb_id],
             " version of the BBS dataset:\n")
   }
@@ -29,11 +29,9 @@ if(is.null(sb_id)){
 data.in.dir <- download_bbs_data(sb_id=sb_id, bbs_dir=bbs_dir, overwrite = overwrite)
 
 ## IMPORT
-cat("Attempting to decompress and import files from", data.in.dir,"\n")
+cat("Importing files to environment from", data.in.dir,"\n")
 bbs <- import_bbs_data(bbs_dir = data.in.dir, sb_id=sb_id)
 
-bbs$data.dir <- bbs_dir
-
 return(bbs)
 
 }

R/import_bbs_data.R

@@ -30,16 +30,16 @@ ObsN <- RTENO <- Date <- TotalSpp  <- NULL # bind variable to avoid CMD CHK WARN
                    exdir = tempdir()
                )$Name)
     fns.50stop <-
-        fns.50stop[stringr::str_detect(tolower(fns.50stop), pattern = ".zip")] # to remove the dir that isnt a .zip
+        fns.50stop[stringr::str_detect(tolower(fns.50stop), pattern = "csv")]
 
     fns.routes <- list.files(path = paste0(bbs_dir),
-                             pattern = "routes.zip",
+                             pattern = "outes",
                              full.names = TRUE)
     fns.vehicle <- list.files(path = paste0(bbs_dir),
                               pattern = "ehicle",
                               full.names = TRUE)
     fns.weather <- list.files(path = paste0(bbs_dir),
-                              pattern = "eather.zip",
+                              pattern = "eather",
                               full.names = TRUE)
 
 
@@ -55,13 +55,11 @@ ObsN <- RTENO <- Date <- TotalSpp  <- NULL # bind variable to avoid CMD CHK WARN
     )
 
     # Get observations and routes ---------------------------------------------
-    # observations <- sapply(fns, function(x) readr::read_csv(unzip(zipfile = x))) %>%
-    # can't figure out how to do this with apply so just looping... le sigh.
-
+    # would prefer this is an sapply instead of a for loop
     observations <- list()
+    cat("Getting observations")
     for (i in seq_along(fns.50stop)) {
       f <- fns.50stop[i]
-      # observations[[i]]  <- data.table::fread(f)
       observations[[i]]  <- readr::read_csv(f, col_types = col_types)
     }
     observations <- dplyr::bind_rows(observations)
@@ -70,14 +68,30 @@ ObsN <- RTENO <- Date <- TotalSpp  <- NULL # bind variable to avoid CMD CHK WARN
     citation <- sbtools::item_get_fields(sb_id, "citation")
 
     # Get species list --------------------------------------------------
-    species_list <- import_species_list(bbs_dir)
+    species_list <- import_species_list(bbs_dir, sb_id = sb_id)
 
     # Get route metadata -------------------------------------------------------
-    routes <-   suppressWarnings(readr::read_csv(fns.routes, col_types = col_types))
-    weather <-   suppressWarnings(readr::read_csv(fns.weather, col_types = col_types))
-    vehicle_data <-  suppressWarnings(readr::read_csv(unzip(zipfile = fns.vehicle, exdir = tempdir), col_types = col_types)) # keep this as unzip
-    # routes <-   suppressWarnings(readr::read_csv(unzip(zipfile = fns.routes, exdir = tempdir), col_types = col_types))
-    # weather <-  suppressWarnings(readr::read_csv(unzip(zipfile = fns.weather, exdir = tempdir), col_types = col_types))
+    ### suppressing warnings here -- scary, yes, but the parsing 'error' isn't an error, it is just correctly removing trailing whitespace from doubles
+    ### can call `vroom::problems(df)` do double check
+
+    # vehicle data
+    suppressWarnings(vehicle_data <- if (stringr::str_detect(fns.vehicle, ".zip")) {
+      message(paste0('unzipping '), fns.vehicle)
+      readr::read_csv(unzip(zipfile = fns.vehicle, exdir = tempdir), col_types = col_types)} else{
+        readr::read_csv(fns.vehicle, col_types = col_types)
+      })
+    # weather
+    suppressWarnings( weather <- if (stringr::str_detect(fns.weather, ".zip")) {
+      message(paste0('unzipping '), fns.weather)
+      readr::read_csv(unzip(zipfile = fns.weather, exdir = tempdir), col_types = col_types)} else{
+        readr::read_csv(fns.weather, col_types = col_types)
+      })
+    # routes
+    suppressWarnings(routes <- if (stringr::str_detect(fns.routes, ".zip")) {
+      message(paste0('unzipping '), fns.routes)
+      readr::read_csv(unzip(zipfile = fns.vehicle, exdir = tempdir), col_types = col_types)} else{
+        readr::read_csv(fns.routes, col_types = col_types)
+      })
 
 
     observers <- weather %>%
@@ -98,8 +112,9 @@ ObsN <- RTENO <- Date <- TotalSpp  <- NULL # bind variable to avoid CMD CHK WARN
            "observers",
            "weather",
            "species_list",
-           "citation",
-           "vehicle_data"
+           "vehicle_data",
+           "bbs_dir",
+           "citation"
       )
     bbs <- lapply(
       list.elements,
@@ -110,6 +125,9 @@ ObsN <- RTENO <- Date <- TotalSpp  <- NULL # bind variable to avoid CMD CHK WARN
     )
     names(bbs) <- list.elements
 
+    cat("Please cite this data release as: ", bbs$citation)
+
+
     # END FUNCTION ------------------------------------------------------------
     return(bbs)
 }

R/import_species_list.R

@@ -3,23 +3,63 @@
 #'
 #' @title Import the species list comprising names and numeric identifiers.
 #' @param bbs_dir Directory for the ScienceBase (sb) item.
+#' @param sb_id ScienceBase Item identifier. Can be found in \code{sb_items}.
 #' @importFrom dplyr left_join
 #' @importFrom readr read_fwf
 #' @export import_species_list
-import_species_list <- function(bbs_dir){
+import_species_list <- function(bbs_dir, sb_id){
     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...
-    ## unfortunately, need to manually assign row 1 as header and remove the "line" row
-    # names=as.vector(c(species_list[1,]))
+    sb_items = bbsAssistant::sb_items
+    # if release_year < 2020, the list is ugly so need some munging.
+    if(sb_items$release_year[
+      sb_items$sb_item == sb_id
+    ] < 2020){
+    # read list in to determine how many ln_row we need to specify (i.e. skip the rows containing useless text.)
+    ln_row <-
+      stringr::str_which(readr::read_fwf(
+        fn,
+        show_col_types = FALSE
+      )[[1]],
+      "---")
+    # I think the data is Windows-1252 encoded, so need to convert to UTF to handle downstream issues.
+    ## Read raw bytes from the file
+    raw_bytes <- readBin(fn, what = "raw", n = file.info(fn)$size)
+    ## Decode Windows-1252 (smart quotes, accents) to UTF-8
+    decoded_txt <- iconv(rawToChar(raw_bytes), from = "Windows-1252", to = "UTF-8")
+    ## Parse the fixed-width file from the decoded text
+    species_list <- readr::read_fwf(
+      I(decoded_txt),
+      skip = ln_row - 2,
+      show_col_types = FALSE
+    )
+    # unfortunately, need to manually assign row 1 as header and remove the "line" row
     temp <- lapply(species_list[1, ], as.character)
     species_list <- species_list[-c(1:2),]
-
     colnames(species_list) <- temp
 
+        }else{
+      species_list <- read.csv(fn)
+    }
+
+
+
+    # # removing french common name due to persistent encoding issues
+    # species_list <- species_list |> select(-'French_Common_Name')
+
     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 <-species_list |>
+      mutate(Scientific_Name = paste0(Genus," ", Species))
+
+
+    ## NOT SURE WHY I WANTED THIS, SO SILENCING FOR NOW
+    # ## Join this species list with the package data list -- not sure why i even wnat to store anSL to package
+    # 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)
 }