public
Last active

  • Download Gist
piecewise_linear_reg.R
R
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24
library("strucchange")
library("lubridate")
 
set.seed(1234567)
N <- 60
df <- data.frame(id = 1:N)
df$date <- seq(as.Date("2013-07-01"), by = "day", along = df$id)
df$date2 <- difftime(df$date, ymd("2013-07-01"), units = "day")
df$date3 <- difftime(df$date, ymd("2013-08-01"), units = "day")
difftime(ymd("2013-08-01"), ymd("2013-07-01"), units = "day")
df$u <- 1 + 10 * rnorm(N)
alpha <- .5
df$y <- ifelse(df$date > as.Date("2013-08-01"), alpha * difftime(ymd("2013-08-01"), ymd("2013-07-01"), units = "day") + - 2 * as.numeric(df$date3) + df$u, alpha * as.numeric(df$date2) + df$u)
 
bp <- breakpoints(y ~ date, data = df, breaks = 1)
df$fit <- fitted(bp)
 
df$ideal <- ifelse(df$date > as.Date("2013-08-01"), alpha * difftime(ymd("2013-08-01"), ymd("2013-07-01"), units = "day") + - 2 * as.numeric(df$date3), alpha * as.numeric(df$date2))
 
ggplot(data = df, aes(x = date, y = y)) +
theme_bw() +
geom_point() +
geom_line(aes(y = fit), colour = "blue") +
geom_line(aes(y = ideal), colour = "red")

Please sign in to comment on this gist.

Something went wrong with that request. Please try again.