根据现有列的输入计算新列

Question

我有一个包含实验开始和停止时间的数据框，我想计算每个实验的持续时间（每个实验一行）。数据框：

 start_t      stop_t
      7:35      7:48
     23:50     00:15
     11:22     12:06

我创建了一个函数来将时间转换为 POSIX 格式并计算持续时间，测试开始和停止是否跨越午夜：

 TimeDiff <- function(t1,t2) { 

if (as.numeric(as.POSIXct(paste("2016-01-01", t1))) > as.numeric(as.POSIXct(paste("2016-01-01", t2)))) { 
  t1n <- as.numeric(as.POSIXct(paste("2016-01-01", t1)))
  t2n <- as.numeric(as.POSIXct(paste("2016-01-02", t2)))
  }
if (as.numeric(as.POSIXct(paste("2016-01-01", t1))) < as.numeric(as.POSIXct(paste("2016-01-01", t2)))) { 
  t1n <- as.numeric(as.POSIXct(paste("2016-01-01", t1)))
  t2n <- as.numeric(as.POSIXct(paste("2016-01-01", t2)))
  }

  #calculate time-difference in seconds
  t2n - t1n 
}

然后我想使用“dplyr”中的“mutate”函数或“apply”函数将此函数应用于我的数据框，例如：

mutate(df, dur = TimeDiff(start_t, stop_t)) 

但结果是“dur”表填充了相同的值。我最终使用了一个笨重的 for 循环将我的函数应用于数据帧，但我想要一个更优雅的解决方案。需要帮助！

Answer 1

由于没有日期只有时间，确实存在实验跨越午夜的问题。您的函数不起作用，因为它没有矢量化，即它不会自行计算每个元素的差异。

以下工作，但仍然不是很优雅：

• 如果开始发生在结束之前，我们只需减去即可获得持续时间。
• 如果我们跨过午夜（对此的启发式算法不是很稳定），我们会计算直到午夜的差值并在第二天加上持续时间。

library(tidyverse)

diff_time <- function(start, end) {
  case_when(start < end ~ end - start,
            start > end ~ parse_time("23:59") - start + end + parse_time("0:01")
  )
}

df %>% 
  mutate_all(parse_time) %>% 
  mutate(duration = diff_time(start_t, stop_t))
#>    start_t   stop_t  duration
#> 1 07:35:00 07:48:00  780 secs
#> 2 23:50:00 00:15:00 1500 secs
#> 3 11:22:00 12:06:00 2640 secs

如果你有约会，你可以这样做：

df %>% 
  mutate(duration = stop_t - start_t)

数据

df <- read.table(text = "start_t      stop_t
      7:35      7:48
                 23:50     00:15
                 11:22     12:06", header = T)

Answer 2

我能想到的最简单的方法是润滑：

library(lubridate)
library(dplyr)

#make a fake df
df <- data.frame(start = c('7:35', '23:50', '11:22'), stop = c('7:48', '00:15', '12:06'), stringsAsFactors = FALSE)

#convert to lubridate minutes/seconds format, then subtract
df %>%
  mutate(start = ms(start), stop = ms(stop)) %>%
  mutate(dur= stop - start)

输出：

    start   stop       dur
1  7M 35S 7M 48S       13S
2 23M 50S    15S -23M -35S
3 11M 22S 12M 6S   1M -16S

您的情况的问题是第二行会混淆 lubridate - 它会显示 23 小时和几分钟，因为它会假设所有这些时间都在同一天。您可能应该添加日期：

library(lubridate)
library(dplyr)

#make a fake df
df <- data.frame(start = c('2017/10/08 7:35', '2017/10/08 23:50', '2017/10/08 11:22'), stop = c('2017/10/08 7:48', '2017/10/09 00:15', '2017/10/08 12:06'), stringsAsFactors = FALSE)

#convert to lubridate minutes/seconds format, then subtract
df %>%
  mutate(start = ymd_hm(start), stop = ymd_hm(stop)) %>%
  mutate(dur= stop - start)

输出：

                start                stop     dur
1 2017-10-08 07:35:00 2017-10-08 07:48:00 13 mins
2 2017-10-08 23:50:00 2017-10-09 00:15:00 25 mins
3 2017-10-08 11:22:00 2017-10-08 12:06:00 44 mins

Answer 3

当时间戳经过午夜时，日期可以递增。我不确定是否有必要只是为了测试 start 和 stop 是否跨越午夜。希望这会有所帮助！

df = data.frame(start_t = c("7:35", "23:50","11:22"), stop_t=c("7:48", "00:15", "12:06"), stringsAsFactors = F)

myfun = function(tvec1, tvec2, units_args="secs") {
  tvec1_t = as.POSIXct(paste("2016-01-01", tvec1))
  tvec2_t = as.POSIXct(paste("2016-01-01", tvec2))
  time_diff = difftime(tvec2_t, tvec1_t, units = units_args)
  return( time_diff )
}

# append new columns (base R)
df$time_diff = myfun(df$start_t, df$stop_t)
df$cross = ifelse(df$time_diff < 0, 1, 0)

输出：

  start_t stop_t   time_diff cross
1    7:35   7:48    780 secs     0
2   23:50  00:15 -84900 secs     1
3   11:22  12:06   2640 secs     0