我有一个数据框,我想基于以下数据集创建一个不平衡的面板。
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
... ... ... ..
答案 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_date
和end_date
按myear
的长度重复。在这里,我按月创建了一系列日期,并将日期转换为您指定的格式,即年和月(例如,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)
此解决方案基于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)
答案 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")]