diff --git a/R/read_waterdata_ratings.R b/R/read_waterdata_ratings.R index cfe02427..3bb18121 100644 --- a/R/read_waterdata_ratings.R +++ b/R/read_waterdata_ratings.R @@ -56,19 +56,23 @@ #' file_type = "exsa") #' #' head(ratings_exsa[["USGS-01104475.exsa.rdb"]]$ratings) -#' ratings_exsa[["USGS-01104475.exsa.rdb"]]$metadata +#' m1 <- ratings_exsa[["USGS-01104475.exsa.rdb"]]$metadata +#' m1 #' #' ratings_corr <- read_waterdata_ratings( #' monitoring_location_id = monitoring_location_id, #' file_type = "corr") #' #' head(ratings_corr[["USGS-01104460.corr.rdb"]]$ratings) -#' ratings_corr[["USGS-01104460.corr.rdb"]]$metadata +#' m2 <- ratings_corr[["USGS-01104460.corr.rdb"]]$metadata +#' m2 #' #' rating_2 <- read_waterdata_ratings( #' monitoring_location_id = monitoring_location_id, #' file_type = c("corr", "exsa")) #' names(rating_2) +#' m3 <- rating_2$`USGS-01104460.exsa.rdb`$metadata +#' rat_data <- rating_2$`USGS-01104460.exsa.rdb`$ratings #' #' bbox <- c(-95.00, 40.0, -92.0, 42) #' @@ -78,7 +82,6 @@ #' recent_query <- read_waterdata_ratings(bbox = bbox, #' datetime = c(Sys.Date()-7, NA), #' download_and_parse = FALSE) -#' length(recent_query) #'} read_waterdata_ratings <- function( monitoring_location_id = NA_character_, @@ -154,7 +157,7 @@ read_waterdata_ratings <- function( basic_request() message("Requesting:\n", request$url) - + resp <- httr2::req_perform(request) log_rate_limit(resp) @@ -199,126 +202,96 @@ download_convert <- function(feature, file_path, file_type) { return(NULL) } -# Parse rating comment metadata into a data frame -parse_ratings_metadata <- function(ratings_df) { - raw_comments <- comment(ratings_df) - - if (is.null(raw_comments)) { - return(data.frame( - header = character(), - value = character() - )) +# Parse a single key=value or key="value" token into a named list +parse_kv_tokens <- function(line) { + kv_pat <- '([A-Za-z0-9_]+)\\s*=\\s*"([^"]*)"|([A-Za-z0-9_]+)\\s*=\\s*(\\S+)' + m <- gregexpr(kv_pat, line, perl = TRUE) + tokens <- regmatches(line, m)[[1]] + result <- list() + for (tok in tokens) { + key <- sub("^([A-Za-z0-9_]+)\\s*=.*", "\\1", tok, perl = TRUE) + val <- sub('^[A-Za-z0-9_]+\\s*=\\s*"?([^"]*)"?$', "\\1", tok, perl = TRUE) + result[[key]] <- val } + result +} - com <- data.frame( - line = raw_comments - ) - - # remove whitespace - com$line <- sub("^#\\s*//?", "", com$line) - com$line <- sub("^//", "", com$line) - com$line <- gsub("\\s+", " ", trimws(com$line)) - # concatenate warning info - warn_rows <- grepl("^WARNING", com$line) - warn_text <- sub("^WARNING\\s*", "", com$line[warn_rows]) - warn_text <- gsub("\\s+", " ", trimws(warn_text)) - warn_text <- warn_text[warn_text != ""] +parse_ratings_metadata <- function(ratings_df) { + raw_comments <- comment(ratings_df) - warning_block <- if (length(warn_text) > 0) { - paste(warn_text, collapse = " ") - } else { - "" + if (is.null(raw_comments)) { + return(data.frame()) } - non_warn <- com[!warn_rows, , drop = FALSE] + # strip leading # // or // + lines <- sub("^#\\s*//?\\s*", "", raw_comments) + lines <- sub("^//\\s*", "", lines) + lines <- trimws(lines) + lines <- lines[lines != ""] + + # collect WARNING lines + warn_idx <- grepl("^WARNING", lines) + warn_text <- trimws(sub("^WARNING\\s*", "", lines[warn_idx])) + warning_value <- paste(warn_text[warn_text != ""], collapse = " ") + lines <- lines[!warn_idx] + + # split each line into header and the rest + # header is the first all-caps+underscore token + header_pat <- "^([A-Z][A-Z0-9_]*)\\s*(.*)" + headers <- sub(header_pat, "\\1", lines, perl = TRUE) + bodies <- sub(header_pat, "\\2", lines, perl = TRUE) + + # group lines by header, preserving order of first appearance + unique_headers <- unique(headers) + + result <- list(WARNING = warning_value) + i <- 1 + for (hdr in unique_headers) { + idx <- which(headers == hdr) + body_lines <- bodies[idx] + + # parse each line's key=value pairs + parsed_rows <- lapply(body_lines, parse_kv_tokens) + + # check if any line has key=value pairs; if not, treat as plain text + has_kv <- sapply(parsed_rows, length) > 0 + + if (any(has_kv)) { + p_rows <- unlist(parsed_rows) + if (anyDuplicated(names(p_rows))) { + columns <- unique(names(p_rows)) + df <- data.frame(matrix( + NA_character_, + nrow = length(p_rows) / length(columns), + ncol = length(columns) + )) + names(df) <- columns + for (i in columns) { + df[[i]] <- p_rows[names(p_rows) %in% i] + } + } else { + df <- data.frame(t(p_rows)) + } - # group the key-value pairs in the data - kv_pat <- '[A-Za-z0-9_]+\\s*=\\s*"[^"]*"|[A-Za-z0-9_]+\\s*=\\s*[^\\s]+' - kv_match <- regmatches( - non_warn$line, - gregexpr(kv_pat, non_warn$line, perl = TRUE) - ) - has_kv <- sapply(kv_match, length) > 0 - kv_flat <- unlist(kv_match, use.names = FALSE) - - pairs_df <- data.frame( - header = sub("^([A-Za-z0-9_]+).*", "\\1", kv_flat, perl = TRUE), - value = gsub( - '^"|"$', - "", - gsub( - "\\s+", - " ", - trimws( - sub("^[A-Za-z0-9_]+\\s*=\\s*", "", kv_flat, perl = TRUE) + if (nrow(df) == 1 && ncol(df) == 1) { + result[[hdr]] <- df[[1]] + } else { + result[[hdr]] <- df + } + } else { + if (substr(body_lines, start = 1, stop = 1) == "=") { + result[[hdr]] <- substr(body_lines, start = 2, stop = nchar(body_lines)) + } else { + comment_label <- paste("Comment", i) + result[[comment_label]] <- paste( + trimws(c(hdr, body_lines)), + collapse = " " ) - ) - ) - ) - - # handle data with colons - colon_pat <- "^[A-Z][A-Z _-]+:" - colon_rows <- grepl(colon_pat, non_warn$line) - colon_lines <- non_warn$line[colon_rows] - - date_df <- data.frame( - header = gsub( - "\\s+", - " ", - trimws( - sub("^([A-Z][A-Z _-]+):.*$", "\\1", colon_lines, perl = TRUE) - ) - ), - value = gsub( - "\\s+", - " ", - trimws( - sub("^[A-Z][A-Z _-]+:\\s*", "", colon_lines, perl = TRUE) - ) - ) - ) - - # parse any lines that don't fit other patterns - other_lines <- non_warn$line[!has_kv & !colon_rows] - - other_df <- data.frame( - header = gsub( - "\\s+", - " ", - trimws( - sub("^([A-Z][A-Z _-]+).*$", "\\1", other_lines, perl = TRUE) - ) - ), - value = gsub( - "\\s+", - " ", - trimws( - sub("^[A-Z][A-Z _-]+\\s*", "", other_lines, perl = TRUE) - ) - ) - ) - - # combine into one dataframe to be added to list object - final <- rbind( - data.frame( - header = "WARNING", - value = warning_block - ), - pairs_df, - date_df, - other_df - ) - - final$value <- gsub("[\\x00-\\x1F\\x7F]+", " ", final$value, perl = TRUE) - final$value <- gsub("\\s+", " ", trimws(final$value)) - final$header <- gsub("\\s+", " ", trimws(final$header)) - - final <- final[!(final$header == "" & final$value == ""), , drop = FALSE] - final <- unique(final) - rownames(final) <- final$header - # final_t <- data.frame(t(final)) - rownames(final) <- NULL + i <- i + 1 + } + } + } - final + return(result) } diff --git a/man/read_waterdata_ratings.Rd b/man/read_waterdata_ratings.Rd index c2284e5f..c883e0af 100644 --- a/man/read_waterdata_ratings.Rd +++ b/man/read_waterdata_ratings.Rd @@ -96,19 +96,23 @@ ratings_exsa <- read_waterdata_ratings( file_type = "exsa") head(ratings_exsa[["USGS-01104475.exsa.rdb"]]$ratings) -ratings_exsa[["USGS-01104475.exsa.rdb"]]$metadata +m1 <- ratings_exsa[["USGS-01104475.exsa.rdb"]]$metadata +m1 ratings_corr <- read_waterdata_ratings( monitoring_location_id = monitoring_location_id, file_type = "corr") head(ratings_corr[["USGS-01104460.corr.rdb"]]$ratings) -ratings_corr[["USGS-01104460.corr.rdb"]]$metadata +m2 <- ratings_corr[["USGS-01104460.corr.rdb"]]$metadata +m2 rating_2 <- read_waterdata_ratings( monitoring_location_id = monitoring_location_id, file_type = c("corr", "exsa")) names(rating_2) +m3 <- rating_2$`USGS-01104460.exsa.rdb`$metadata +rat_data <- rating_2$`USGS-01104460.exsa.rdb`$ratings bbox <- c(-95.00, 40.0, -92.0, 42) @@ -118,7 +122,6 @@ length(bbox_query) recent_query <- read_waterdata_ratings(bbox = bbox, datetime = c(Sys.Date()-7, NA), download_and_parse = FALSE) -length(recent_query) } \dontshow{\}) # examplesIf} }