forked from matackett/sta199-sp19-website
-
Notifications
You must be signed in to change notification settings - Fork 4
/
sta210-sticker.Rmd
88 lines (73 loc) · 2.5 KB
/
sta210-sticker.Rmd
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
---
title: "STA 210 Sticker"
author: "Maria Tackett"
date: "12/30/2018"
output: github_document
---
```{r setup, include=FALSE}
knitr::opts_chunk$set(echo = TRUE,
warning=FALSE,
message=FALSE)
```
This document contains the code to make the sticker for [STA 210: Regression Analysis](https://www2.stat.duke.edu/courses/Spring19/sta210.001/). The following packages are used in this project:
```{r packages}
library(hexSticker)
library(readr)
library(tidyverse)
library(tibble)
library(showtext)
library(nnet)
library(knitr)
```
## The Data
The data is the [Capital Bikeshare data set](https://archive.ics.uci.edu/ml/datasets/bike+sharing+dataset) pulled from the UCI Machine Learning Repository. The following variables are used in this project:
- `season`: 1 - Winter, 2 - Spring, 3 - Summer 4 - Fall
- `atemp`: feeling temperature ÷ 50 (in degrees Celsius)
<br>
```{r data}
bikeshare <- read_csv("https://raw.githubusercontent.com/matackett/data/master/capital-bikeshare.csv")
bikeshare <- bikeshare %>%
mutate(season = case_when(
season==1 ~ "Winter",
season==2 ~ "Spring",
season==3 ~ "Summer",
season==4 ~ "Fall"
)) %>%
select(season,atemp)
```
## Fit Model
A multinomial logistic regression model is used to create the main plot. The response variable is `season` and the predictor variable is `atemp`.
```{r multinom-logistic}
# fit multinomial logistic model
# add predicted probabilities to bikeshare data
m <- multinom(season ~ atemp,data=bikeshare)
pred <- as.data.frame(predict.glm(m,type="response"))
bikeshare <- bind_cols(bikeshare,pred)
```
## Make Sticker
```{r plot}
# plot predicted probabilites versus atemp
p <- ggplot(data=bikeshare,aes(x=atemp)) +
geom_line(aes(y=Winter),color="#00BFC4") +
geom_line(aes(y=Spring),color="#F8766D") +
geom_line(aes(y=Summer),color="#C77CFF") +
geom_line(aes(y=Fall),color="#7CAE00") +
theme_minimal() +
theme(axis.title=element_blank(),
axis.text.x=element_blank(),
axis.text.y=element_blank())
```
```{r add-font}
# add font to be used in sticker function
font_add_google("Open Sans", "open")
```
```{r make-sticker}
# create and save sticker
sticker(p, package="STA 210",p_color="#00797C", p_family="open", p_size=7.5, s_x=1, s_y=0.75, s_width=1.2, s_height=1, h_fill = "#FFFFFF",
h_color="#00797C", h_size =0.8,
filename="static/img/sta210_sticker.png")
```
```{r display-sticker}
#display final sticker
include_graphics("static/img/sta210_sticker.png")
```