R中时间序列数据的增长率

Question

library(ggplot2)
library(data.table)

set.seed(100)

# Making data table
date <- rep(1:10, each=10)
id <- rep(1:10, 10)
grp <- rep(1:2, each=5)

# Adding random body size per group and averaging
dt <- as.data.table(cbind(date, grp, id))
dt[grp==1, bodysize:=rnorm(50, mean=6)]
dt[grp==2, bodysize:=rnorm(50, mean=7)]
dt <- dt[, mean.Body:=mean(bodysize), list(date, grp)]

# Plot
ggplot(data=dt, aes(x=date, y=mean.Body, group=grp)) + 
  geom_line(position="identity", aes(color=as.factor(grp)), size= 2, linetype= 2) +
  geom_point(size=2) +
  theme_minimal() + 
  labs(x= "Date", y= "Body size (mm)", color="Group" )

我的问题是如何实现一个函数来计算数据表中个人几天内的增长率。这是形态学数据，因此增长率将计算为 log(body size day(i)) - log(body size day (i-1))。换句话说，（今天的体型）-（昨天的体型）。我每组有 5 个人，为期 10 天。找出每个人每天的增长率是这篇文章的目标，并重新创建发布的图表，但每天的增长率。附上一些模拟数据。

任何建议将不胜感激。

Answer 1

好吧，我不擅长data.table，但这是tidyverse的尝试。

首先，我会重新制作你的数据。

library(tidyverse)

set.seed(100)

# Making data
date <- rep(1:10, each=10)
id <- rep(1:10, 10)
grp <- rep(1:2, each=5)

df <- cbind(date, grp, id) %>% 
  as_tibble %>%
  rowwise %>%
  mutate(bodysize = rnorm(1, mean = 5 + grp)) %>%
  ungroup

我想不出比 pivot_wider 更好的解决方案，按个人进行延迟，然后转回长格式，以使延迟正常工作：

result <- df %>% 
  pivot_wider(names_from = c(grp, id), 
              values_from = bodysize) %>%
  mutate_at(vars(-date), 
            list(growth = ~. - lag(.))) %>%
  pivot_longer(-date, names_to = c("grp", "id"), 
               names_pattern = "([0-9]+)_([0-9]+)",
               values_to = "growth") %>%
  filter(!is.na(growth))

现在，我有点不确定你想要的情节是什么。您提到了 5 个个人，但您有 10 个 id。如果我们分别绘制它们，情节会有点混乱，但您可以使用aes 来分隔每一行。

# Plot
ggplot(result, 
       aes(x = date, y = growth, group = id)) + 
  geom_line(position = "identity", 
            aes(color = as.factor(grp)), size = 2, linetype = 2) +
  geom_point(size = 2) +
  theme_minimal() + 
  labs(x = "Date", y = "Body size (mm)", color = "Group" )

或者，如果您愿意，我们当然可以对每个组的每个 id 进行平均以获得更整洁的图：

# Alternative plot
ggplot(result %>% group_by(date, grp) %>% summarise(grp_mean = mean(growth)), 
       aes(x = date, y = grp_mean, group = grp)) + 
  geom_line(position = "identity", 
            aes(color = as.factor(grp)), size = 2, linetype = 2) +
  geom_point(size = 2) +
  theme_minimal() + 
  labs(x = "Date", y = "Body size (mm)", color = "Group")

^{由reprex package (v0.2.1) 于 2019 年 12 月 6 日创建}

（为了更好的尝试而完全编辑。）