Floor/Ceiling HMS

[muschellij2]

Would floor_hms or ceiling_hms be useful? I believe ceiling_hms would be in some cases. floor_hms, however, is essentially trunc_hms except when the values are negative, which I'm not sure is a good use case but may be useful for mapping the api.

Setup

Loading Packages

library(hms)
suppressPackageStartupMessages(library(dplyr))

Defining Functions

ceiling_hms = function (x, secs = NULL)
{
  vctrs::vec_restore(ceiling(as.numeric(x)/secs) * secs, x)
}

floor_hms = function (x, secs = NULL, digits = NULL) 
{
  vctrs::vec_restore(floor(as.numeric(x)/secs) * secs, x)
}

Creating Conditions

conditions = tibble::tribble(
  ~ x,                      ~ secs,
  as_hms("01:34:56"),         5,
  as_hms("01:32:56"),         5,
  as_hms("01:34:56"),         60,
  as_hms("01:28:56"),         60,
  as_hms("01:34:56.78"),      0.25,
  as_hms("01:34:56.52"),      0.25
)

Running Functions over Conditions

funcs = list(
  trunc_hms = hms::trunc_hms,
  floor_hms = floor_hms,
  ceiling_hms = ceiling_hms,
  round_hms = hms::round_hms
)
out = lapply(names(funcs), function(i) {
  f = funcs[[i]]
  r = mapply(function(x, secs) {
    data.frame(output = f(x, secs))
  }, conditions$x, sec = conditions$secs, SIMPLIFY = FALSE) 
  out = dplyr::bind_rows(r)
  colnames(out) = i
  out
})
result = dplyr::bind_cols(conditions, out)

End Result

print(result)
#> # A tibble: 6 × 6
#>   x            secs trunc_hms   floor_hms   ceiling_hms round_hms  
#>   <time>      <dbl> <time>      <time>      <time>      <time>     
#> 1 01:34:56.00  5    01:34:55.00 01:34:55.00 01:35:00.00 01:34:55.00
#> 2 01:32:56.00  5    01:32:55.00 01:32:55.00 01:33:00.00 01:32:55.00
#> 3 01:34:56.00 60    01:34:00.00 01:34:00.00 01:35:00.00 01:35:00.00
#> 4 01:28:56.00 60    01:28:00.00 01:28:00.00 01:29:00.00 01:29:00.00
#> 5 01:34:56.78  0.25 01:34:56.75 01:34:56.75 01:34:57.00 01:34:56.75
#> 6 01:34:56.52  0.25 01:34:56.50 01:34:56.50 01:34:56.75 01:34:56.50

Comparison

Floor always equal to trunc_hms for positive values

identical(result$trunc_hms, result$floor_hms)
#> [1] TRUE

trunc_hms always different from ceiling_hms

result %>% 
  select(x, secs, trunc_hms, ceiling_hms) %>% 
  filter(trunc_hms != ceiling_hms)
#> # A tibble: 6 × 4
#>   x            secs trunc_hms   ceiling_hms
#>   <time>      <dbl> <time>      <time>     
#> 1 01:34:56.00  5    01:34:55.00 01:35:00.00
#> 2 01:32:56.00  5    01:32:55.00 01:33:00.00
#> 3 01:34:56.00 60    01:34:00.00 01:35:00.00
#> 4 01:28:56.00 60    01:28:00.00 01:29:00.00
#> 5 01:34:56.78  0.25 01:34:56.75 01:34:57.00
#> 6 01:34:56.52  0.25 01:34:56.50 01:34:56.75

round_hms different from ceiling_hms in cases where round != ceiling

result %>% 
  select(x, secs, round_hms, ceiling_hms) %>% 
  filter(round_hms != ceiling_hms)
#> # A tibble: 4 × 4
#>   x            secs round_hms   ceiling_hms
#>   <time>      <dbl> <time>      <time>     
#> 1 01:34:56.00  5    01:34:55.00 01:35:00.00
#> 2 01:32:56.00  5    01:32:55.00 01:33:00.00
#> 3 01:34:56.78  0.25 01:34:56.75 01:34:57.00
#> 4 01:34:56.52  0.25 01:34:56.50 01:34:56.75

How Floor may be Useful

Floor gives difference if the value is negative, not sure if this is a real use case though

x = hms::as_hms(hms::as_hms("00:00:00") - 100)
x
#> -00:01:40
trunc_hms(x, 5)
#> -00:01:40
floor_hms(x, 5)
#> -00:01:40
trunc_hms(x, 60)
#> -00:01:00
floor_hms(x, 60)
#> -00:02:00
trunc_hms(x, 0.25)
#> -00:01:40
floor_hms(x, 0.25)
#> -00:01:40

^{Created on 2023-06-14 with reprex v2.0.2}