Breast Cancer using Tidymodels - with tuning

Author

Prof. Eric A. Suess

Published

February 26, 2025

library(tidyverse)
── Attaching core tidyverse packages ──────────────────────── tidyverse 2.0.0 ──
✔ dplyr     1.1.4     ✔ readr     2.1.5
✔ forcats   1.0.0     ✔ stringr   1.5.1
✔ ggplot2   3.5.1     ✔ tibble    3.2.1
✔ lubridate 1.9.4     ✔ tidyr     1.3.1
✔ purrr     1.0.4     
── Conflicts ────────────────────────────────────────── tidyverse_conflicts() ──
✖ dplyr::filter() masks stats::filter()
✖ dplyr::lag()    masks stats::lag()
ℹ Use the conflicted package (<http://conflicted.r-lib.org/>) to force all conflicts to become errors
library(tidymodels)
── Attaching packages ────────────────────────────────────── tidymodels 1.3.0 ──
✔ broom        1.0.7          ✔ rsample      1.2.1.9000
✔ dials        1.4.0.9000     ✔ tune         1.3.0.9000
✔ infer        1.0.7          ✔ workflows    1.2.0.9000
✔ modeldata    1.4.0          ✔ workflowsets 1.1.0     
✔ parsnip      1.3.0.9000     ✔ yardstick    1.3.2     
✔ recipes      1.1.1.9000     
── Conflicts ───────────────────────────────────────── tidymodels_conflicts() ──
✖ scales::discard() masks purrr::discard()
✖ dplyr::filter()   masks stats::filter()
✖ recipes::fixed()  masks stringr::fixed()
✖ dplyr::lag()      masks stats::lag()
✖ yardstick::spec() masks readr::spec()
✖ recipes::step()   masks stats::step()
library(naniar)
library(GGally)
Registered S3 method overwritten by 'GGally':
  method from   
  +.gg   ggplot2
wbcd <- read_csv("wisc_bc_data.csv")
Rows: 569 Columns: 32
── Column specification ────────────────────────────────────────────────────────
Delimiter: ","
chr  (1): diagnosis
dbl (31): id, radius_mean, texture_mean, perimeter_mean, area_mean, smoothne...

ℹ 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.
wbcd <- wbcd |> select(-id) |> 
  mutate(diagnosis = as_factor(diagnosis))
wbcd
# A tibble: 569 × 31
   diagnosis radius_mean texture_mean perimeter_mean area_mean smoothness_mean
   <fct>           <dbl>        <dbl>          <dbl>     <dbl>           <dbl>
 1 B                12.3         12.4           78.8      464.          0.103 
 2 B                10.6         19.0           69.3      346.          0.0969
 3 B                11.0         16.8           70.9      373.          0.108 
 4 B                11.3         13.4           73        385.          0.116 
 5 B                15.2         13.2           97.6      712.          0.0796
 6 B                11.6         19.0           74.2      410.          0.0855
 7 B                11.5         23.9           74.5      404.          0.0926
 8 M                13.8         23.8           91.6      598.          0.132 
 9 B                10.5         19.3           67.4      336.          0.0999
10 B                11.1         15.0           71.5      374.          0.103 
# ℹ 559 more rows
# ℹ 25 more variables: compactness_mean <dbl>, concavity_mean <dbl>,
#   points_mean <dbl>, symmetry_mean <dbl>, dimension_mean <dbl>,
#   radius_se <dbl>, texture_se <dbl>, perimeter_se <dbl>, area_se <dbl>,
#   smoothness_se <dbl>, compactness_se <dbl>, concavity_se <dbl>,
#   points_se <dbl>, symmetry_se <dbl>, dimension_se <dbl>, radius_worst <dbl>,
#   texture_worst <dbl>, perimeter_worst <dbl>, area_worst <dbl>, …
wbcd |> filter(is_na(diagnosis))
# A tibble: 0 × 31
# ℹ 31 variables: diagnosis <fct>, radius_mean <dbl>, texture_mean <dbl>,
#   perimeter_mean <dbl>, area_mean <dbl>, smoothness_mean <dbl>,
#   compactness_mean <dbl>, concavity_mean <dbl>, points_mean <dbl>,
#   symmetry_mean <dbl>, dimension_mean <dbl>, radius_se <dbl>,
#   texture_se <dbl>, perimeter_se <dbl>, area_se <dbl>, smoothness_se <dbl>,
#   compactness_se <dbl>, concavity_se <dbl>, points_se <dbl>,
#   symmetry_se <dbl>, dimension_se <dbl>, radius_worst <dbl>, …
wbcd_split <- initial_split(wbcd, prop = 0.8)
wbcd_split
<Training/Testing/Total>
<455/114/569>
wbcd_train <- training(wbcd_split)
head(wbcd_train)
# A tibble: 6 × 31
  diagnosis radius_mean texture_mean perimeter_mean area_mean smoothness_mean
  <fct>           <dbl>        <dbl>          <dbl>     <dbl>           <dbl>
1 M                14.2        23.8            92.9      611.          0.0946
2 M                18.6        17.6           124.      1076           0.110 
3 B                13.6        13.2            87.9      569.          0.0965
4 B                11.0        17.2            71.7      372.          0.0891
5 B                10.8         9.71           68.8      358.          0.0959
6 M                21.2        23.0           137.      1404           0.0943
# ℹ 25 more variables: compactness_mean <dbl>, concavity_mean <dbl>,
#   points_mean <dbl>, symmetry_mean <dbl>, dimension_mean <dbl>,
#   radius_se <dbl>, texture_se <dbl>, perimeter_se <dbl>, area_se <dbl>,
#   smoothness_se <dbl>, compactness_se <dbl>, concavity_se <dbl>,
#   points_se <dbl>, symmetry_se <dbl>, dimension_se <dbl>, radius_worst <dbl>,
#   texture_worst <dbl>, perimeter_worst <dbl>, area_worst <dbl>,
#   smoothness_worst <dbl>, compactness_worst <dbl>, concavity_worst <dbl>, …
wbcd_test <- testing(wbcd_split)
head(wbcd_test)
# A tibble: 6 × 31
  diagnosis radius_mean texture_mean perimeter_mean area_mean smoothness_mean
  <fct>           <dbl>        <dbl>          <dbl>     <dbl>           <dbl>
1 B                15.2         13.2           97.6      712.          0.0796
2 B                14.6         22.7           96.4      657.          0.0847
3 B                15.7         13.9          102        762.          0.0946
4 B                12.2         13.3           79.1      456.          0.107 
5 B                10.9         18.6           70.4      370           0.100 
6 B                15.1         16.4           99.6      674.          0.115 
# ℹ 25 more variables: compactness_mean <dbl>, concavity_mean <dbl>,
#   points_mean <dbl>, symmetry_mean <dbl>, dimension_mean <dbl>,
#   radius_se <dbl>, texture_se <dbl>, perimeter_se <dbl>, area_se <dbl>,
#   smoothness_se <dbl>, compactness_se <dbl>, concavity_se <dbl>,
#   points_se <dbl>, symmetry_se <dbl>, dimension_se <dbl>, radius_worst <dbl>,
#   texture_worst <dbl>, perimeter_worst <dbl>, area_worst <dbl>,
#   smoothness_worst <dbl>, compactness_worst <dbl>, concavity_worst <dbl>, …
wbcd |> count(diagnosis) |> 
  mutate(prop = n/sum(n))
# A tibble: 2 × 3
  diagnosis     n  prop
  <fct>     <int> <dbl>
1 B           357 0.627
2 M           212 0.373
wbcd_train |> count(diagnosis) |> 
  mutate(prop = n/sum(n))
# A tibble: 2 × 3
  diagnosis     n  prop
  <fct>     <int> <dbl>
1 B           283 0.622
2 M           172 0.378
wbcd_test |> count(diagnosis) |> 
  mutate(prop = n/sum(n))
# A tibble: 2 × 3
  diagnosis     n  prop
  <fct>     <int> <dbl>
1 B            74 0.649
2 M            40 0.351
wbcd |> select(diagnosis, ends_with("mean")) |>   
  ggpairs(aes(color = diagnosis))

wbcd_rec <-
  recipe(diagnosis ~ ., data = wbcd_train) |>
  step_normalize(all_predictors()) 

wbcd_rec
── Recipe ──────────────────────────────────────────────────────────────────────
── Inputs 
Number of variables by role
outcome:    1
predictor: 30
── Operations 
• Centering and scaling for: all_predictors()
summary(wbcd_rec)
# A tibble: 31 × 4
   variable         type      role      source  
   <chr>            <list>    <chr>     <chr>   
 1 radius_mean      <chr [2]> predictor original
 2 texture_mean     <chr [2]> predictor original
 3 perimeter_mean   <chr [2]> predictor original
 4 area_mean        <chr [2]> predictor original
 5 smoothness_mean  <chr [2]> predictor original
 6 compactness_mean <chr [2]> predictor original
 7 concavity_mean   <chr [2]> predictor original
 8 points_mean      <chr [2]> predictor original
 9 symmetry_mean    <chr [2]> predictor original
10 dimension_mean   <chr [2]> predictor original
# ℹ 21 more rows
tune_spec <- 
  nearest_neighbor(neighbors = tune()) |>
  set_engine("kknn") |> 
  set_mode("classification")
tune_grid <- seq(5, 23, by = 2)
tune_grid
 [1]  5  7  9 11 13 15 17 19 21 23
wbcd_wflow <-
  workflow() |>
  add_recipe(wbcd_rec) |>
  add_model(tune_spec)

wbcd_wflow
══ Workflow ════════════════════════════════════════════════════════════════════
Preprocessor: Recipe
Model: nearest_neighbor()

── Preprocessor ────────────────────────────────────────────────────────────────
1 Recipe Step

• step_normalize()

── Model ───────────────────────────────────────────────────────────────────────
K-Nearest Neighbor Model Specification (classification)

Main Arguments:
  neighbors = tune()

Computational engine: kknn 

Using Cross Validation

folds <- vfold_cv(wbcd_train, v = 10)
folds
#  10-fold cross-validation 
# A tibble: 10 × 2
   splits           id    
   <list>           <chr> 
 1 <split [409/46]> Fold01
 2 <split [409/46]> Fold02
 3 <split [409/46]> Fold03
 4 <split [409/46]> Fold04
 5 <split [409/46]> Fold05
 6 <split [410/45]> Fold06
 7 <split [410/45]> Fold07
 8 <split [410/45]> Fold08
 9 <split [410/45]> Fold09
10 <split [410/45]> Fold10
wbcd_fit_rs <- 
  wbcd_wflow |> 
  tune_grid(
    resamples = folds,
    grid = tune_grid
    )
collect_metrics(wbcd_fit_rs)
# A tibble: 15 × 7
   neighbors .metric     .estimator   mean     n std_err .config             
       <int> <chr>       <chr>       <dbl> <int>   <dbl> <chr>               
 1         1 accuracy    binary     0.978     10 0.00725 Preprocessor1_Model1
 2         1 brier_class binary     0.0218    10 0.00725 Preprocessor1_Model1
 3         1 roc_auc     binary     0.973     10 0.0104  Preprocessor1_Model1
 4         4 accuracy    binary     0.978     10 0.00725 Preprocessor1_Model2
 5         4 brier_class binary     0.0200    10 0.00519 Preprocessor1_Model2
 6         4 roc_auc     binary     0.987     10 0.00631 Preprocessor1_Model2
 7         8 accuracy    binary     0.976     10 0.00687 Preprocessor1_Model3
 8         8 brier_class binary     0.0208    10 0.00449 Preprocessor1_Model3
 9         8 roc_auc     binary     0.992     10 0.00436 Preprocessor1_Model3
10        12 accuracy    binary     0.974     10 0.00634 Preprocessor1_Model4
11        12 brier_class binary     0.0215    10 0.00417 Preprocessor1_Model4
12        12 roc_auc     binary     0.992     10 0.00448 Preprocessor1_Model4
13        15 accuracy    binary     0.976     10 0.00605 Preprocessor1_Model5
14        15 brier_class binary     0.0222    10 0.00400 Preprocessor1_Model5
15        15 roc_auc     binary     0.992     10 0.00458 Preprocessor1_Model5
wbcd_fit_rs |>
  show_best(metric = "accuracy")
# A tibble: 5 × 7
  neighbors .metric  .estimator  mean     n std_err .config             
      <int> <chr>    <chr>      <dbl> <int>   <dbl> <chr>               
1         1 accuracy binary     0.978    10 0.00725 Preprocessor1_Model1
2         4 accuracy binary     0.978    10 0.00725 Preprocessor1_Model2
3         8 accuracy binary     0.976    10 0.00687 Preprocessor1_Model3
4        15 accuracy binary     0.976    10 0.00605 Preprocessor1_Model5
5        12 accuracy binary     0.974    10 0.00634 Preprocessor1_Model4
best_knn <- wbcd_fit_rs |>
  select_best(metric = "accuracy")

best_knn
# A tibble: 1 × 2
  neighbors .config             
      <int> <chr>               
1         1 Preprocessor1_Model1
final_wflow <- 
  wbcd_wflow |> 
  finalize_workflow(best_knn)
final_knn <- 
  final_wflow |>
  last_fit(wbcd_split) 

final_knn |> 
    collect_metrics()
# A tibble: 3 × 4
  .metric     .estimator .estimate .config             
  <chr>       <chr>          <dbl> <chr>               
1 accuracy    binary        0.947  Preprocessor1_Model1
2 roc_auc     binary        0.931  Preprocessor1_Model1
3 brier_class binary        0.0526 Preprocessor1_Model1