Merge branch 'main' into 2184_check_keys_renaming

NAMESPACE

@@ -201,12 +201,15 @@ importFrom(lubridate,date)
 importFrom(lubridate,days)
 importFrom(lubridate,duration)
 importFrom(lubridate,floor_date)
+importFrom(lubridate,hour)
 importFrom(lubridate,hours)
 importFrom(lubridate,is.Date)
 importFrom(lubridate,is.POSIXct)
 importFrom(lubridate,is.instant)
+importFrom(lubridate,minute)
 importFrom(lubridate,minutes)
 importFrom(lubridate,rollback)
+importFrom(lubridate,second)
 importFrom(lubridate,time_length)
 importFrom(lubridate,weeks)
 importFrom(lubridate,years)
@@ -220,6 +223,7 @@ importFrom(purrr,keep)
 importFrom(purrr,map)
 importFrom(purrr,map2)
 importFrom(purrr,map_chr)
+importFrom(purrr,map_dbl)
 importFrom(purrr,map_if)
 importFrom(purrr,map_lgl)
 importFrom(purrr,modify_at)
@@ -244,6 +248,7 @@ importFrom(rlang,current_env)
 importFrom(rlang,enexpr)
 importFrom(rlang,eval_bare)
 importFrom(rlang,eval_tidy)
+importFrom(rlang,exec)
 importFrom(rlang,expr)
 importFrom(rlang,expr_interp)
 importFrom(rlang,expr_label)

NEWS.md

@@ -4,6 +4,10 @@
 
 ## Updates of Existing Functions
 
