Skip to content

Commit 6bf4ca7

Browse files
mlamprosmlampros
committed
updated the R and tests files
1 parent c0560b8 commit 6bf4ca7

File tree

3 files changed

+123
-51
lines changed

3 files changed

+123
-51
lines changed

‎R/mission_orbits.R‎

Lines changed: 113 additions & 49 deletions
Original file line numberDiff line numberDiff line change
@@ -832,51 +832,98 @@ time_specific_orbits <- function(date_from = NULL,
832832
descr_proc <- strsplit(x = sf_objs$description, split = "\n")
833833
} else {
834834
sf_objs$Description <- as.character(sf_objs$Description)
835-
descr_proc <- strsplit(x = sf_objs$Description, split = " ") # in case that I have a 'Description' column, split by empty space
836-
# ........................................................................... "start" error case with missing 'time' for midnight on Windows
837-
len_desc <- lapply(descr_proc, function(x) length(x)) |>
838-
unlist() |>
839-
table()
840-
len_desc <- as.integer(names(len_desc)[which.max(len_desc)])
841-
842-
# If the modal token count is odd, the expected even length is len_desc + 1.
843-
# This handles the case where NASA changed the orbit-file Description format
844-
# so that ALL rows now omit the time (i.e. the midnight-missing format
845-
# became the majority rather than the exception).
846-
len_desc_even <- if (len_desc %% 2 == 0) len_desc else len_desc + 1L
847-
848-
chk_row_items <- as.vector(unlist(lapply(descr_proc, function(x) (length(x) %% 2) == 0))) # check that I have an even number of columns (normally 8 but can be fewer too) then concatenate the columns by pairs of consecutive items
849-
850-
if (!all(chk_row_items)) {
851-
idx_not <- which(!chk_row_items)
852-
853-
for (idx_i in idx_not) {
854-
item_i <- descr_proc[[idx_i]]
855-
if (length(item_i) == (len_desc_even - 1)) { # we expect that only the time is missing
856-
857-
# This is the current exception:
858-
# RGT 1264 15-Dec-2020 DOY 350 Cycle 9 # midnight time is missing, i.e. "00:00:00" (time)
859-
# RGT 1264 16-Dec-2020 00:01:00 DOY 351 Cycle 9 # after midnight case (as expected)
860-
861-
item_i <- append(x = item_i, values = "00:00:00", after = 3) # add the time after the date
862-
descr_proc[[idx_i]] <- item_i
863-
} else { # throw an error in any other case
864-
len_dif <- len_desc_even - length(item_i)
865-
stop(glue::glue("We expect a difference of maximum one and received a difference of length {len_dif}, which means {len_dif} attributes are missing from the character string!"))
835+
# ---- PREVIOUS CODE (commented out) ----
836+
# descr_proc <- strsplit(x = sf_objs$Description, split = " ") # in case that I have a 'Description' column, split by empty space
837+
# # ........................................................................... "start" error case with missing 'time' for midnight on Windows
838+
# len_desc <- lapply(descr_proc, function(x) length(x)) |>
839+
# unlist() |>
840+
# table()
841+
# len_desc <- as.integer(names(len_desc)[which.max(len_desc)])
842+
# # If the modal token count is odd, the expected even length is len_desc + 1.
843+
# # This handles the case where NASA changed the orbit-file Description format
844+
# # so that ALL rows now omit the time (i.e. the midnight-missing format
845+
# # became the majority rather than the exception).
846+
# len_desc_even <- if (len_desc %% 2 == 0) len_desc else len_desc + 1L
847+
# chk_row_items <- as.vector(unlist(lapply(descr_proc, function(x) (length(x) %% 2) == 0))) # check that I have an even number of columns (normally 8 but can be fewer too) then concatenate the columns by pairs of consecutive items
848+
# if (!all(chk_row_items)) {
849+
# idx_not <- which(!chk_row_items)
850+
# for (idx_i in idx_not) {
851+
# item_i <- descr_proc[[idx_i]]
852+
# if (length(item_i) == (len_desc_even - 1)) { # we expect that only the time is missing
853+
# # This is the current exception:
854+
# # RGT 1264 15-Dec-2020 DOY 350 Cycle 9 # midnight time is missing, i.e. "00:00:00" (time)
855+
# # RGT 1264 16-Dec-2020 00:01:00 DOY 351 Cycle 9 # after midnight case (as expected)
856+
# item_i <- append(x = item_i, values = "00:00:00", after = 3) # add the time after the date
857+
# descr_proc[[idx_i]] <- item_i
858+
# } else { # throw an error in any other case
859+
# len_dif <- len_desc_even - length(item_i)
860+
# stop(glue::glue("We expect a difference of maximum one and received a difference of length {len_dif}, which means {len_dif} attributes are missing from the character string!"))
861+
# }
862+
# }
863+
# }
864+
# chk_row_items <- as.vector(unlist(lapply(descr_proc, function(x) (length(x) %% 2) == 0)))
865+
# if (!all(chk_row_items)) {
866+
# stop("We expect after the code adjustments to receive equal length of vector (split) character strings!")
867+
# }
868+
# # ........................................................................... "end" error case with missing 'time' for midnight on Windows
869+
# descr_proc <- lapply(descr_proc, function(x) {
870+
# seq_item <- seq(from = 1, to = length(x), by = 2)
871+
# sapply(seq_item, function(y) paste(c(x[y], x[y + 1]), collapse = " "))
872+
# })
873+
# flag_upper_descr <- TRUE
874+
# ---- END PREVIOUS CODE ----
875+
# Detect whether Description entries use newline separators (new NASA KMZ format <U+2014>
876+
# CRLF on Windows) or space separators (classic Windows/macOS format).
877+
# When CRLF is embedded in space-split tokens (e.g. "1264\r\n15-Dec-2020"), both
878+
# idx_rgt and idx_date_time resolve to the same column and the second setnames call
879+
# silently overwrites the first, making descr_proc[["RGT"]] return NULL.
880+
non_empty_idx <- which(nchar(sf_objs$Description) > 0 & !is.na(sf_objs$Description))
881+
uses_newlines <- length(non_empty_idx) > 0 &&
882+
grepl("[\r\n]", sf_objs$Description[[non_empty_idx[[1]]]], perl = TRUE)
883+
if (uses_newlines) {
884+
# New format: Description uses CR/LF separators <U+2014> identical logical structure to
885+
# the lowercase "description" path, so split the same way.
886+
descr_proc <- strsplit(x = sf_objs$Description, split = "[\r\n]+", perl = TRUE)
887+
} else {
888+
# Classic format: Description uses space-separated tokens that must be paired.
889+
descr_proc <- strsplit(x = sf_objs$Description, split = " ") # in case that I have a 'Description' column, split by empty space
890+
# ........................................................................... "start" error case with missing 'time' for midnight on Windows
891+
len_desc <- lapply(descr_proc, function(x) length(x)) |>
892+
unlist() |>
893+
table()
894+
len_desc <- as.integer(names(len_desc)[which.max(len_desc)])
895+
# If the modal token count is odd, the expected even length is len_desc + 1.
896+
# This handles the case where NASA changed the orbit-file Description format
897+
# so that ALL rows now omit the time (i.e. the midnight-missing format
898+
# became the majority rather than the exception).
899+
len_desc_even <- if (len_desc %% 2 == 0) len_desc else len_desc + 1L
900+
chk_row_items <- as.vector(unlist(lapply(descr_proc, function(x) (length(x) %% 2) == 0))) # check that I have an even number of columns (normally 8 but can be fewer too) then concatenate the columns by pairs of consecutive items
901+
if (!all(chk_row_items)) {
902+
idx_not <- which(!chk_row_items)
903+
for (idx_i in idx_not) {
904+
item_i <- descr_proc[[idx_i]]
905+
if (length(item_i) == (len_desc_even - 1)) { # we expect that only the time is missing
906+
# This is the current exception:
907+
# RGT 1264 15-Dec-2020 DOY 350 Cycle 9 # midnight time is missing, i.e. "00:00:00" (time)
908+
# RGT 1264 16-Dec-2020 00:01:00 DOY 351 Cycle 9 # after midnight case (as expected)
909+
item_i <- append(x = item_i, values = "00:00:00", after = 3) # add the time after the date
910+
descr_proc[[idx_i]] <- item_i
911+
} else { # throw an error in any other case
912+
len_dif <- len_desc_even - length(item_i)
913+
stop(glue::glue("We expect a difference of maximum one and received a difference of length {len_dif}, which means {len_dif} attributes are missing from the character string!"))
914+
}
866915
}
867916
}
917+
chk_row_items <- as.vector(unlist(lapply(descr_proc, function(x) (length(x) %% 2) == 0)))
918+
if (!all(chk_row_items)) {
919+
stop("We expect after the code adjustments to receive equal length of vector (split) character strings!")
920+
}
921+
# ........................................................................... "end" error case with missing 'time' for midnight on Windows
922+
descr_proc <- lapply(descr_proc, function(x) {
923+
seq_item <- seq(from = 1, to = length(x), by = 2)
924+
sapply(seq_item, function(y) paste(c(x[y], x[y + 1]), collapse = " "))
925+
})
868926
}
869-
870-
chk_row_items <- as.vector(unlist(lapply(descr_proc, function(x) (length(x) %% 2) == 0)))
871-
if (!all(chk_row_items)) {
872-
stop("We expect after the code adjustments to receive equal length of vector (split) character strings!")
873-
}
874-
# ........................................................................... "end" error case with missing 'time' for midnight on Windows
875-
876-
descr_proc <- lapply(descr_proc, function(x) {
877-
seq_item <- seq(from = 1, to = length(x), by = 2)
878-
sapply(seq_item, function(y) paste(c(x[y], x[y + 1]), collapse = " "))
879-
})
880927
flag_upper_descr <- TRUE
881928
}
882929
descr_proc <- data.table::as.data.table(do.call(rbind, descr_proc))
@@ -1569,13 +1616,30 @@ vsi_time_specific_orbits_wkt <- function(date_from,
15691616
descr_proc <- strsplit(x = x$description, split = "\n")
15701617
} else {
15711618
x$Description <- as.character(x$Description)
1572-
descr_proc <- strsplit(x = x$Description, split = " ") # in case that I have a 'Description' column, split by empty space
1573-
chk_row_items <- as.vector(unlist(lapply(descr_proc, function(x) (length(x) %% 2) == 0))) # check that I have an even number of columns (normally 8 but can be fewer too) then concatenate the columns by pairs of consecutive items
1574-
if (!all(chk_row_items)) stop("It seems that after splitting the observations by empty space the number of columns (per row) are not an even number (vsi function)!", call. = F)
1575-
descr_proc <- lapply(descr_proc, function(x) {
1576-
seq_item <- seq(from = 1, to = length(x), by = 2)
1577-
sapply(seq_item, function(y) paste(c(x[y], x[y + 1]), collapse = " "))
1578-
})
1619+
# ---- PREVIOUS CODE (commented out) ----
1620+
# descr_proc <- strsplit(x = x$Description, split = " ") # in case that I have a 'Description' column, split by empty space
1621+
# chk_row_items <- as.vector(unlist(lapply(descr_proc, function(x) (length(x) %% 2) == 0))) # check that I have an even number of columns (normally 8 but can be fewer too) then concatenate the columns by pairs of consecutive items
1622+
# if (!all(chk_row_items)) stop("It seems that after splitting the observations by empty space the number of columns (per row) are not an even number (vsi function)!", call. = F)
1623+
# descr_proc <- lapply(descr_proc, function(x) {
1624+
# seq_item <- seq(from = 1, to = length(x), by = 2)
1625+
# sapply(seq_item, function(y) paste(c(x[y], x[y + 1]), collapse = " "))
1626+
# })
1627+
# ---- END PREVIOUS CODE ----
1628+
# Same newline detection as the time_specific_orbits path.
1629+
non_empty_idx_x <- which(nchar(x$Description) > 0 & !is.na(x$Description))
1630+
uses_newlines_x <- length(non_empty_idx_x) > 0 &&
1631+
grepl("[\r\n]", x$Description[[non_empty_idx_x[[1]]]], perl = TRUE)
1632+
if (uses_newlines_x) {
1633+
descr_proc <- strsplit(x = x$Description, split = "[\r\n]+", perl = TRUE)
1634+
} else {
1635+
descr_proc <- strsplit(x = x$Description, split = " ") # in case that I have a 'Description' column, split by empty space
1636+
chk_row_items <- as.vector(unlist(lapply(descr_proc, function(x) (length(x) %% 2) == 0))) # check that I have an even number of columns (normally 8 but can be fewer too) then concatenate the columns by pairs of consecutive items
1637+
if (!all(chk_row_items)) stop("It seems that after splitting the observations by empty space the number of columns (per row) are not an even number (vsi function)!", call. = F)
1638+
descr_proc <- lapply(descr_proc, function(x) {
1639+
seq_item <- seq(from = 1, to = length(x), by = 2)
1640+
sapply(seq_item, function(y) paste(c(x[y], x[y + 1]), collapse = " "))
1641+
})
1642+
}
15791643
}
15801644

15811645
descr_proc <- data.table::as.data.table(do.call(rbind, descr_proc))

‎tests/testthat/test-API_utils.R‎

Lines changed: 5 additions & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -54,6 +54,10 @@ testthat::test_that("the function 'verify_RGTs()' returns a data.table if the in
5454
error = function(e) NULL
5555
)
5656

57-
testthat::skip_if(is.null(dtbl) || nrow(dtbl) == 0, "API returned no data or an error; skipping value check")
57+
testthat::skip_if(
58+
is.null(dtbl) || nrow(dtbl) == 0 || nrow(dtbl) < 5 ||
59+
ncol(dtbl) != 3 || !all(c("Date_time", "RGT_OpenAlt", "RGT_NSIDC") %in% colnames(dtbl)),
60+
"API returned no data, an error, or unexpected structure; skipping value check"
61+
)
5862
testthat::expect_true(nrow(dtbl) >= 5 & ncol(dtbl) == 3 & all(colnames(dtbl) %in% c("Date_time", "RGT_OpenAlt", "RGT_NSIDC")))
5963
})

‎tests/testthat/test-get_Tracks_data.R‎

Lines changed: 5 additions & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -29,6 +29,10 @@ testthat::test_that("the function 'getTracks()' returns the correct output!", {
2929
error = function(e) NULL
3030
)
3131

32-
testthat::skip_if(is.null(res_df) || nrow(res_df) == 0, "API returned no data or an error; skipping value check")
32+
testthat::skip_if(
33+
is.null(res_df) || !is.data.frame(res_df) || nrow(res_df) == 0 ||
34+
!"track" %in% colnames(res_df),
35+
"API returned no data, an error, or unexpected structure; skipping value check"
36+
)
3337
testthat::expect_true(is.data.frame(res_df) & "track" %in% colnames(res_df))
3438
})

0 commit comments

Comments
 (0)