R Notebook

Packages required:

library(tidymodels)
library(tidyverse)
library(AmesHousing)

Part 1

Import and Generalization RMSE

# a. Import the boston.csv data
boston <- read_csv("~/Library/CloudStorage/OneDrive-UniversityofCincinnati/UC Courses/Fall 2024/Data Mining/lab10_data/boston.csv")

Rows: 506 Columns: 16── Column specification ──────────────────────────────────────────────────────────────────────────────────
Delimiter: ","
dbl (16): lon, lat, cmedv, crim, zn, indus, chas, nox, rm, age, dis, rad, tax, ptratio, b, lstat
ℹ 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.

# b. Create a 70-30 train/test dataset split
set.seed(123)
split <- initial_split(boston, prop = 0.7, strata = cmedv)
boston_train <- training(split)
boston_test <- testing(split)

# c. Fit a multiple linear regression model using all predictors
boston_lm1 <- linear_reg() %>%
  fit(cmedv ~ ., data = boston_train)

# d. Compute the RMSE on the test data
boston_lm1 %>%
  predict(boston_test) %>%
  bind_cols(boston_test %>% select(cmedv)) %>%
  rmse(truth = cmedv, estimate = .pred)

# b. Create a 70-30 train/test dataset split
set.seed(123)
split <- initial_split(boston, prop = 0.7, strata = cmedv)
boston_train <- training(split)
boston_test <- testing(split)

# c. Fit a multiple linear regression model using all predictors
boston_lm1 <- linear_reg() %>%
  fit(cmedv ~ ., data = boston_train)

# d. Compute the RMSE on the test data
boston_lm1 %>%
  predict(boston_test) %>%
  bind_cols(boston_test %>% select(cmedv)) %>%
  rmse(truth = cmedv, estimate = .pred)

NA

Question 2:

# a. Create a recipe
mlr_recipe <- recipe(cmedv ~ ., data = boston_train) %>%
  step_YeoJohnson(all_numeric_predictors()) %>%
  step_normalize(all_numeric_predictors())

# b. Create a workflow object that contains the model and recipe
mlr_wflow <- workflow() %>%
  add_model(linear_reg()) %>%
  add_recipe(mlr_recipe)

# c. Train the model
mlr_fit <- mlr_wflow %>%
  fit(data = boston_train)

# d. Compute the RMSE on the test data
mlr_fit %>%
  predict(boston_test) %>%
  bind_cols(boston_test %>% select(cmedv)) %>%
  rmse(truth = cmedv, estimate = .pred)

NA

Question 3:

ames <- AmesHousing::make_ames()
set.seed(123) # for reproducibility
split <- initial_split(ames, prop = 0.7, strata = "Sale_Price")
ames_train <- training(split)
ames_test <- testing(split)
# Remove trouble variables
trbl_vars <- c("MS_SubClass", "Condition_2", "Exterior_1st",
"Exterior_2nd", "Misc_Feature")
ames_train_subset <- ames_train %>%
select(-trbl_vars)

Warning: Using an external vector in selections was deprecated in tidyselect 1.1.0.
Please use `all_of()` or `any_of()` instead.
# Was:
data %>% select(trbl_vars)

# Now:
data %>% select(all_of(trbl_vars))

See <https://tidyselect.r-lib.org/reference/faq-external-vector.html>.

# Train the model without the above trouble variables
ames_lm1 <- linear_reg() %>%
fit(Sale_Price ~ ., data = ames_train_subset)
# Compute test data generalization RMSE
ames_lm1 %>%
predict(ames_test) %>%
bind_cols(ames_test) %>%
rmse(truth = Sale_Price, estimate = .pred)

Warning: prediction from rank-deficient fit; consider predict(., rankdeficient="NA")

ames <- AmesHousing::make_ames()
set.seed(123) # for reproducibility
split <- initial_split(ames, prop = 0.7, strata = "Sale_Price")
ames_train <- training(split)
ames_test <- testing(split)

# a. Create a recipe with novel level lumping
mlr_recipe <- recipe(Sale_Price ~ ., data = ames_train) %>%
  step_other(all_nominal_predictors(), threshold = 0.01, other = "other")

# b. Create a workflow and train model
mlr_wflow <- workflow() %>%
  add_model(linear_reg()) %>%
  add_recipe(mlr_recipe)

mlr_fit <- mlr_wflow %>%
  fit(data = ames_train)

# c. Compute the RMSE on the test data
mlr_fit %>%
  predict(ames_test) %>%
  bind_cols(ames_test %>% select(Sale_Price)) %>%
  rmse(truth = Sale_Price, estimate =.pred)

Warning: prediction from rank-deficient fit; consider predict(., rankdeficient="NA")

Part 2

Question 1:

# a. import the Advertising.csv data
advertising <- read_csv("~/Library/CloudStorage/OneDrive-UniversityofCincinnati/UC Courses/Fall 2024/Data Mining/lab10_data/Advertising.csv")

Rows: 200 Columns: 4── Column specification ──────────────────────────────────────────────────────────────────────────────────
Delimiter: ","
dbl (4): TV, radio, newspaper, sales
ℹ 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.

# b. create a 70-30 train/test dataset split
set.seed(123)
split <- initial_split(advertising, prop = 0.7, strata = sales)
advertising_train <- training(split)
advertising_test <- testing(split)

Question 2:

# a. Create 10-fold cross-validation object
set.seed(123)
kfolds <- vfold_cv(advertising_train, v = 10, strata = sales)

# b. Create recipe with no feature engineering steps
mlr_recipe <- recipe(sales ~ ., data = advertising_train)

# c. Create workflow object with model and recipe
mlr_wflow <- workflow() %>%
  add_model(linear_reg()) %>%
  add_recipe(mlr_recipe)

# d. Fit our model across the 10-fold cross-validation
mlr_fit_cv <- mlr_wflow %>%
  fit_resamples(kfolds)

Question 3:

# Calculate the average cross-validation RMSE
collect_metrics(mlr_fit_cv) %>%
  filter(.metric == "rmse")

NA

Question 4:

# Range of cross-validation RMSE values across all folds
cv_rmse_range <- collect_metrics(mlr_fit_cv, summarize = FALSE) %>%
  filter(.metric == "rmse") %>%
  summarize(range_rmse = max(.estimate) - min(.estimate))

cv_rmse_range

NA

Question 5:

# Create bootstrap sample object
set.seed(123)
bs_samples <- bootstraps(advertising_train, times = 10, strata = sales)

# Fit our model across the bootstrapped samples
mlr_fit_bs <- mlr_wflow %>%
  fit_resamples(bs_samples)

Question 6:

# Calculate average bootstrap RMSE
mlr_fit_bs %>%
  collect_metrics(summarize = FALSE) %>%
  filter(.metric == "rmse") %>%
  summarize(avg_rmse = mean(.estimate))

NA

Question 7:

collect_metrics(mlr_fit_bs, summarize = FALSE) %>%
  filter(.metric == "rmse") %>%
  summarize(min_rmse = min(.estimate), max_rmse = max(.estimate))

NA