R - Эффективный расчет времени, прошедшего между записями, на основе условия

У меня есть набор данных, состоящий из показаний монитора для системы отслеживания местоположения. К сожалению, я недостаточно опытен, чтобы воспроизвести его случайным образом, поэтому вот первые несколько записей:

  Time               TagID   MonitorID  Location
2017-10-31 23:03:26 1427435   1352303    A4.18
2017-10-31 23:06:02 1427435   1352303    A4.18
2017-10-31 23:06:20 1427435   1352303    A4.18
2017-10-31 23:06:50 1427435   1352303    A4.18
2017-10-31 23:06:51 1427435   1352303    A4.18
2017-10-31 23:07:20 1427435   1352303    A4.18
                      .
                      .
                      .
2017-11-22 22:29:55 1427435   1349044    B6.24
2017-11-22 22:30:22 1427435    286748    B6.41
2017-11-22 22:30:25 1427435   1349044    B6.24
2017-11-22 22:30:40 1427435    286748    B6.41
2017-11-22 22:30:41 1427435    286748    B6.41
2017-11-22 22:30:55 1427435   1349044    B6.24

Я пытаюсь определить время, которое метка RFID провела в определенном месте монитора, глядя на то, сколько времени прошло до изменения показаний MonitorID. Я делаю это с помощью этой функции, которую я написал:

elapsed_time <- function(x) {
  # Prepare variables
  current_monitor <- x$MonitorID[1]
  start_time <- x$Time[1]
  end_time <- NULL
  output <- data.frame("Date" = as.POSIXct(as.character()), "MonitorID" = as.integer(), 
                      "Minutes_elapsed" = as.integer())
  # For loop to iterate over rows
  for (i in 1:nrow(x)) {
    # if the new monitor is the same as the old one then go to next iteration
    # otherwise calculate the time between dates, add values to output
    if (x$MonitorID[i] == current_monitor & i != nrow(x)) {
      next
    } else {
      # Mark what the time is when the location changes
      end_time <- x$Time[i]
      # Calculate time difference
      time_spent <- difftime(end_time, start_time, units = "mins")
      # Create temporary data frame to append to output
      temp <- data.frame(start_time, current_monitor, time_spent)
      # Append temp to output
      output <- rbind(output, setNames(temp, names(output)))
      # Set the new start time to the current time
      start_time <- end_time
      # Set the current monitor tracker to the new monitor
      current_monitor <- x$MonitorID[i]
    }
  }
  # Add monitor mappings to output
  output <- left_join(output, Mmappings[,c(1,2)], by="MonitorID")
  return(output)
}

Последнюю строку можно игнорировать, она просто предназначена для переназначения фактического имени местоположения на показания MonitorID. Эта функция работает так, как хотелось бы, однако для работы только с одним монитором требуется очень много времени (~ 4 минуты), и я хотел бы использовать ее одновременно с примерно 95 мониторами в другой функции. Я уверен, что есть более эффективный способ написать эту функцию, чтобы сократить время.

РЕДАКТИРОВАТЬ: Вот пример вывода по запросу:

  Date                MonitorID Minutes_elapsed   Location
1 2017-10-31 23:03:26   1352303 3.36666667 mins    A4.18
2 2017-10-31 23:06:48         0 0.03333333 mins    A4.20
3 2017-10-31 23:06:50   1352303 0.45000000 mins    A4.18
4 2017-10-31 23:07:17         0 0.05000000 mins    A4.20
5 2017-10-31 23:07:20   1352303 0.45000000 mins    A4.18
6 2017-10-31 23:07:47         0 0.05000000 mins    A4.20

В этом случае время между изменениями невелико, поскольку иногда показания перескакивают на другие мониторы, но это не имеет значения.


person anthillcode    schedule 23.01.2018    source источник
comment
Не знаете, что мы пытаемся сделать, предоставьте ожидаемый результат для вашего примера ввода. Я предполагаю, что нет необходимости перебирать строки, может быть, увидеть функции lead/lag?   -  person zx8754    schedule 23.01.2018
comment
Не могли бы вы опубликовать немного больше данных с примерами изменения TagID и MonitorID, а также требуемый результат, который должны сделать эти данные?   -  person Andrew Chisholm    schedule 23.01.2018
comment
Я предоставил несколько примеров вывода и немного больше входных данных. Данные пропускаются, потому что в наборе данных много NA, которые не следует удалять.   -  person anthillcode    schedule 23.01.2018
comment
Взгляните на функцию dput(data[1:n,]).   -  person Christoph    schedule 23.01.2018
comment
@Кристоф, это действительно полезно для будущих постов, спасибо! Буду ли я в этом случае копировать вывод dput(data[1:20,]) в свой вопрос, чтобы люди могли легко воспроизвести образец набора данных?   -  person anthillcode    schedule 23.01.2018
comment
Да, это был бы вариант.   -  person Christoph    schedule 23.01.2018


Ответы (2)


