Добавить и изменить строки по заданному правилу - PullRequest
0 голосов
/ 03 июня 2018

У меня есть набор данных, который содержит идентификаторы и начальные даты.Я пытаюсь создать набор данных с идентификаторами и датами от начальной даты до сегодняшнего дня.

Мне удалось сделать это с помощью циклов, но это работает очень медленно.Есть ли решение в стиле R без циклов?

Это мой код:

library('lubridate')

names <- c('Andrey', 'Sergey', 'Voldemar')
starts <- c(dmy(01062018), dmy(29052018), dmy(27052018))
df <- data.frame(names, starts, stringsAsFactors = FALSE)
df$day_number <- as.integer(0)
df$cur_day <- df$starts

Итак, мы получили исходную таблицу, которая выглядит следующим образом:

     names     starts day_number    cur_day
1   Andrey 2018-06-01          0 2018-06-01
2   Sergey 2018-05-29          0 2018-05-29
3 Voldemar 2018-05-27          0 2018-05-27

Теперь я добавляю новые даты:

    for (row in 1:nrow(df)){
      start <- df$starts[row]
      lifetime <- interval(start,dmy(03062018))
      lifetime_days <- (int_length(lifetime) / 60 / 60 / 24) - 1
      if (lifetime_days <1) {next}
      df_temp <- data.frame(
        names = vector(length=lifetime_days),
        starts = vector(length=lifetime_days),
        day_number = vector(length=lifetime_days),
        cur_day = vector(length=lifetime_days)
      )
      df_temp$names <- as.character(df_temp$names)
      df_temp$starts <- ymd(df_temp$starts)
      df_temp$day_number <- as.integer(df_temp$day_number)
      df_temp$cur_day <- ymd(df_temp$cur_day)
      for (d in 1:lifetime_days){
        cur_day <- start + days(d)
        df_temp$names[d] <- df$names[row]
        df_temp$starts[d] <- start
        df_temp$day_number[d] <- d
        df_temp$cur_day [d] <- cur_day
      }


      df <- rbind(df, df_temp)
    }

    df <- df[order(df$names, df$day_number),]

    df

names     starts day_number    cur_day
1    Andrey 2018-06-01          0 2018-06-01
4    Andrey 2018-06-01          1 2018-06-02
2    Sergey 2018-05-29          0 2018-05-29
5    Sergey 2018-05-29          1 2018-05-30
6    Sergey 2018-05-29          2 2018-05-31
7    Sergey 2018-05-29          3 2018-06-01
8    Sergey 2018-05-29          4 2018-06-02
3  Voldemar 2018-05-27          0 2018-05-27
9  Voldemar 2018-05-27          1 2018-05-28
10 Voldemar 2018-05-27          2 2018-05-29
11 Voldemar 2018-05-27          3 2018-05-30
12 Voldemar 2018-05-27          4 2018-05-31
13 Voldemar 2018-05-27          5 2018-06-01
14 Voldemar 2018-05-27          6 2018-06-02

1 Ответ

0 голосов
/ 03 июня 2018
library(tidyverse)
library(lubridate)
df%>%
  group_by(names)%>%
  mutate(lifetime=int_length(interval(starts,dmy(03062018)))/3600/24 - 1,
         day_number=list(0:lifetime),
         cur_day=list(as.character(seq(starts,starts+lifetime,by="1 day"))))%>%
  select(-lifetime)%>%
  unnest()%>%
  mutate(cur_day=ymd(cur_day))    

 A tibble: 14 x 4
# Groups:   names [3]
   names    starts     day_number cur_day   
   <chr>    <date>          <int> <date>    
 1 Andrey   2018-06-01          0 2018-06-01
 2 Andrey   2018-06-01          1 2018-06-02
 3 Sergey   2018-05-29          0 2018-05-29
 4 Sergey   2018-05-29          1 2018-05-30
 5 Sergey   2018-05-29          2 2018-05-31
 6 Sergey   2018-05-29          3 2018-06-01
 7 Sergey   2018-05-29          4 2018-06-02
 8 Voldemar 2018-05-27          0 2018-05-27
 9 Voldemar 2018-05-27          1 2018-05-28
10 Voldemar 2018-05-27          2 2018-05-29
11 Voldemar 2018-05-27          3 2018-05-30
12 Voldemar 2018-05-27          4 2018-05-31
13 Voldemar 2018-05-27          5 2018-06-01
14 Voldemar 2018-05-27          6 2018-06-02
Добро пожаловать на сайт PullRequest, где вы можете задавать вопросы и получать ответы от других членов сообщества.
...