binomial_expected_response_plot.R

---
title: "Expected Repsponse plot"
author: "Miles McBain"
date: "20 October 2016"
output: html_document
---



#Read Data
```{r}
#kaggle titanic data
library(readr)
titanic_data <- read_csv("./train.csv")
```

#Filter + Split Data
```{r}
titanic_data <-
  titanic_data %>%
  select(Survived, Pclass, Sex, Age)
library(caret)
train_idxs <- createDataPartition(titanic_data$Survived, p = 0.6, times = 1, list =  FALSE)
```

#Train Model
```{r}
titanic_glm <-
  glm(formula = Survived ~ .,
      data = titanic_data[train_idxs,],
      family = binomial(link="logit"))
```

#Examine model fit
```{r}
train_preds <- predict(titanic_glm, type = "response", newdata = titanic_data[train_idxs,])


comp_df <-  data_frame(
  linear_prediction = train_preds,
  response = titanic_data[train_idxs,]$Survived
)

comp_df %>%
  arrange(linear_prediction) %>%
  mutate(pc = ntile(linear_prediction,10)) %>%
  group_by(pc) %>%
  summarise(n_response_1 = sum(response), 
            exp_response_1 = sum(linear_prediction),
            exp_variance = sum(linear_prediction*(1-linear_prediction)) ) %>%
  ggplot() + geom_point(aes(x=exp_response_1,y=n_response_1)) +
  geom_errorbar(aes(y=n_response_1,
                    x=exp_response_1,
                    ymax = n_response_1 + 3*sqrt(exp_variance),
                    ymin = n_response_1 - 3*sqrt(exp_variance)
  )) + 
  geom_abline(slope = 1, intercept = 0)

```