Packages required:

library(kknn)
library(tidymodels)
Registered S3 method overwritten by 'data.table':
  method           from
  print.data.table     
── Attaching packages ────────────────────────────────────────────────────────────── tidymodels 1.2.0 ──
✔ broom        1.0.7     ✔ recipes      1.1.0
✔ dials        1.3.0     ✔ rsample      1.2.1
✔ dplyr        1.1.4     ✔ tibble       3.2.1
✔ ggplot2      3.5.1     ✔ tidyr        1.3.1
✔ infer        1.0.7     ✔ tune         1.2.1
✔ modeldata    1.4.0     ✔ workflows    1.1.4
✔ parsnip      1.2.1     ✔ workflowsets 1.1.0
✔ purrr        1.0.2     ✔ yardstick    1.3.1
── Conflicts ───────────────────────────────────────────────────────────────── tidymodels_conflicts() ──
✖ purrr::discard() masks scales::discard()
✖ dplyr::filter()  masks stats::filter()
✖ dplyr::lag()     masks stats::lag()
✖ recipes::step()  masks stats::step()
• Learn how to get started at https://www.tidymodels.org/start/

Q1: Is this a supervised or unsupervised learning problem? Why?

This is a supervised because we are using predictor variables to predict a known response variable (cmedv)

Q2: There are 16 variables in this data set. Which variable is the response variable and which variables are the predictor variables (aka features)?

cmedv is the response variable. All others are predictor variables

Q3: Is this a regression or classification problem?

This is a regression problem because the response variable cmedv is continuous

Q4: Import data set + Missing value + Statistic

