创建月度数据和扩展数据答案

【问题标题】：Creating monthly data and expanding data创建月度数据和扩展数据
【发布时间】：2017-11-15 07:30:50
【问题描述】：

我有一个数据框，我想根据以下数据集创建一个不平衡面板。

 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，对于 myear 01-2008 编码为 01，对于 02-2008 编码为 02 ....so on 12-2009 as 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     
 ...          ...           ...          ..

【问题讨论】：

标签： r dplyr tidyr

【解决方案1】：

此解决方案基于 tidyverse、lubridate 和 stringr 中的函数。

更新

我误解了tid 的定义。现在代码应该按预期计算tid。 tid 显示记录总数，但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)

【讨论】：

【解决方案2】：

我知道您已经接受了答案，但为了完整起见，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")]

【讨论】：

【解决方案3】：

这是一个想法。首先确保您的日期是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

【讨论】：

我收到此错误。 seq.default(x, y, by = "months") 中的错误：'from' 不能是 NA、NaN 或无限。有什么建议吗？
配置文件的类应该是什么？我的是一个列表。请建议
太棒了！它起作用了，2008-01 的 tid 应该是 1，如果 start_date 是 2008-02，对于某些列，我仍然将第一个数字设为 1 而不是 2。任何建议如何获得正确的 tid？例如，在我显示的输出中查看 john profile
是的，但它从开始日期开始，例如，如果一个人在 2008 年 1 月创建了他的个人资料，那么 tid 将为 1，（例如 lehman），另一方面，如果个人资料是在 2008 年 2 月创建的，那么它应该是 2。
我收到此错误。 seq.default(x, length.out = y) 中的错误：'from' 不能是 NA、NaN 或无限

【解决方案4】：

这是完成任务的另一种可能方式。我正在关注您的示例数据。对于profile 中的所有名称，您都有相同的end_date，即2009 年12 月31 日。最早的start_date 是2008 年1 月1 日。这两件事是我对以下代码的假设。因此，如果您的数据与示例数据不同，则以下内容将不好。

我尝试使用do() 创建日期序列。由于我使用了group_by()，所以start_date和end_date按照myear的长度重复。在这里，我按月创建了一系列日期，并将日期转换为您指定的格式，即年和月（例如，01-2008）。 myear 是，因此，在字符。有一次，这项工作完成后，我创建了tid。不管怎样，profile 中所有级别的结束编号都是 24。所以我做了简单的数学运算。您想知道profile 的每个级别存在多少行。让我们看看毕加索。 start_date 是 2009 年 2 月，这是从 2008 年 1 月算起的第 14 个月。因此，picaso 有 11 行，这意味着 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

数据

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")

【讨论】：