创建月度数据和扩展数据

时间:2017-06-13 13:23:58

标签: r dplyr tidyr

我有一个数据框,我想基于以下数据集创建一个不平衡的面板。

 profile<- c('lehman', 'john','oliver','stephen','picasso')
 start_date<-   c(2008-01-01, 2008-02-02,2008-04-02,2008-09-02,2009-02-02)
 end_date <-   c (2009-12-31, 2009-12-31, 2009-12-31,2009-12-31,2009-12-31)
 df<- data.frame(profile,start_date,end_date)

我想创建两列tid和myear。 Myear基本上是从开始日期开始的月份,并且基于月份直到最后结束日期不断扩展。然后我需要一个tid,其编号为01,用于myear 01-2008,02用于02-2008 ....所以12-2009为24.有人可以建议如何做到这一点吗?这是预期的输出。

 profile      start_date    end_date     tid   myear
 lehman       2008-01-01    2009-12-31   01   01-2008
 lehman       2008-01-01    2009-12-31   02   02-2008
 ...          ..            ..           ..
 lehman       2008-01-01    2009-12-31   24   12-2009
 john         2008-02-02    2009-12-31   02   02-2008
 john         2008-02-02    2009-12-31   03   03-2008
 ..           ..             ..          ..
 john         2008-02-02    2009-12-31   24   12-2009
 ...          ..            ...          ..
 picasso      2009-02-02    2009-12-31   14   02-2009
 picasso      2009-03-02    2009-12-31   15   03-2009     
 ...          ...           ...          ..

4 个答案:

答案 0 :(得分:5)

