wbcd %>% filter(is_na(diagnosis))
wbcd %>% filter(is.na(diagnosis))
wbcd_split <- initial_split(wbcd, prop = 0.8)
wbcd_split
wbcd_train <- training(wbcd_split)
head(wbcd_train)
wbcd_test <- testing(wbcd_split)
head(wbcd_test)
wbcd %>% count(diagnosis) %>%
mutate(prop = n/sum(n))
wbcd_train %>% count(diagnosis) %>%
mutate(prop = n/sum(n))
wbcd_test %>% count(diagnosis) %>%
mutate(prop = n/sum(n))
wbcd %>% select(diagnosis, ends_with("mean")) %>%
ggpairs(aes(color = diagnosis))
wbcd_rec <-
recipe(diagnosis ~ ., data = wbcd_train) %>%
step_normalize(all_predictors()) %>%
prep()
wbcd_rec
summary(wbcd_rec)
tune_spec <-
nearest_neighbor(neighbors = tune()) %>%
set_engine("kknn") %>%
set_mode("classification")
tune_spec <-
nearest_neighbor(neighbors = tune()) %>%
set_engine("kknn") %>%
set_mode("classification")
tune_grid <- seq(5, 23, by = 2)
tune_grid
wbcd_wflow <-
workflow() %>%
add_recipe(wbcd_rec) %>%
add_model(tune_spec)
wbcd_wflow
folds <- vfold_cv(wbcd_train, v = 10)
folds
wbcd_fit_rs <-
wbcd_wflow %>%
tune_grid(
resamples = folds,
grid = tune_grid
)
wbcd_fit_rs <-
wbcd_wflow %>%
tune_grid(
resamples = folds,
grid = tune_grid
)
collect_metrics(wbcd_fit_rs)
wbcd_fit_rs %>%
show_best("accuracy")
knn_training_pred <-
predict(knn_fit, wbcd_train_prep) %>%
bind_cols(predict(knn_fit, wbcd_train_prep, type = "prob")) %>%
# Add the true outcome data back in
bind_cols(wbcd_train_prep %>%
select(diagnosis))
collect_metrics(wbcd_fit_rs)
wbcd_fit_rs %>%
show_best("accuracy")
best_knn <- wbcd_fit_rs %>%
select_best("accuracy")
best_knn
final_wflow <-
wbcd_wflow %>%
finalize_workflow(best_knn)
final_knn <-
final_wflow %>%
last_fit(wbcd_split)
final_knn %>%
collect_metrics()
source("~/classes/2022-2023/Spring_2023/Stat652/Projects/Chap03/MLwR_v2_03.r", echo=TRUE)
##### Chapter 3: Classification using Nearest Neighbors --------------------
## Example: Classifying Cancer Samples ----
## Step 2: Exploring and preparing the data ----
# import the CSV file
wbcd <- read.csv("wisc_bc_data.csv", stringsAsFactors = FALSE)
# examine the structure of the wbcd data frame
str(wbcd)
# drop the id feature
wbcd <- wbcd[-1]
# table of diagnosis
table(wbcd$diagnosis)
# recode diagnosis as a factor
wbcd$diagnosis <- factor(wbcd$diagnosis, levels = c("B", "M"),
labels = c("Benign", "Malignant"))
# table or proportions with more informative labels
round(prop.table(table(wbcd$diagnosis)) * 100, digits = 1)
# summarize three numeric features
summary(wbcd[c("radius_mean", "area_mean", "smoothness_mean")])
# create normalization function
normalize <- function(x) {
return ((x - min(x)) / (max(x) - min(x)))
}
# test normalization function - result should be identical
normalize(c(1, 2, 3, 4, 5))
normalize(c(10, 20, 30, 40, 50))
# normalize the wbcd data
wbcd_n <- as.data.frame(lapply(wbcd[2:31], normalize))
# confirm that normalization worked
summary(wbcd_n$area_mean)
# create training and test data  ## Do not do this!!!
wbcd_train <- wbcd_n[1:469, ]
wbcd_test <- wbcd_n[470:569, ]
# create labels for training and test data
wbcd_train_labels <- wbcd[1:469, 1]
wbcd_test_labels <- wbcd[470:569, 1]
# visualize the data using labels
plot(wbcd$radius_mean,wbcd$texture_mean,
main = 'Scatterplot',
xlab = 'randius mean',
ylab = 'texture mean')
pairs(~radius_mean+texture_mean+perimeter_mean+area_mean+smoothness_mean,
data = wbcd,
main = 'Scaterplot of many variables')
library(car)
scatterplot(texture_mean ~ radius_mean | diagnosis, data = wbcd,
main = 'Scatterplot',
xlab = 'randius mean',
ylab = 'texture mean')
scatterplotMatrix(~radius_mean+texture_mean+perimeter_mean+area_mean+smoothness_mean | diagnosis, data=wbcd)
## Step 3: Training a model on the data ----
# load the "class" library
library(class)
wbcd_test_pred <- knn(train = wbcd_train, test = wbcd_test,
cl = wbcd_train_labels, k = 21)
head(wbcd_test)
head(wbcd_test_pred)
## Step 4: Evaluating model performance ----
# load the "gmodels" library
library(gmodels)
# Create the cross tabulation of predicted vs. actual
CrossTable(x = wbcd_test_labels, y = wbcd_test_pred,
prop.chisq = FALSE)
## Step 5: Improving model performance ----
# use the scale() function to z-score standardize a data frame
wbcd_z <- as.data.frame(scale(wbcd[-1]))
# confirm that the transformation was applied correctly
summary(wbcd_z$area_mean)
# create training and test datasets
wbcd_train <- wbcd_z[1:469, ]
wbcd_test <- wbcd_z[470:569, ]
# re-classify test cases
wbcd_test_pred <- knn(train = wbcd_train, test = wbcd_test,
cl = wbcd_train_labels, k = 21)
# Create the cross tabulation of predicted vs. actual
CrossTable(x = wbcd_test_labels, y = wbcd_test_pred,
prop.chisq = FALSE)
# try several different values of k
wbcd_train <- wbcd_n[1:469, ]
wbcd_test <- wbcd_n[470:569, ]
#start time
strt<-Sys.time()
wbcd_test_pred <- knn(train = wbcd_train, test = wbcd_test, cl = wbcd_train_labels, k=1)
CrossTable(x = wbcd_test_labels, y = wbcd_test_pred, prop.chisq=FALSE)
wbcd_test_pred <- knn(train = wbcd_train, test = wbcd_test, cl = wbcd_train_labels, k=5)
CrossTable(x = wbcd_test_labels, y = wbcd_test_pred, prop.chisq=FALSE)
wbcd_test_pred <- knn(train = wbcd_train, test = wbcd_test, cl = wbcd_train_labels, k=11)
CrossTable(x = wbcd_test_labels, y = wbcd_test_pred, prop.chisq=FALSE)
wbcd_test_pred <- knn(train = wbcd_train, test = wbcd_test, cl = wbcd_train_labels, k=15)
CrossTable(x = wbcd_test_labels, y = wbcd_test_pred, prop.chisq=FALSE)
wbcd_test_pred <- knn(train = wbcd_train, test = wbcd_test, cl = wbcd_train_labels, k=21)
CrossTable(x = wbcd_test_labels, y = wbcd_test_pred, prop.chisq=FALSE)
wbcd_test_pred <- knn(train = wbcd_train, test = wbcd_test, cl = wbcd_train_labels, k=27)
CrossTable(x = wbcd_test_labels, y = wbcd_test_pred, prop.chisq=FALSE)
#end time
print(Sys.time()-strt)
knitr::opts_chunk$set(echo = TRUE)
library(tidyverse)
library(tidymodels)
wbcd <- read_csv("wisc_bc_data.csv")
wbcd <- wbcd %>% select(-id) %>%
mutate(diagnosis = as_factor(diagnosis))
wbcd
wbcd %>% filter(is.na(diagnosis))
wbcd_split <- initial_split(wbcd, prop = 0.8)
wbcd_split
wbcd_train <- training(wbcd_split)
head(wbcd_train)
wbcd_test <- testing(wbcd_split)
head(wbcd_test)
wbcd %>% count(diagnosis) %>%
mutate(prop = n/sum(n))
wbcd_train %>% count(diagnosis) %>%
mutate(prop = n/sum(n))
wbcd_test %>% count(diagnosis) %>%
mutate(prop = n/sum(n))
wbcd_rec <-
recipe(diagnosis ~ ., data = wbcd_train) %>%
step_normalize(all_predictors()) %>%
prep()
wbcd_rec
summary(wbcd_rec)
knn_model <-
nearest_neighbor(neighbors = 9) %>%
set_engine("kknn") %>%
set_mode("classification")
wbcd_train_prep <- bake(wbcd_rec, wbcd_train)
wbcd_train_prep
wbcd_test_prep <- bake(wbcd_rec, wbcd_test)
wbcd_test_prep
knn_fit <- knn_model %>% fit(diagnosis ~., wbcd_train_prep)
knn_fit
knn_training_pred <-
predict(knn_fit, wbcd_train_prep) %>%
bind_cols(predict(knn_fit, wbcd_train_prep, type = "prob")) %>%
# Add the true outcome data back in
bind_cols(wbcd_train_prep %>%
select(diagnosis))
knn_training_pred %>%                # training set predictions
accuracy(truth = diagnosis, .pred_class)
knn_training_pred %>% # training set predictions
roc_auc(truth = diagnosis, .pred_B)
knn_training_pred %>%
conf_mat(truth = diagnosis, estimate = .pred_class)
knn_test_pred <-
predict(knn_fit, wbcd_test_prep) %>%
bind_cols(predict(knn_fit, wbcd_test_prep, type = "prob")) %>%
# Add the true outcome data back in
bind_cols(wbcd_test_prep %>%
select(diagnosis))
knn_test_pred %>%                # training set predictions
accuracy(truth = diagnosis, .pred_class)
knn_test_pred %>% # training set predictions
roc_auc(truth = diagnosis, .pred_B)
knn_test_pred %>%
conf_mat(truth = diagnosis, estimate = .pred_class)
wbcd_wflow <-
workflow() %>%
add_recipe(wbcd_rec) %>%
add_model(knn_model)
wbcd_wflow
knn_fit <- wbcd_wflow %>%
last_fit(wbcd_split)
knn_fit %>%
collect_predictions() %>%
conf_mat(truth = diagnosis, estimate = .pred_class)
knn_fit %>%
collect_metrics()
folds <- vfold_cv(wbcd_train, v = 10)
folds
wbcd_fit_rs <-
wbcd_wflow %>%
fit_resamples(folds)
collect_metrics(wbcd_fit_rs)
knitr::opts_chunk$set(echo = TRUE)
library(tidyverse)
library(tidymodels)
library(GGally)
wbcd <- read_csv("wisc_bc_data.csv")
wbcd <- wbcd %>% select(-id) %>%
mutate(diagnosis = as_factor(diagnosis))
wbcd
wbcd %>% filter(is.na(diagnosis))
wbcd_split <- initial_split(wbcd, prop = 0.8)
wbcd_split
wbcd_train <- training(wbcd_split)
head(wbcd_train)
wbcd_test <- testing(wbcd_split)
head(wbcd_test)
wbcd %>% count(diagnosis) %>%
mutate(prop = n/sum(n))
wbcd_train %>% count(diagnosis) %>%
mutate(prop = n/sum(n))
wbcd_test %>% count(diagnosis) %>%
mutate(prop = n/sum(n))
wbcd %>% select(diagnosis, ends_with("mean")) %>%
ggpairs(aes(color = diagnosis))
wbcd_rec <-
recipe(diagnosis ~ ., data = wbcd_train) %>%
step_normalize(all_predictors()) %>%
prep()
wbcd_rec
summary(wbcd_rec)
tune_spec <-
nearest_neighbor(neighbors = tune()) %>%
set_engine("kknn") %>%
set_mode("classification")
tune_grid <- seq(5, 23, by = 2)
tune_grid
wbcd_wflow <-
workflow() %>%
add_recipe(wbcd_rec) %>%
add_model(tune_spec)
wbcd_wflow
folds <- vfold_cv(wbcd_train, v = 10)
folds
wbcd_fit_rs <-
wbcd_wflow %>%
tune_grid(
resamples = folds,
grid = tune_grid
)
collect_metrics(wbcd_fit_rs)
wbcd_fit_rs %>%
show_best("accuracy")
best_knn <- wbcd_fit_rs %>%
select_best("accuracy")
best_knn
final_wflow <-
wbcd_wflow %>%
finalize_workflow(best_knn)
final_knn <-
final_wflow %>%
last_fit(wbcd_split)
final_knn %>%
collect_metrics()
knn_training_pred <-
predict(knn_fit, wbcd_train_prep) %>%
bind_cols(predict(knn_fit, wbcd_train_prep, type = "prob")) %>%
# Add the true outcome data back in
bind_cols(wbcd_train_prep %>%
select(diagnosis))
knitr::opts_chunk$set(echo = TRUE)
library(tidyverse)
library(tidymodels)
wbcd <- read_csv("wisc_bc_data.csv")
wbcd <- wbcd %>% select(-id) %>%
mutate(diagnosis = as_factor(diagnosis))
wbcd
knn_training_pred <-
predict(knn_fit, wbcd_train_prep) %>%
bind_cols(predict(knn_fit, wbcd_train_prep, type = "prob")) %>%
# Add the true outcome data back in
bind_cols(wbcd_train_prep %>%
select(diagnosis))
library(tidyverse)
library(tidymodels)
wbcd <- read_csv("wisc_bc_data.csv")
wbcd <- wbcd %>% select(-id) %>%
mutate(diagnosis = as_factor(diagnosis))
wbcd
wbcd %>% filter(is.na(diagnosis))
wbcd_split <- initial_split(wbcd, prop = 0.8)
wbcd_split
wbcd_train <- training(wbcd_split)
head(wbcd_train)
wbcd_test <- testing(wbcd_split)
head(wbcd_test)
wbcd %>% count(diagnosis) %>%
mutate(prop = n/sum(n))
wbcd_train %>% count(diagnosis) %>%
mutate(prop = n/sum(n))
wbcd_test %>% count(diagnosis) %>%
mutate(prop = n/sum(n))
wbcd_rec <-
recipe(diagnosis ~ ., data = wbcd_train) %>%
step_normalize(all_predictors()) %>%
prep()
wbcd_rec
summary(wbcd_rec)
knn_model <-
nearest_neighbor(neighbors = 9) %>%
set_engine("kknn") %>%
set_mode("classification")
wbcd_train_prep <- bake(wbcd_rec, wbcd_train)
wbcd_train_prep
wbcd_test_prep <- bake(wbcd_rec, wbcd_test)
wbcd_test_prep
knn_fit <- knn_model %>% fit(diagnosis ~., wbcd_train_prep)
knn_fit
knn_training_pred <-
predict(knn_fit, wbcd_train_prep) %>%
bind_cols(predict(knn_fit, wbcd_train_prep, type = "prob")) %>%
# Add the true outcome data back in
bind_cols(wbcd_train_prep %>%
select(diagnosis))
knn_training_pred
knitr::opts_chunk$set(echo = TRUE)
library(tidyverse)
library(tidymodels)
library(GGally)
wbcd <- read_csv("wisc_bc_data.csv")
wbcd <- wbcd %>% select(-id) %>%
mutate(diagnosis = as_factor(diagnosis))
wbcd
wbcd %>% filter(is.na(diagnosis))
wbcd_split <- initial_split(wbcd, prop = 0.8)
wbcd_split
wbcd_train <- training(wbcd_split)
head(wbcd_train)
wbcd_test <- testing(wbcd_split)
head(wbcd_test)
wbcd %>% count(diagnosis) %>%
mutate(prop = n/sum(n))
wbcd_train %>% count(diagnosis) %>%
mutate(prop = n/sum(n))
wbcd_test %>% count(diagnosis) %>%
mutate(prop = n/sum(n))
wbcd %>% select(diagnosis, ends_with("mean")) %>%
ggpairs(aes(color = diagnosis))
wbcd_rec <-
recipe(diagnosis ~ ., data = wbcd_train) %>%
step_normalize(all_predictors()) %>%
prep()
wbcd_rec
summary(wbcd_rec)
tune_spec <-
nearest_neighbor(neighbors = tune()) %>%
set_engine("kknn") %>%
set_mode("classification")
tune_grid <- seq(5, 23, by = 2)
tune_grid
wbcd_wflow <-
workflow() %>%
add_recipe(wbcd_rec) %>%
add_model(tune_spec)
wbcd_wflow
folds <- vfold_cv(wbcd_train, v = 10)
folds
wbcd_fit_rs <-
wbcd_wflow %>%
tune_grid(
resamples = folds,
grid = tune_grid
)
collect_metrics(wbcd_fit_rs)
wbcd_fit_rs %>%
show_best("accuracy")
best_knn <- wbcd_fit_rs %>%
select_best("accuracy")
best_knn
final_wflow <-
wbcd_wflow %>%
finalize_workflow(best_knn)
final_knn <-
final_wflow %>%
last_fit(wbcd_split)
final_knn %>%
collect_metrics()
knitr::opts_chunk$set(echo = TRUE)
library(tidyverse)
library(tidymodels)
wbcd <- read_csv("wisc_bc_data.csv")
wbcd <- wbcd %>% select(-id) %>%
mutate(diagnosis = as_factor(diagnosis))
wbcd
wbcd %>% filter(is.na(diagnosis))
wbcd_split <- initial_split(wbcd, prop = 0.8)
wbcd_split
wbcd_train <- training(wbcd_split)
head(wbcd_train)
wbcd_test <- testing(wbcd_split)
head(wbcd_test)
wbcd %>% count(diagnosis) %>%
mutate(prop = n/sum(n))
wbcd_train %>% count(diagnosis) %>%
mutate(prop = n/sum(n))
wbcd_test %>% count(diagnosis) %>%
mutate(prop = n/sum(n))
wbcd_rec <-
recipe(diagnosis ~ ., data = wbcd_train) %>%
step_normalize(all_predictors()) %>%
prep()
wbcd_rec
summary(wbcd_rec)
knn_model <-
nearest_neighbor(neighbors = 9) %>%
set_engine("kknn") %>%
set_mode("classification")
wbcd_train_prep <- bake(wbcd_rec, wbcd_train)
wbcd_train_prep
wbcd_test_prep <- bake(wbcd_rec, wbcd_test)
wbcd_test_prep
knn_fit <- knn_model %>% fit(diagnosis ~., wbcd_train_prep)
knn_fit
knn_training_pred <-
predict(knn_fit, wbcd_train_prep) %>%
bind_cols(predict(knn_fit, wbcd_train_prep, type = "prob")) %>%
# Add the true outcome data back in
bind_cols(wbcd_train_prep %>%
select(diagnosis))
head(knn_training_pred)
knn_training_pred %>%                # training set predictions
accuracy(truth = diagnosis, .pred_class)
knn_training_pred %>% # training set predictions
roc_auc(truth = diagnosis, .pred_B)
knn_training_pred %>%
conf_mat(truth = diagnosis, estimate = .pred_class)
knn_test_pred <-
predict(knn_fit, wbcd_test_prep) %>%
bind_cols(predict(knn_fit, wbcd_test_prep, type = "prob")) %>%
# Add the true outcome data back in
bind_cols(wbcd_test_prep %>%
select(diagnosis))
knn_test_pred %>%                # training set predictions
accuracy(truth = diagnosis, .pred_class)
knn_test_pred %>% # training set predictions
roc_auc(truth = diagnosis, .pred_B)
knn_test_pred %>%
conf_mat(truth = diagnosis, estimate = .pred_class)
wbcd_wflow <-
workflow() %>%
add_recipe(wbcd_rec) %>%
add_model(knn_model)
wbcd_wflow
knn_fit <- wbcd_wflow %>%
last_fit(wbcd_split)
knn_fit %>%
collect_predictions() %>%
conf_mat(truth = diagnosis, estimate = .pred_class)
knn_fit %>%
collect_metrics()
folds <- vfold_cv(wbcd_train, v = 10)
folds
wbcd_fit_rs <-
wbcd_wflow %>%
fit_resamples(folds)
collect_metrics(wbcd_fit_rs)
