plot_marginal_effects <- function(covs, preds) {
cbind(covs, preds) %>%
tidyr::gather(alpha, prediction, -seq_len(NCOL(covs))) %>%
dplyr::mutate(prediction = as.numeric(prediction)) %>%
tidyr::gather(variable, value, -(alpha:prediction)) %>%
dplyr::mutate(value = as.numeric(value)) %>%
ggplot(aes(value, prediction, color = alpha)) +
geom_point(alpha = 0.15) +
geom_smooth(span = 0.5, se = FALSE) +
facet_wrap(~ variable, scale = "free_x") +
theme(legend.position = "none") +
theme(plot.margin = unit(c(0, 0, 0, 0), "mm")) +
xlab("")
}
## instant dteday season yr mnth holiday weekday workingday weathersit
## 1 1 2011-01-01 1 0 1 0 6 0 2
## 2 2 2011-01-02 1 0 1 0 0 0 2
## 3 3 2011-01-03 1 0 1 0 1 1 1
## 4 4 2011-01-04 1 0 1 0 2 1 1
## 5 5 2011-01-05 1 0 1 0 3 1 1
## 6 6 2011-01-06 1 0 1 0 4 1 1
## temp atemp hum windspeed casual registered cnt
## 1 0.344167 0.363625 0.805833 0.1604460 331 654 985
## 2 0.363478 0.353739 0.696087 0.2485390 131 670 801
## 3 0.196364 0.189405 0.437273 0.2483090 120 1229 1349
## 4 0.200000 0.212122 0.590435 0.1602960 108 1454 1562
## 5 0.226957 0.229270 0.436957 0.1869000 82 1518 1600
## 6 0.204348 0.233209 0.518261 0.0895652 88 1518 1606
See variable description on UCI web page.
ggplot(bikedata, aes(dteday, count)) +
geom_line() +
scale_x_date(labels = scales::date_format("%b %y")) +
xlab("date") +
ylab("rental count") +
stat_smooth(method = "lm", se = FALSE, linetype = "dashed") +
theme(plot.title = element_text(lineheight = 0.8, size = 20)) +
theme(text = element_text(size = 18))
lm_trend <- lm(count ~ instant, data = bikedata)
trend <- predict(lm_trend)
bikedata <- mutate(bikedata, count = count / trend)
ggplot(bikedata, aes(dteday, count)) +
geom_line() +
scale_x_date(labels = scales::date_format("%b %y")) +
xlab("date") +
ylab("detrended rental count") +
theme(plot.title = element_text(lineheight = 0.8, size = 20)) +
theme(text = element_text(size = 18))
## D-vine regression model: count | temperature, humidity, windspeed, month, season, weathersituation, workingday, weekday
## nobs = 731, edf = 57.55, cll = 414.62, caic = -714.15, cbic = -449.74
## var edf cll caic cbic p_value
## 1 count 9.596830 -198.076002 415.345665 459.437472 NA
## 2 temperature 21.973257 415.792064 -787.637614 -686.683385 1.101456e-161
## 3 humidity 17.935922 118.945590 -202.019336 -119.614295 2.152571e-40
## 4 windspeed 1.000000 22.862611 -43.725223 -39.130810 1.360595e-11
## 5 month 1.000000 13.914960 -25.829921 -21.235508 1.324616e-07
## 6 season 1.000000 11.353496 -20.706992 -16.112578 1.886801e-06
## 7 weathersituation 1.000000 12.049340 -22.098679 -17.504266 9.152305e-07
## 8 workingday 3.044168 13.401411 -20.714486 -6.728321 6.860982e-06
## 9 weekday 1.000000 4.381521 -6.763042 -2.168628 3.073960e-03
month_labs <- c("Jan","", "Mar", "", "May", "", "Jul", "", "Sep", "", "Nov", "")
plot_marginal_effects(covs = select(bikedata, month), preds = pred) +
scale_x_discrete(limits = 1:12, labels = month_labs)
plot_marginal_effects(covs = select(bikedata, weathersituation),
preds = pred) +
scale_x_discrete(limits = 1:3,labels = c("good", "medium", "bad"))
weekday_labs <- c("Mon", "Tue", "Wed", "Thu", "Fri", "Sat", "Sun")
plot_marginal_effects(covs = select(bikedata, weekday), preds = pred) +
scale_x_discrete(limits = 1:7, labels = weekday_labs)