library(tidymodels)
## ── Attaching packages ────────────────────────────────────── tidymodels 1.1.1 ──
## ✔ broom        1.0.5      ✔ recipes      1.0.10
## ✔ dials        1.2.1      ✔ rsample      1.2.0 
## ✔ dplyr        1.1.4      ✔ tibble       3.2.1 
## ✔ ggplot2      3.4.4      ✔ tidyr        1.3.0 
## ✔ infer        1.0.6      ✔ tune         1.1.2 
## ✔ modeldata    1.3.0      ✔ workflows    1.1.4 
## ✔ parsnip      1.2.0      ✔ workflowsets 1.0.1 
## ✔ purrr        1.0.2      ✔ yardstick    1.3.0
## ── Conflicts ───────────────────────────────────────── tidymodels_conflicts() ──
## ✖ purrr::discard() masks scales::discard()
## ✖ dplyr::filter()  masks stats::filter()
## ✖ dplyr::lag()     masks stats::lag()
## ✖ recipes::step()  masks stats::step()
## • Dig deeper into tidy modeling with R at https://www.tmwr.org
library(tidyverse)
## ── Attaching core tidyverse packages ──────────────────────── tidyverse 2.0.0 ──
## ✔ forcats   1.0.0     ✔ readr     2.1.5
## ✔ lubridate 1.9.3     ✔ stringr   1.5.1
## ── Conflicts ────────────────────────────────────────── tidyverse_conflicts() ──
## ✖ readr::col_factor() masks scales::col_factor()
## ✖ purrr::discard()    masks scales::discard()
## ✖ dplyr::filter()     masks stats::filter()
## ✖ stringr::fixed()    masks recipes::fixed()
## ✖ dplyr::lag()        masks stats::lag()
## ✖ readr::spec()       masks yardstick::spec()
## ℹ Use the conflicted package (<http://conflicted.r-lib.org/>) to force all conflicts to become errors
library(vip)
## Warning: package 'vip' was built under R version 4.3.3
## 
## Attaching package: 'vip'
## 
## The following object is masked from 'package:utils':
## 
##     vi
titanic <- read_csv("C:/Users/edmic/Downloads/lab11_data/lab11_data/titanic.csv")
## Rows: 1043 Columns: 4
## ── Column specification ────────────────────────────────────────────────────────
## Delimiter: ","
## chr (3): pclass, survived, sex
## dbl (1): age
## 
## ℹ Use `spec()` to retrieve the full column specification for this data.
## ℹ Specify the column types or set `show_col_types = FALSE` to quiet this message.
titanic <- mutate(titanic, survived = factor(survived))
titanic
## # A tibble: 1,043 × 4
##    pclass survived sex       age
##    <chr>  <fct>    <chr>   <dbl>
##  1 1st    Yes      female 29    
##  2 1st    Yes      male    0.917
##  3 1st    No       female  2    
##  4 1st    No       male   30    
##  5 1st    No       female 25    
##  6 1st    Yes      male   48    
##  7 1st    Yes      female 63    
##  8 1st    No       male   39    
##  9 1st    Yes      female 53    
## 10 1st    No       male   71    
## # ℹ 1,033 more rows
## Question 1
table(titanic$survived)
## 
##  No Yes 
## 618 425
sum(618+425)
## [1] 1043
618/1043
## [1] 0.5925216
425/1043
## [1] 0.4074784
## Question 2
set.seed(123)
split <- initial_split(titanic, prop = .7, strata = "survived")
titanic_train <- training(split)
titanic_test <- testing(split)

lr_fit1 <- logistic_reg() %>%
  fit(survived ~ sex, data = titanic_train)
tidy(lr_fit1)
## # A tibble: 2 × 5
##   term        estimate std.error statistic  p.value
##   <chr>          <dbl>     <dbl>     <dbl>    <dbl>
## 1 (Intercept)     1.18     0.142      8.30 1.04e-16
## 2 sexmale        -2.63     0.186    -14.2  1.71e-45
lr_fit2 <- logistic_reg() %>%
  fit(survived ~ pclass, data = titanic_train)
tidy(lr_fit2)
## # A tibble: 3 × 5
##   term        estimate std.error statistic  p.value
##   <chr>          <dbl>     <dbl>     <dbl>    <dbl>
## 1 (Intercept)    0.589     0.148      3.98 6.81e- 5
## 2 pclass2nd     -0.904     0.208     -4.35 1.37e- 5
## 3 pclass3rd     -1.63      0.193     -8.46 2.62e-17
lr_fit3 <- logistic_reg() %>%
  fit(survived ~ age, data = titanic_train)