+- Fixed a bug in `compute_tmf()` where the time imputation flag was being incorrectly
+populated when any of the existing time components (hour, minute and/or second) of the date
+character vector (`'--DTC'`), was imputed. (#2146)
+
 - `derive_extreme_records()`, `derive_var_extreme_flag()`,`derive_vars_joined()` and `derive_vars_merged()` were enhanced with the arguments `true_value` and `false_value` to align with preexisting functions that had similar functionality (#2125)
 
 - `restrict_derivation()` now allows `{dplyr}` functions like `mutate` in the
@@ -13,6 +17,22 @@
 were enhanced such that more than one summary variable can be derived, e.g.,
 `AVAL` as the sum and `ADT` as the maximum of the contributing records. (#1792)
 
+- The "joined" functions (`derive_vars_joined()`, `derive_var_joined_exist_flag()`,
+`filter_joined()`, and `event_joined()`) were unified: (#2126)
+    - The `dataset_add` and `filter_add` arguments were added to
+    `derive_var_joined_exist_flag()` and `filter_joined()`.
+    - The `filter` argument was renamed to `filter_join` in
+    `derive_var_joined_exist_flag()` and `filter_joined()`.
+    - The `tmp_obs_nr_var`, the `join_type`, the `first_cond_lower`, and the
+    `first_cond_upper` arguments were added to `derive_vars_joined()`.
+    - In `derive_var_joined_exist_flag()`, `filter_joined()`, and `event_joined()`
+    the `first_cond` argument was renamed to `first_cond_upper` and the
+    `first_cond_lower` argument was added.
+    - In all "joined" functions the `filter_add` argument is applied to the
+    additional dataset grouped by `by_vars` and the `filter_join` argument is
+    applied to the joined dataset grouped by the observations from the input
+    dataset. I.e., summary functions like `all()` or `any()` can be used.
+
 - The `tmp_event_nr_var` argument was added to `derive_extreme_records()` to
 allow more control of the selection of records. It creates a temporary variable
 for the event number, which can be used in `order`. (#2140)
@@ -35,7 +55,14 @@ for the event number, which can be used in `order`. (#2140)
 - The default value for the `false_value` argument in `derive_extreme_records()` was changed to `NA_character_` (#2125)
 
 - For the function `consolidate_metadata()`, the argument `check_keys` was renamed to `check_type` to align with other functions (#2184)
-- 
+
+- In `filter_joined()` and `derive_var_joined_exist_flag()` (#2126)
+    - the `first_cond` argument was deprecated in favor of `first_cond_upper` and
+    - the `filter` argument was deprecated in favor of `filter_join`.
+
+- In `event_joined()` the `first_cond` argument was deprecated in favor of
+`first_cond_upper`. (#2126)
+
 - The `ignore_event_order` argument in `derive_extreme_event()` was deprecated
 and the selection of the records was changed to allow more control. Before, the
 records were selected first by event and then by `order`. Now they are selected

R/admiral-package.R

@@ -11,16 +11,17 @@
 #'   call2 caller_env call_name current_env .data enexpr eval_bare eval_tidy
 #'   expr expr_interp expr_label exprs f_lhs f_rhs inform is_call is_expression
 #'   is_missing new_formula parse_expr parse_exprs set_names sym syms type_of
-#'   warn as_data_mask list2
+#'   warn as_data_mask list2 exec
 #' @importFrom utils capture.output str file.edit
 #' @importFrom purrr map map2 map_chr map_lgl reduce walk keep map_if transpose
-#'             flatten every modify_at modify_if reduce compose pmap
+#'             flatten every modify_at modify_if reduce compose pmap map_dbl
 #' @importFrom stringr str_c str_count str_detect str_extract str_glue
 #'   str_length str_locate str_locate_all str_match str_remove str_remove_all
 #'   str_replace str_replace_all str_split str_starts str_sub str_subset
 #'   str_trim str_to_lower str_to_title str_to_upper
 #' @importFrom lubridate as_datetime ceiling_date date days duration floor_date is.Date is.instant
-#'             rollback time_length %--% ymd ymd_hms weeks years hours minutes is.POSIXct
+#'             rollback time_length %--% ymd ymd_hms weeks years hours minutes is.POSIXct hour
+#'             minute second
 #' @importFrom tidyr crossing drop_na fill nest pivot_longer pivot_wider unnest
 #' @importFrom tidyselect all_of any_of contains matches vars_select
 #' @importFrom hms as_hms

R/derive_date_vars.R

@@ -1207,25 +1207,46 @@ compute_dtf <- function(dtc, dt) {
 #' @export
 #'
 #' @examples
-#' compute_tmf(dtc = "2019-07-18T15:25", dtm = as.POSIXct("2019-07-18T15:25:00"))
-#' compute_tmf(dtc = "2019-07-18T15", dtm = as.POSIXct("2019-07-18T15:25:00"))
-#' compute_tmf(dtc = "2019-07-18", dtm = as.POSIXct("2019-07-18"))
+#' library(lubridate)
+#'
+#' compute_tmf(dtc = "2019-07-18T15:25", dtm = ymd_hms("2019-07-18T15:25:00"))
+#' compute_tmf(dtc = "2019-07-18T15", dtm = ymd_hms("2019-07-18T15:25:00"))
+#' compute_tmf(dtc = "2019-07-18", dtm = ymd("2019-07-18"))
+#' compute_tmf(dtc = "2022-05--T00:00", dtm = ymd_hms("2022-05-15T23:59:59"))
+#' compute_tmf(dtc = "2022-05--T23:00", dtm = ymd_hms("2022-05-15T23:59:59"))
+#' compute_tmf(dtc = "2022-05--T23:59:00", dtm = ymd_hms("2022-05-15T23:59:59"))
+#'
 compute_tmf <- function(dtc,
                         dtm,
                         ignore_seconds_flag = FALSE) {
   assert_date_vector(dtm)
   assert_character_vector(dtc)
   assert_logical_scalar(ignore_seconds_flag)
 
+  valid_dtc <- is_valid_dtc(dtc)
+  warn_if_invalid_dtc(dtc, valid_dtc)
+
   partial <- get_partialdatetime(dtc)
   highest_miss <- convert_blanks_to_na(vector("character", length(dtc)))
-  for (c in c("hour", "minute", "second")) {
+
+  # concatenate lubridate functions: `hour()`, `minute()`, `second()` to map over dtm input
+  hms <- c("hour", "minute", "second")
+
+  # extract hour, minute, second over each value of dtm and put into a list time_part
+  time_part <-
+    map(set_names(hms), function(y) map_dbl(dtm, function(x) exec(y, x)))
+
+  for (c in hms) {
     highest_miss <-
-      if_else(is.na(partial[[c]]) & is.na(highest_miss), c, highest_miss)
+      if_else((is.na(partial[[c]]) & is.na(highest_miss)) |
+        (
+          !is.na(partial[[c]]) &
+            is.na(highest_miss) & as.numeric(partial[[c]]) != time_part[[c]]
+        ),
+      c,
+      highest_miss
+      )
   }
-  is_na <- is.na(dtm)
-  valid_dtc <- is_valid_dtc(dtc)
-  warn_if_invalid_dtc(dtc, valid_dtc)
 
   map <- c(
     hour = "H",