Skip to content

Instantly share code, notes, and snippets.

@chrishanretty
Created January 16, 2018 19:30
Show Gist options
  • Star 0 You must be signed in to star a gist
  • Fork 1 You must be signed in to fork a gist
  • Save chrishanretty/9ba6f048cbb1263d8c7aea78748d7dd8 to your computer and use it in GitHub Desktop.
Save chrishanretty/9ba6f048cbb1263d8c7aea78748d7dd8 to your computer and use it in GitHub Desktop.
Segmented regression on Brexit Right-Wrong gap
library(segmented)
library(tidyverse)
dat <- structure(list(Pollster = structure(c(2L, 2L, 2L, 2L, 2L, 2L,
2L, 2L, 2L, 2L, 2L, 2L, 2L, 2L, 2L, 2L, 2L, 2L, 2L, 2L, 2L, 1L,
2L, 2L, 2L, 2L, 2L, 2L, 2L, 2L, 2L, 1L, 2L, 2L, 2L, 2L, 2L, 2L,
2L, 2L, 2L, 2L, 2L, 2L, 2L, 2L, 2L, 2L, 2L, 2L, 2L, 2L), .Label = c("Poll by gfk",
"Poll by YouGov"), class = "factor"), Fieldwork.end.date = structure(c(17539,
17520, 17511, 17505, 17478, 17463, 17459, 17458, 17450, 17433,
17409, 17400, 17379, 17366, 17358, 17339, 17330, 17324, 17317,
17311, 17303, 17300, 17296, 17289, 17282, 17277, 17275, 17269,
17262, 17252, 17246, 17240, 17239, 17225, 17219, 17210, 17197,
17184, 17176, 17170, 17154, 17140, 17134, 17120, 17094, 17086,
17058, 17044, 17036, 17030, 17022, 17015), class = "Date"), Right = c(0.42,
0.42, 0.44, 0.42, 0.42, 0.43, 0.42, 0.42, 0.42, 0.44, 0.44, 0.43,
0.45, 0.43, 0.45, 0.44, 0.44, 0.45, 0.44, 0.46, 0.46, 0.45, 0.44,
0.46, 0.43, 0.44, 0.46, 0.45, 0.46, 0.44, 0.44, 0.46, 0.44, 0.45,
0.45, 0.46, 0.45, 0.46, 0.46, 0.47, 0.44, 0.44, 0.44, 0.46, 0.45,
0.45, 0.46, 0.47, 0.45, 0.46, 0.45, 0.46), Wrong = c(0.46, 0.45,
0.45, 0.45, 0.46, 0.45, 0.44, 0.45, 0.47, 0.45, 0.44, 0.45, 0.45,
0.43, 0.43, 0.45, 0.45, 0.45, 0.45, 0.43, 0.43, 0.41, 0.45, 0.43,
0.45, 0.44, 0.43, 0.43, 0.42, 0.43, 0.44, 0.41, 0.42, 0.44, 0.45,
0.42, 0.42, 0.42, 0.42, 0.43, 0.44, 0.42, 0.45, 0.43, 0.44, 0.44,
0.43, 0.44, 0.43, 0.43, 0.44, 0.42), Don.t.know = c(0.12, 0.12,
0.11, 0.13, 0.12, 0.12, 0.14, 0.14, 0.11, 0.11, 0.12, 0.11, 0.1,
0.14, 0.12, 0.11, 0.11, 0.1, 0.11, 0.11, 0.11, 0.14, 0.11, 0.11,
0.12, 0.12, 0.11, 0.12, 0.11, 0.13, 0.12, 0.13, 0.15, 0.11, 0.1,
0.12, 0.12, 0.12, 0.13, 0.11, 0.12, 0.14, 0.11, 0.12, 0.11, 0.11,
0.11, 0.09, 0.12, 0.11, 0.12, 0.12), Gap = c(-4, -3, -1, -3,
-4, -2, -2, -3, -5, -1, 0, -2, 0, 0, 2, -1, -1, 0, -1, 3, 3,
4, -1, 3, -2, 0, 3, 2, 4, 1, 0, 5, 2, 1, 0, 4, 3, 4, 4, 4, 0,
2, -1, 3, 1, 1, 3, 3, 2, 3, 1, 4), daysSinceReferendum = structure(c(564,
545, 536, 530, 503, 488, 484, 483, 475, 458, 434, 425, 404, 391,
383, 364, 355, 349, 342, 336, 328, 325, 321, 314, 307, 302, 300,
294, 287, 277, 271, 265, 264, 250, 244, 235, 222, 209, 201, 195,
179, 165, 159, 145, 119, 111, 83, 69, 61, 55, 47, 40), origin = structure(16975, class = "Date")),
monthsSinceReferendum = structure(c(18.8, 18.1666666666667,
17.8666666666667, 17.6666666666667, 16.7666666666667, 16.2666666666667,
16.1333333333333, 16.1, 15.8333333333333, 15.2666666666667,
14.4666666666667, 14.1666666666667, 13.4666666666667, 13.0333333333333,
12.7666666666667, 12.1333333333333, 11.8333333333333, 11.6333333333333,
11.4, 11.2, 10.9333333333333, 10.8333333333333, 10.7, 10.4666666666667,
10.2333333333333, 10.0666666666667, 10, 9.8, 9.56666666666667,
9.23333333333333, 9.03333333333333, 8.83333333333333, 8.8,
8.33333333333333, 8.13333333333333, 7.83333333333333, 7.4,
6.96666666666667, 6.7, 6.5, 5.96666666666667, 5.5, 5.3, 4.83333333333333,
3.96666666666667, 3.7, 2.76666666666667, 2.3, 2.03333333333333,
1.83333333333333, 1.56666666666667, 1.33333333333333), origin = structure(16975, class = "Date"))), .Names = c("Pollster",
"Fieldwork.end.date", "Right", "Wrong", "Don.t.know", "Gap",
"daysSinceReferendum", "monthsSinceReferendum"), row.names = c(NA,
-52L), class = "data.frame")
p1 <- ggplot(dat, aes(Fieldwork.end.date, Gap)) +
scale_x_date("Date of fieldwork") +
scale_y_continuous("Brexit Right (%) - Wrong (%)") +
geom_hline(yintercept = 0, color = 'black') +
geom_point() +
geom_smooth() +
theme_bw()
summary(mod <- lm(Gap ~ monthsSinceReferendum, data = dat))
sobj <- segmented(mod, seg.Z =~monthsSinceReferendum, psi = c(5))
## Call: segmented.lm(obj = mod, seg.Z = ~monthsSinceReferendum, psi = c(5))
## Meaningful coefficients of the linear terms:
## (Intercept) monthsSinceReferendum U1.monthsSinceReferendum
## 2.40391 -0.03948 -0.60120
## Estimated Break-Point(s):
## psi1.monthsSinceReferendum
## 9.544
sobj$psi
## Initial Est. St.Err
## psi1.monthsSinceReferendum 5 9.543511 1.361382
Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment