this function is developed to avoid
random errors in compressing and decompressing R function objects
with qs::qsave and qs::qread. If you encounter such errors, please use
this function with function name strings to save and load the function
objects.
Note
The function name string must include two colons ::.
Also, the package preceding the two colons should be loaded in the
current environment.
Examples
unmarshal_function("amadeus::process_aqs")
#> function (path = NULL, date = c("2018-01-01", "2022-12-31"),
#> mode = c("date-location", "available-data", "location"),
#> data_field = "Arithmetic.Mean", return_format = c("terra",
#> "sf", "data.table"), extent = NULL, ...)
#> {
#> mode <- match.arg(mode)
#> return_format <- match.arg(return_format)
#> if (!is.null(date)) {
#> date <- try(as.Date(date))
#> if (inherits(date, "try-error")) {
#> stop("date has invalid format(s). Please check the values.")
#> }
#> if (length(date) != 2) {
#> stop("date should be a character vector of length 2.")
#> }
#> }
#> else {
#> stop("date should be defined.")
#> }
#> if (length(path) == 1 && dir.exists(path)) {
#> path <- list.files(path = path, pattern = "*.csv$", full.names = TRUE)
#> }
#> if (length(path) == 0) {
#> stop("path does not contain csv files.")
#> }
#> pathfiles <- lapply(path, read.csv)
#> sites <- data.table::rbindlist(pathfiles, fill = TRUE)
#> sites$site_id <- sprintf("%02d%03d%04d%05d", as.integer(sites$State.Code),
#> as.integer(sites$County.Code), as.integer(sites$Site.Num),
#> as.integer(sites$Parameter.Code))
#> site_id <- NULL
#> Datum <- NULL
#> POC <- NULL
#> Date.Local <- NULL
#> Sample.Duration <- NULL
#> date_start <- as.Date(date[1])
#> date_end <- as.Date(date[2])
#> date_sequence <- seq(date_start, date_end, "day")
#> date_sequence <- as.character(date_sequence)
#> sites <- dplyr::ungroup(dplyr::mutate(dplyr::filter(dplyr::group_by(dplyr::filter(dplyr::filter(dplyr::as_tibble(sites),
#> as.character(Date.Local) %in% date_sequence), startsWith(Sample.Duration,
#> "24")), site_id), POC == min(POC)), time = Date.Local))
#> col_sel <- c("site_id", "Longitude", "Latitude", "Datum")
#> if (mode != "available-data") {
#> sites_v <- unique(sites[, col_sel])
#> }
#> else {
#> col_sel <- append(col_sel, "Event.Type")
#> col_sel <- append(col_sel, "time")
#> col_sel <- append(col_sel, data_field)
#> sites_v <- dplyr::distinct(dplyr::select(sites, dplyr::all_of(col_sel)))
#> sites_vdup <- dplyr::ungroup(dplyr::filter(dplyr::filter(dplyr::group_by(sites_v,
#> site_id, time), dplyr::n() > 1), !!dplyr::sym("Event.Type") ==
#> "Excluded"))
#> sites_v <- dplyr::anti_join(sites_v, sites_vdup, by = c("site_id",
#> "time", "Event.Type"))
#> }
#> names(sites_v)[2:3] <- c("lon", "lat")
#> sites_v <- data.table::as.data.table(sites_v)
#> sites_v <- sites_v[!grepl("^(02|15|72|78|6|80)", site_id),
#> ]
#> sites_v_nad <- sites_v[sites_v$Datum == "NAD83", ]
#> sites_v_nad <- terra::vect(sites_v_nad, keepgeom = TRUE,
#> crs = "EPSG:4269")
#> sites_v_nad <- terra::project(sites_v_nad, "EPSG:4326")
#> sites_v_nad <- as.data.frame(sites_v_nad)
#> sites_v_wgs <- sites_v[sites_v$Datum == "WGS84"]
#> final_sites <- data.table::rbindlist(list(sites_v_wgs, sites_v_nad),
#> fill = TRUE)
#> final_sites <- final_sites[, grep("Datum", names(final_sites),
#> invert = TRUE), with = FALSE]
#> if (mode == "date-location") {
#> final_sites <- lapply(split(date_sequence, date_sequence),
#> function(x) {
#> fs_time <- final_sites
#> fs_time$time <- x
#> return(fs_time)
#> })
#> final_sites <- data.table::rbindlist(final_sites, fill = TRUE)
#> }
#> if (mode == "available-data") {
#> final_sites <- unique(final_sites)
#> }
#> final_sites <- switch(return_format, terra = terra::vect(final_sites,
#> keepgeom = TRUE, crs = "EPSG:4326"), sf = sf::st_as_sf(final_sites,
#> remove = FALSE, dim = "XY", coords = c("lon", "lat"),
#> crs = "EPSG:4326"), data.table = final_sites)
#> if (!is.null(extent)) {
#> if (return_format == "data.table") {
#> warning("Extent is not applicable for data.table. Returning data.table...\n")
#> return(final_sites)
#> }
#> final_sites <- apply_extent(final_sites, extent)
#> }
#> return(final_sites)
#> }
#> <bytecode: 0x55a7404320b0>
#> <environment: namespace:amadeus>