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()