tidy(lr_fit3)
## # A tibble: 2 × 5
##   term        estimate std.error statistic p.value
##   <chr>          <dbl>     <dbl>     <dbl>   <dbl>
## 1 (Intercept) -0.185     0.173       -1.07   0.285
## 2 age         -0.00628   0.00521     -1.21   0.227
## Question 3
set.seed(123)
split <- initial_split(titanic, prop = .7, strata = "survived")
titanic_train <- training(split)
titanic_test <- testing(split)
## Qestion 4
set.seed(123)
kfold <- vfold_cv(titanic_train, v = 5)
results <- logistic_reg() %>%
  fit_resamples(survived ~ ., kfold)
collect_metrics(results)
## # A tibble: 2 × 6
##   .metric  .estimator  mean     n std_err .config             
##   <chr>    <chr>      <dbl> <int>   <dbl> <chr>               
## 1 accuracy binary     0.789     5  0.0111 Preprocessor1_Model1
## 2 roc_auc  binary     0.851     5  0.0121 Preprocessor1_Model1
## Question 5
final_fit <- logistic_reg() %>%
  fit(survived ~ ., data = titanic_train)
tidy(final_fit)
## # A tibble: 5 × 5
##   term        estimate std.error statistic  p.value
##   <chr>          <dbl>     <dbl>     <dbl>    <dbl>
## 1 (Intercept)   3.67     0.406        9.03 1.68e-19
## 2 pclass2nd    -1.43     0.275       -5.20 1.99e- 7
## 3 pclass3rd    -2.41     0.284       -8.49 2.03e-17
## 4 sexmale      -2.69     0.205      -13.1  2.33e-39
## 5 age          -0.0336   0.00775     -4.33 1.51e- 5
## Question 6
final_fit %>%
  predict(titanic_test) %>%
  bind_cols(titanic_test %>% select(survived)) %>%
  conf_mat(truth = survived, estimate = .pred_class)
##           Truth
## Prediction  No Yes
##        No  151  44
##        Yes  35  84
## Question 7
vip(final_fit$fit,num_features = 20)

## Part 2

## Question 1
boston<- read.csv("C:/Users/edmic/Downloads/lab11_data/lab11_data/boston.csv")
set.seed(123)
split <- initial_split(boston, prop = .7, strata = cmedv)
boston_train <- training(split)
boston_test <- testing(split)

## Question 2
boston_recipe <- recipe(cmedv ~ ., data = boston_train) %>%
  step_normalize(all_numeric_predictors()) %>%
  step_dummy(all_nominal_predictors())

## Question 3
ridge_mod <- linear_reg(penalty = .1, mixture = 0) %>%
  set_engine("glmnet")
ridge_wf <- workflow() %>%
  add_recipe(boston_recipe) %>%
  add_model(ridge_mod)
set.seed(123)
kfolds <- vfold_cv(boston_train, v = 5, strata = cmedv)
ridge_wf %>%
  fit_resamples(resamples = kfolds) %>%
  collect_metrics()
## Warning: package 'glmnet' was built under R version 4.3.3
## # A tibble: 2 × 6
##   .metric .estimator  mean     n std_err .config             
##   <chr>   <chr>      <dbl> <int>   <dbl> <chr>               
## 1 rmse    standard   4.95      5  0.179  Preprocessor1_Model1
## 2 rsq     standard   0.710     5  0.0342 Preprocessor1_Model1
## Question 4
lasso_mod <- linear_reg(penalty = .01, mixture = 1) %>%
  set_engine("glmnet")
lasso_wf <- workflow() %>%
  add_recipe(boston_recipe) %>%
  add_model(lasso_mod)
set.seed(123)
kfolds <- vfold_cv(boston_train, v = 5, strata = cmedv)
lasso_wf %>%
  fit_resamples(resamples = kfolds) %>%
  collect_metrics()
## # A tibble: 2 × 6
##   .metric .estimator  mean     n std_err .config             
##   <chr>   <chr>      <dbl> <int>   <dbl> <chr>               
## 1 rmse    standard   4.94      5  0.173  Preprocessor1_Model1
## 2 rsq     standard   0.710     5  0.0365 Preprocessor1_Model1
## Question 5
best_mod <- linear_reg(penalty = .01, mixture = 1) %>%
  set_engine("glmnet")
best_mod_wf <- workflow() %>%
  add_recipe(boston_recipe) %>%
  add_model(best_mod)
final_fit <- best_mod_wf %>%
  fit(data = boston_train)
final_fit %>%
  extract_fit_parsnip() %>%
  vip::vip()