Это помогает?

    library(tidyverse) # for easy data manipulation
    library(lubridate) # for dealing with dates

    # create the sample data
    myDf <- frame_data(
        ~Time,               ~TagID,   ~MonitorID,  ~Location,
        "2017-10-31 23:03:26", 1427435,   1352303,    "A4.18",
        "2017-10-31 23:06:02", 1427435,   1352303,    "A4.18",
        "2017-10-31 23:06:20", 1427435,   1352303,    "A4.18",
        "2017-10-31 23:06:50", 1427435,   1352303,    "A4.18",
        "2017-10-31 23:06:51", 1427435,   1352303,    "A4.18",
        "2017-10-31 23:07:20", 1427435,   1352303,    "A4.18",
        "2017-11-22 22:29:55", 1427435,   1349044,    "B6.24",
        "2017-11-22 22:30:22", 1427435,    286748,    "B6.41",
        "2017-11-22 22:30:25", 1427435,   1349044,    "B6.24",
        "2017-11-22 22:30:40", 1427435,    286748,    "B6.41",
        "2017-11-22 22:30:41", 1427435,    286748,    "B6.41",
        "2017-11-22 22:30:55", 1427435,   1349044,    "B6.24"
    )

    # make times times
    # and (important!) sort the dataframe
    myDf <- myDf %>%
        mutate(Time = as_datetime(Time)) %>%
        arrange(TagID, Time)

    myDf %>%
        mutate(priorIDtheSame = MonitorID == lag(MonitorID)) %>%
        mutate(priorIDtheSame = replace(priorIDtheSame, is.na(priorIDtheSame), FALSE)) %>%
        mutate(nextIDtheSame = MonitorID == lead(MonitorID)) %>%
        mutate(nextIDtheSame = replace(nextIDtheSame, is.na(nextIDtheSame), FALSE)) %>%
        # we simply remove all the rows inbetween first and last at one location
        filter(!(priorIDtheSame & nextIDtheSame)) %>%
        # calculate the time difference
        mutate(timeAtThisLocation = Time - lag(Time)) %>%
        # and make sure it is only calculated were we need it
        mutate(timeAtThisLocation = replace(timeAtThisLocation, !priorIDtheSame, NA))

Это приводит к

    # A tibble: 8 x 7
                     Time   TagID MonitorID Location priorIDtheSame nextIDtheSame timeAtThisLocation
                   <dttm>   <dbl>     <dbl>    <chr>          <lgl>         <lgl>             <time>
    1 2017-10-31 22:03:26 1427435   1352303    A4.18          FALSE          TRUE            NA secs
    2 2017-10-31 22:07:20 1427435   1352303    A4.18           TRUE         FALSE           234 secs
    3 2017-11-22 21:29:55 1427435   1349044    B6.24          FALSE         FALSE            NA secs
    4 2017-11-22 21:30:22 1427435    286748    B6.41          FALSE         FALSE            NA secs
    5 2017-11-22 21:30:25 1427435   1349044    B6.24          FALSE         FALSE            NA secs
    6 2017-11-22 21:30:40 1427435    286748    B6.41          FALSE          TRUE            NA secs
    7 2017-11-22 21:30:41 1427435    286748    B6.41           TRUE         FALSE             1 secs
    8 2017-11-22 21:30:55 1427435   1349044    B6.24          FALSE         FALSE            NA secs
person Georgery    schedule 23.01.2018
comment
Это помогло мне решить эту проблему! Пришлось внести несколько изменений, так как расчет времени должен быть между временем первой записи монитора и временем первой записи следующего монитора. Ваш способ рассчитал время между первым и последним появлением одного и того же монитора. Я поражен, насколько это быстрее. Он делает это за несколько секунд, а не за 4 минуты. Буду читать о том, как создаются функции dplyr, чтобы быть такими эффективными. Спасибо за помощь! - person anthillcode; 23.01.2018
comment
Функции Dplyr такие быстрые, потому что (i) они используют векторизацию и (ii) они частично запрограммированы на C (или C++ - точно не знаю). Вместо того, чтобы выяснять, почему, лучше потратьте время на то, чтобы понять, как их использовать. Веб-сайт/книга r4ds.had.co.nz Гролемунда и Уикхема очень поможет. - person Georgery; 23.01.2018

Я попытаюсь создать пример фрейма данных

df1<-data.frame(Time=c("2017-10-31 23:03:26","2017-10-31 23:06:02","2017-10-31 23:06:20","2017-10-31 23:06:50","2017-10-31 23:06:51",
                   "2017-10-31 23:07:20"),TagID=c(1427435,1427435,1427435,1427435,1427435,1427435),
           MonitorID=c(1352303,1352303,1352303,1352303,1352303,1352303),Location=c("A4.18","A4.18","A4.18","A4.18","A4.18","A4.18"))

df1$Time<-ymd_hms(df1$Time)
df2<-df1
df2$Time=df2$Time+minutes(30)
df2$MonitorID=df2$MonitorID+1
df2$Location<-"A4.19"
df<-rbind(df1,df2)

поэтому, если ваш фрейм данных похож на приведенный выше, вы можете рассчитать прошедшее время (в минутах) для каждого идентификатора монитора с помощью кода ниже:

result<-df%>%group_by(MonitorID)%>%summarize(ElapsedTime=difftime(tail(Time,1),head(Time,1)))
person Antonis    schedule 23.01.2018
comment
Было бы здорово, если бы было только одно наблюдение в день, но может случиться так, что монитор снова появится в другое время. Я хотел бы разделить разные показания, чтобы иметь возможность приблизиться к его пути в течение дня. - person anthillcode; 23.01.2018