From 35fe5f3b68c19bd8b62fe98f17feeb6435da7272 Mon Sep 17 00:00:00 2001 From: Fred Date: Fri, 7 Jul 2023 12:01:51 +0200 Subject: [PATCH 1/3] fix error when removing duplicate columns --- R/internal.R | 5 ++++- 1 file changed, 4 insertions(+), 1 deletion(-) diff --git a/R/internal.R b/R/internal.R index 22e8b21..e8c3431 100644 --- a/R/internal.R +++ b/R/internal.R @@ -141,7 +141,10 @@ records$stop_time <- as.POSIXct(strptime(records$stop_time, "%Y:%j:%T", tz = "UTC")) records$date_acquisition <- as.Date(records$start_time) records$start_date <- records$stop_date <- NULL - records[, which(colnames(records) == "cloudcov")[2]] <- NULL #remove duplicated column + # Find and remove Duplicated Columns + duplicated_columns <- duplicated(as.list(records)) + records <- records[!duplicated_columns] + #records[, which(colnames(records) == "cloudcov")[2]] <- NULL #remove duplicated column } if(product_group == "modis"){ records$start_time <- as.POSIXct(strptime(records$start_date, "%Y-%m-%d %T", tz = "UTC")) From 764ffe5093270cecee50f790c14d99365e6dc7ac Mon Sep 17 00:00:00 2001 From: Fred Date: Mon, 10 Jul 2023 10:27:42 +0200 Subject: [PATCH 2/3] fix bug with hyphen in USGS account --- R/check_availability.R | 7 ++++--- 1 file changed, 4 insertions(+), 3 deletions(-) diff --git a/R/check_availability.R b/R/check_availability.R index ce80af7..64093c0 100644 --- a/R/check_availability.R +++ b/R/check_availability.R @@ -60,12 +60,13 @@ check_availability <- function(records, verbose = TRUE){ # extract order ids of last 7 days order_ids <- gsub('\\["', "", gsub('"]', "", strsplit(xml_text(xml_children(order_ids)[[1]]), '\", \"')[[1]])) - order_dates <- lapply(order_ids, function(x) strptime(strsplit(x, "-")[[1]][3], format = "%m%d%Y")) + # get third to last string of split, thereby ignoring possible hyphens in account e-mail-adress + order_dates <- lapply(order_ids, function(x) strptime(strsplit(x, "-")[[1]][length(strsplit(x, "-")[[1]])-2], format = "%m%d%Y")) order_ids <- order_ids[sapply(order_dates, function(x) difftime(Sys.time(), x, units = "days")) <= 7] # if there is something, digg deeper if(!is.na(order_ids[1])){ - + browser() # get item ids for each order item_ids <- lapply(order_ids, function(x){ response <- content(.get(paste0(getOption("gSD.api")$espa, "/order/", x), getOption("gSD.usgs_user"), getOption("gSD.usgs_pass"))) @@ -124,4 +125,4 @@ check_availability <- function(records, verbose = TRUE){ out(paste0(as.character(n_avail), "/", nrow(records), " records are currently available for download (this includes past completed orders that are still available for download)."), type = 1) if(n_avail < nrow(records)) out("Use order_data() to order/restore records that are not available for download.") return(.column_summary(records, records.names)) -} \ No newline at end of file +} From dbf9e7d7c17a71d6c941151a9cd8e0a7242cf592 Mon Sep 17 00:00:00 2001 From: Fred Date: Mon, 10 Jul 2023 17:43:44 +0200 Subject: [PATCH 3/3] no message --- R/check_availability.R | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/R/check_availability.R b/R/check_availability.R index 64093c0..966192b 100644 --- a/R/check_availability.R +++ b/R/check_availability.R @@ -66,7 +66,7 @@ check_availability <- function(records, verbose = TRUE){ # if there is something, digg deeper if(!is.na(order_ids[1])){ - browser() + # get item ids for each order item_ids <- lapply(order_ids, function(x){ response <- content(.get(paste0(getOption("gSD.api")$espa, "/order/", x), getOption("gSD.usgs_user"), getOption("gSD.usgs_pass"))) @@ -77,7 +77,7 @@ check_availability <- function(records, verbose = TRUE){ # extract order ids that match records and are still hot for download records[sub,]$gSD.order_id <- .sapply(records[sub,]$record_id, function(recid){ match_item <- .sapply(item_ids, function(itid) recid %in% itid) - if(any(match_item)) order_ids[match_item] else NA + if(any(match_item)) order_ids[match_item][1] else NA }) #records[sub,][records[sub,]$record_id %in% unlist(item_ids),]$gSD.order_id <- order_ids[unlist(item_ids) %in% records[sub,]$record_id] #records[sub,]$gSD.order_id <- order_ids[sapply(records[sub,]$record_id, function(x) which(x == item_ids)[1])]