boston <- readr::read_csv("~/Library/CloudStorage/OneDrive-UniversityofCincinnati/UC Courses/Fall 2024/Data Mining/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.
sum(is.na(boston))
[1] 0
summary(boston$cmedv)
   Min. 1st Qu.  Median    Mean 3rd Qu.    Max. 
   5.00   17.02   21.20   22.53   25.00   50.00 

Q5: Split data set:

set.seed(123)
split <- initial_split(boston, prop = 0.7, strata = cmedv)
train <- training(split)
test <- testing(split)

Q6: Number of observation in training set and test set:

nrow(train)  #training set
[1] 352
nrow(test)   #test set
[1] 154

Q7: Comparision the distribution of cmedv between 2 sets:

library(ggplot2)

# For the training set histogram
ggplot(train, aes(x = cmedv)) + 
  geom_histogram(binwidth = 1, fill = "blue", color = "black") + 
  ggtitle("Training Set cmedv Distribution")


# For the test set histogram
ggplot(test, aes(x = cmedv)) + 
  geom_histogram(binwidth = 1, fill = "red", color = "black") + 
  ggtitle("Test Set cmedv Distribution")

Q8: Fit a linear regression model with rm as the predictor

lm1 <- linear_reg() %>%
  fit(cmedv ~ rm, data = train)

lm1 %>%
  predict(new_data = test) %>%
  bind_cols(test %>% select(cmedv)) %>%
  rmse(truth = cmedv, estimate = .pred)

Q9:

lm2 <- linear_reg() %>%
  fit(cmedv ~ ., data = train)

lm2 %>%
  predict(new_data = test) %>%
  bind_cols(test %>% select(cmedv)) %>%
  rmse(truth = cmedv, estimate = .pred)

Q10:

knn <- nearest_neighbor() %>%
  set_engine("kknn") %>%
  set_mode("regression") %>%
  fit(cmedv ~ ., data = train)

# Compute the RMSE on the test data
knn %>%
  predict(new_data = test) %>%
  bind_cols(test %>% select(cmedv)) %>%
  rmse(truth = cmedv, estimate = .pred)
LS0tCnRpdGxlOiAiTW9kdWxlIExhYiA4IC0gSmFjayBWbyIKb3V0cHV0OiBodG1sX25vdGVib29rCi0tLQoKCiMjIyMgUGFja2FnZXMgcmVxdWlyZWQ6IApgYGB7cn0KbGlicmFyeShra25uKQpsaWJyYXJ5KHRpZHltb2RlbHMpCmBgYAoKIyMjIyBRMTogSXMgdGhpcyBhIHN1cGVydmlzZWQgb3IgdW5zdXBlcnZpc2VkIGxlYXJuaW5nIHByb2JsZW0/IFdoeT8gCgpUaGlzIGlzIGEgc3VwZXJ2aXNlZCBiZWNhdXNlIHdlIGFyZSB1c2luZyBwcmVkaWN0b3IgdmFyaWFibGVzIHRvIHByZWRpY3QgYSBrbm93biByZXNwb25zZSB2YXJpYWJsZSAoY21lZHYpCgoKIyMjIyBRMjogVGhlcmUgYXJlIDE2IHZhcmlhYmxlcyBpbiB0aGlzIGRhdGEgc2V0LiBXaGljaCB2YXJpYWJsZSBpcyB0aGUgcmVzcG9uc2UgdmFyaWFibGUgYW5kIHdoaWNoIHZhcmlhYmxlcyBhcmUgdGhlIHByZWRpY3RvciB2YXJpYWJsZXMgKGFrYSBmZWF0dXJlcyk/CgpjbWVkdiBpcyB0aGUgcmVzcG9uc2UgdmFyaWFibGUuIEFsbCBvdGhlcnMgYXJlIHByZWRpY3RvciB2YXJpYWJsZXMgCgoKIyMjIyBRMzogSXMgdGhpcyBhIHJlZ3Jlc3Npb24gb3IgY2xhc3NpZmljYXRpb24gcHJvYmxlbT8KClRoaXMgaXMgYSByZWdyZXNzaW9uIHByb2JsZW0gYmVjYXVzZSB0aGUgcmVzcG9uc2UgdmFyaWFibGUgY21lZHYgaXMgY29udGludW91cwoKCiMjIyMgUTQ6IEltcG9ydCBkYXRhIHNldCArIE1pc3NpbmcgdmFsdWUgKyBTdGF0aXN0aWMgCgpgYGB7cn0KYm9zdG9uIDwtIHJlYWRyOjpyZWFkX2Nzdigifi9MaWJyYXJ5L0Nsb3VkU3RvcmFnZS9PbmVEcml2ZS1Vbml2ZXJzaXR5b2ZDaW5jaW5uYXRpL1VDIENvdXJzZXMvRmFsbCAyMDI0L0RhdGEgTWluaW5nL2Jvc3Rvbi5jc3YiKQoKc3VtKGlzLm5hKGJvc3RvbikpCnN1bW1hcnkoYm9zdG9uJGNtZWR2KQpgYGAKCiMjIyMgUTU6IFNwbGl0IGRhdGEgc2V0OiAKYGBge3J9CnNldC5zZWVkKDEyMykKc3BsaXQgPC0gaW5pdGlhbF9zcGxpdChib3N0b24sIHByb3AgPSAwLjcsIHN0cmF0YSA9IGNtZWR2KQp0cmFpbiA8LSB0cmFpbmluZyhzcGxpdCkKdGVzdCA8LSB0ZXN0aW5nKHNwbGl0KQpgYGAKCiMjIyMgUTY6IE51bWJlciBvZiBvYnNlcnZhdGlvbiBpbiB0cmFpbmluZyBzZXQgYW5kIHRlc3Qgc2V0OiAKYGBge3J9Cm5yb3codHJhaW4pICAjdHJhaW5pbmcgc2V0Cm5yb3codGVzdCkgICAjdGVzdCBzZXQKYGBgCgojIyMjIFE3OiBDb21wYXJpc2lvbiB0aGUgZGlzdHJpYnV0aW9uIG9mIGNtZWR2IGJldHdlZW4gMiBzZXRzOiAKYGBge3J9CmxpYnJhcnkoZ2dwbG90MikKCiMgRm9yIHRoZSB0cmFpbmluZyBzZXQgaGlzdG9ncmFtCmdncGxvdCh0cmFpbiwgYWVzKHggPSBjbWVkdikpICsgCiAgZ2VvbV9oaXN0b2dyYW0oYmlud2lkdGggPSAxLCBmaWxsID0gImJsdWUiLCBjb2xvciA9ICJibGFjayIpICsgCiAgZ2d0aXRsZSgiVHJhaW5pbmcgU2V0IGNtZWR2IERpc3RyaWJ1dGlvbiIpCgojIEZvciB0aGUgdGVzdCBzZXQgaGlzdG9ncmFtCmdncGxvdCh0ZXN0LCBhZXMoeCA9IGNtZWR2KSkgKyAKICBnZW9tX2hpc3RvZ3JhbShiaW53aWR0aCA9IDEsIGZpbGwgPSAicmVkIiwgY29sb3IgPSAiYmxhY2siKSArIAogIGdndGl0bGUoIlRlc3QgU2V0IGNtZWR2IERpc3RyaWJ1dGlvbiIpCgpgYGAKCiMjIyMgUTg6IEZpdCBhIGxpbmVhciByZWdyZXNzaW9uIG1vZGVsIHdpdGggcm0gYXMgdGhlIHByZWRpY3RvcgpgYGB7cn0KbG0xIDwtIGxpbmVhcl9yZWcoKSAlPiUKICBmaXQoY21lZHYgfiBybSwgZGF0YSA9IHRyYWluKQoKbG0xICU+JQogIHByZWRpY3QobmV3X2RhdGEgPSB0ZXN0KSAlPiUKICBiaW5kX2NvbHModGVzdCAlPiUgc2VsZWN0KGNtZWR2KSkgJT4lCiAgcm1zZSh0cnV0aCA9IGNtZWR2LCBlc3RpbWF0ZSA9IC5wcmVkKQpgYGAKIyMjIyBROTogCmBgYHtyfQpsbTIgPC0gbGluZWFyX3JlZygpICU+JQogIGZpdChjbWVkdiB+IC4sIGRhdGEgPSB0cmFpbikKCmxtMiAlPiUKICBwcmVkaWN0KG5ld19kYXRhID0gdGVzdCkgJT4lCiAgYmluZF9jb2xzKHRlc3QgJT4lIHNlbGVjdChjbWVkdikpICU+JQogIHJtc2UodHJ1dGggPSBjbWVkdiwgZXN0aW1hdGUgPSAucHJlZCkKYGBgCiMjIyMgUTEwOiAKYGBge3J9CmtubiA8LSBuZWFyZXN0X25laWdoYm9yKCkgJT4lCiAgc2V0X2VuZ2luZSgia2tubiIpICU+JQogIHNldF9tb2RlKCJyZWdyZXNzaW9uIikgJT4lCiAgZml0KGNtZWR2IH4gLiwgZGF0YSA9IHRyYWluKQoKIyBDb21wdXRlIHRoZSBSTVNFIG9uIHRoZSB0ZXN0IGRhdGEKa25uICU+JQogIHByZWRpY3QobmV3X2RhdGEgPSB0ZXN0KSAlPiUKICBiaW5kX2NvbHModGVzdCAlPiUgc2VsZWN0KGNtZWR2KSkgJT4lCiAgcm1zZSh0cnV0aCA9IGNtZWR2LCBlc3RpbWF0ZSA9IC5wcmVkKQpgYGAKCgoKCgoKCgoKCgoK