В качестве ответа на ваш главный вопрос ... попробуйте это. Я просто присоединил время удвоения к вашему основному дф и создал новый вариант, в котором нет. недели и удвоения времени. Затем цвет сопоставляется с этой новой переменной.
Относительно вашего второго вопроса: есть способы вычислить наклон из вычисленных значений geom_smooth / stat_smooth. Однако, по моему мнению, ваш подход к вычислению уклонов - это более простой способ решения проблемы, которую вы пытаетесь решить.
library(ggplot2)
library(dplyr)
library(gridExtra)
# Input data: Daily number of cases starting at day0
cases <- c(1,1,2,3,7,10,13,16,24,38,51,62,85,116,150,202,240,274,402,554,709, 927)
day0 <- as.Date("2020-03-04")
# actual dates by counting from day0
dates <- day0 + 1:length(cases)
# week number as factor to obtain regression line for each week
week <- as.factor(1 + (1:length(cases) ) %/% 7)
# tibble with daily data, also with week number
datatib <- tibble( dates, cases, week)
# tibble with computed doubling time per week
resulttib <- tibble(Week=unique(week), Doubling_Time=NA)
# linear regression on log of dependent variable
for (wk in unique(week) ) {
resulttib[wk,'Doubling_Time'] <-
round( log(2) / lm(log(cases) ~ dates, data=datatib[week==wk,] )$coef['dates'], 2 )
}
# insert row at top for second line of column heading
#resulttib <- add_row(resulttib, Week = '', Doubling_Time = '(days)', .before = 1)
#doublingtime = tableGrob(resulttib[,'Doubling_Time'], rows=NULL)
datatib1 <- datatib %>%
left_join(resulttib, by = c("week" = "Week")) %>%
mutate(week1 = paste0(week, " (", Doubling_Time, ")"))
gp <-
ggplot(datatib1, aes(dates, cases, color = week1 ) ) +
geom_point() +
geom_smooth( method = "lm", se = FALSE) +
scale_x_date() +
scale_y_continuous(trans="log10") +
labs(x = "", y = "Number of Cases") +
ggtitle("Number of Cases with Weekly Doubling Times") +
theme(plot.title = element_text(hjust = 0.5)) +
theme(
legend.position = c(.95, .05),
legend.justification = c("right", "bottom"),
legend.box.just = "right",
legend.margin = margin(6, 6, 6, 6)
) +
labs(color = "Week (Doubling time in days)")
gp
Создано в 2020 году -03-27 представьте пакет (v0.3.0)