Converting list of hms objects to one column

Viewed 32

I have a list of hms objects and want to retain this format when converting to a dataframe with a single column. However, when I try to achieve this with unlist I only get the seconds.

For example:

#Psuedo-data

date_1 <- date()
date_ms <- date_1 %>% strsplit(., ' ') %>% unlist() %>% .[4]

time_test <- c()

for(i in 1:10000){
  time_test[[i]] <- data.frame(date = hms(date_ms) - i*2)
}

Then If I do:

map_dfr(time_test, unlist)

# A tibble: 10,000 × 1
    date
   <dbl>
 1    57
 2    55
 3    53
 4    51
 5    49
 6    47
 7    45
 8    43
 9    41
10    39
# … with 9,990 more rows

How do I keep the hms formatting? Expected output:


        date
1 12H 6M 57S
2 12H 6M 55S
...
...

Managed to find a solution:

map_dfr(time_test, pack)

       date
1 12H 6M 57S
2 12H 6M 55S
3 12H 6M 53S
4 12H 6M 51S

It is very slow with a larger number of lists but it packs everything into a single column.

1 Answers

It seems to be very slow to try to bind all of these data frames together, perhaps because they contain S4 Period objects which have to be recreated at each step. This is true whether you use a map function or dplyr::bind_rows, which was my first thought here.

It seems that it is genuinely much faster (as in 500 times faster) to strip out the attributes and build a single Period object in a new tibble, even though the code is a bit clunky. This means you only need to create a single Period object, rather than 10,000 of them:

library(lubridate)

units <- c('second', 'year', 'month', 'day', 'hour', 'minute')
result <- unlist(time_test, use.names = FALSE)
v <- lapply(units[-1], \(x) sapply(time_test, \(y) attr(y$date, x)))

dplyr::tibble(date = period(second = result, year = v[[1]], month = v[[2]], 
                            day = v[[3]], hour = v[[4]], minute = v[[5]]))
#> # A tibble: 10,000 x 1
#>    date       
#>    <Period>   
#>  1 12H 15M 14S
#>  2 12H 15M 12S
#>  3 12H 15M 10S
#>  4 12H 15M 8S 
#>  5 12H 15M 6S 
#>  6 12H 15M 4S 
#>  7 12H 15M 2S 
#>  8 12H 15M 0S 
#>  9 12H 15M -2S
#> 10 12H 15M -4S
#> # ... with 9,990 more rows

Benchmark

The following benchmark shows that this whole process takes about 200ms as opposed to over a minute using dplyr::bind_rows:

f1 <- function() {
units <- c('second', 'year', 'month', 'day', 'hour', 'minute')
result <- unlist(time_test, use.names = FALSE)
v <- lapply(units[-1], \(x) sapply(time_test, \(y) attr(y$date, x)))

dplyr::tibble(date = period(second = result, year = v[[1]], month = v[[2]], 
                            day = v[[3]], hour = v[[4]], minute = v[[5]]))
}

f2 <- function() {
  dplyr::bind_rows(time_test)
}


microbenchmark::microbenchmark(f1(), f2(), times = 1)
#> Unit: milliseconds
#> expr        min         lq       mean     median         uq        max neval
#> f1()   199.7554   199.7554   199.7554   199.7554   199.7554   199.7554     1
#> f2() 77174.5432 77174.5432 77174.5432 77174.5432 77174.5432 77174.5432     1

Created on 2022-07-25 by the reprex package (v2.0.1)

Related