这是一个想法。首先确保您的日期为as.Date(即df[2:3] <- lapply(df[2:3], function(i) as.Date(i, format = '%Y-%m-%d'))。然后创建一个列表,其中包含开始日期和结束日期之间的每月序列。计算该列表的长度并使用它们来扩展数据框。添加日期序列作为新列,并根据每个配置文件的长度创建tid

seq_lst <- lapply(Map(function(x, y) seq(x, y, by = 'months'), 
                      df$start_date, df$end_date), function(i) format(i, '%m-%Y'))

df <- df[rep(seq_len(nrow(df)), lengths(seq_lst)),]

df$myear <- unlist(seq_lst)

i1 <- setNames(seq(length(seq_lst[[1]])), seq_lst[[1]])
df$tid <- sprintf('%02d', i1[match(df$myear, names(i1))])

head(df)
#    profile start_date   end_date   myear tid
#1    lehman 2008-01-01 2009-12-31 01-2008  01
#1.1  lehman 2008-01-01 2009-12-31 02-2008  02
#1.2  lehman 2008-01-01 2009-12-31 03-2008  03
#1.3  lehman 2008-01-01 2009-12-31 04-2008  04
#1.4  lehman 2008-01-01 2009-12-31 05-2008  05
#1.5  lehman 2008-01-01 2009-12-31 06-2008  06

答案 1 :(得分:2)

这是实现任务的另一种可能方式。我正在关注您的示例数据。对于profile中的所有姓名,您都拥有相同的end_date,即2009年12月31日。最早的start_date是2008年1月1日。这两件事都在我的身上以下代码的假设。因此,如果您的数据与样本数据不同,则以下情况不会很好。

我尝试使用do()创建日期序列。自从我使用group_by()后,start_dateend_datemyear的长度重复。在这里,我按月创建了一系列日期,并将日期转换为您指定的格式,即年和月(例如,01-2008)。因此,myear具有特色。有一次,这项工作完成了,我创建了tid。无论如何,profile中所有级别的结束数字为24。所以我做了简单的数学。您想知道每个profile级别存在多少行。让我们来看看毕加索吧。 start_date是2009年2月,也就是从2008年1月起计算的第14个月。所以你有8行picaso,这意味着n()= 11.因此,(1 +(24 - 11)):24创建一个数字序列从14开始到24结束。我留下了你下面的部分输出。

library(dplyr)

group_by(df, profile) %>%
do(data.frame(start_date = .$start_date,
              end_date = .$end_date,
              myear = format(seq(from = .$start_date, to = .$end_date, by = "months"),
                             "%m-%Y")
             )
   ) %>%
mutate(tid = (1 + (24 - n())):24)

#69 picasso 2009-02-02 2009-12-31 02-2009  14
#70 picasso 2009-02-02 2009-12-31 03-2009  15
#71 picasso 2009-02-02 2009-12-31 04-2009  16
#72 picasso 2009-02-02 2009-12-31 05-2009  17
#73 picasso 2009-02-02 2009-12-31 06-2009  18
#74 picasso 2009-02-02 2009-12-31 07-2009  19
#75 picasso 2009-02-02 2009-12-31 08-2009  20
#76 picasso 2009-02-02 2009-12-31 09-2009  21
#77 picasso 2009-02-02 2009-12-31 10-2009  22
#78 picasso 2009-02-02 2009-12-31 11-2009  23
#79 picasso 2009-02-02 2009-12-31 12-2009  24

DATA

structure(list(profile = structure(c(2L, 1L, 3L, 5L, 4L), .Label = c("john", 
"lehman", "oliver", "picasso", "stephen"), class = "factor"), 
start_date = structure(c(1199113200, 1201878000, 1207062000, 
1220281200, 1233500400), class = c("POSIXct", "POSIXt"), tzone = ""), 
end_date = structure(c(1262185200, 1262185200, 1262185200, 
1262185200, 1262185200), class = c("POSIXct", "POSIXt"), tzone = "")), .Names = c("profile", 
"start_date", "end_date"), row.names = c(NA, -5L), class = "data.frame")

答案 2 :(得分:1)

此解决方案基于tidyverselubridatestringr的功能。

更新

我误解了tid的定义。现在代码应按预期计算tidtid显示的是记录总数,但tid的开头是最早年份的最早月份,而myear则是将月份和年份信息合并在一起。

library(tidyverse)
library(lubridate)
library(stringr)    

df2 <- df %>%
  mutate(start_date = ymd(start_date), end_date = ymd(end_date)) %>%
  mutate(start_year = year(start_date), end_year = year(end_date),
         start_month = month(start_date), end_month = month(end_date)) %>%
  mutate(Year = map2(start_year, end_year, `:`)) %>%
  unnest() %>%
  group_by(profile) %>%
  mutate(first_year = ifelse(Year == min(Year), TRUE, FALSE),
         last_year = ifelse(Year == max(Year), TRUE, FALSE)) %>%
  mutate(start_month = ifelse(!first_year, 1, start_month),
         end_month = ifelse(!last_year, 12, end_month)) %>%
  mutate(Month = map2(start_month, end_month, `:`)) %>%
  unnest() %>%
  mutate(endid = n() + Month - 1) %>%
  mutate(tid = first(Month):first(endid)) %>%
  mutate(Multiple_Year = ifelse(length(unique(Year)) > 1, TRUE, FALSE)) %>%
  ungroup() %>%
  mutate(tid = ifelse(Year > min(Year) & !Multiple_Year,
                      tid + 12 * (Year - min(Year)), tid)) %>%
  mutate(tid = str_pad(tid, width = 2, pad = "0")) %>%
  mutate(Month = str_pad(Month, width = 2, pad = "0")) %>%
  mutate(myear = paste(Month, Year, sep = "-")) %>%
  select(profile, start_date, end_date, tid, myear)

输出

现在检查输出df2的一部分,看看代码是否按预期工作。

雷曼的前两行

df2 %>%
  filter(profile %in% "lehman") %>%
  head(2)

    # A tibble: 2 x 5
  profile start_date   end_date   tid   myear
   <fctr>     <date>     <date> <chr>   <chr>
1  lehman 2008-01-01 2009-12-31    01 01-2008
2  lehman 2008-01-01 2009-12-31    02 02-2008

雷曼的最后一排

df2 %>%
  filter(profile %in% "lehman") %>%
  tail(1)

# A tibble: 1 x 5
  profile start_date   end_date   tid   myear
   <fctr>     <date>     <date> <chr>   <chr>
1  lehman 2008-01-01 2009-12-31    24 12-2009

前两排毕加索

df2 %>% 
  filter(profile %in% "picasso") %>% 
  head(2)  

# A tibble: 2 x 5
  profile start_date   end_date   tid   myear
   <fctr>     <date>     <date> <chr>   <chr>
1 picasso 2009-02-02 2009-12-31    14 02-2009
2 picasso 2009-02-02 2009-12-31    15 03-2009

数据准备

profile <- c('lehman', 'john','oliver','stephen','picasso')
start_date <- c("2008-01-01", "2008-02-02", "2008-04-02", "2008-09-02", "2009-02-02")
end_date <- c("2009-12-31", "2009-12-31", "2009-12-31", "2009-12-31", "2009-12-31")
df <- data.frame(profile,start_date,end_date)

答案 3 :(得分:0)

我知道你已经接受了答案,但为了完整起见,data.table方法也有效:

dt <- data.table(df)
dt.l <- setDT(dt)[ , list(myear = seq(start_date, end_date, by = "1 month"), by = profile]
dt.l <- dt.l[ ,tid := ifelse(as.numeric(year(myear)) > 2008, as.numeric(month(myear)) + 12, as.numeric(month(myear)))]
dt.l <- setDT(dt.l)[, myear := format(as.Date(myear), "%Y-%m")]