wisc_bc_data - kNN

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(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_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 B                14.1         12.9           90.0      616.          0.0931
2 B                14.3         19.6           97.8      630.          0.0784
3 B                12.3         15.9           78.8      464.          0.0808
4 M                17.0         19.1          113.       895           0.114 
5 B                11.5         23.9           74.5      404.          0.0926
6 B                14.4         27.0           92.2      646.          0.0700
# ℹ 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                11.7         24.4           76.4      406.          0.124 
3 B                10.5         20.2           68.6      334.          0.112 
4 M                13.8         15.8           90.4      584.          0.101 
5 M                12.8         22.5           81.7      506.          0.0906
6 M                16.8         18.8          109.       886.          0.0887
# ℹ 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 |> select(diagnosis, ends_with("mean")) |>   
  ggpairs(aes(color = diagnosis))

wbcd_rec <-
  recipe(diagnosis ~ ., data = wbcd_train) |>
  step_normalize(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

knn_model <-
  nearest_neighbor(
    mode = "classification"
  ) |>
  set_engine("kknn")

wbcd_wflow <-
  workflow() |>
  add_recipe(wbcd_rec) |>
  add_model(knn_model)

knn_fit <- wbcd_wflow |>
  # fit the final best model to the training set and evaluate the test set
  last_fit(wbcd_split)

knn_predictions <- knn_fit |>
  collect_predictions()

knn_performance <- knn_fit |>
  collect_metrics()

knn_predictions |>
  conf_mat(truth = diagnosis, estimate = .pred_class)

          Truth
Prediction  B  M
         B 75  4
         M  2 33

knn_predictions <- knn_fit |>
  collect_metrics()
knn_predictions

# A tibble: 3 × 4
  .metric     .estimator .estimate .config             
  <chr>       <chr>          <dbl> <chr>               
1 accuracy    binary        0.947  Preprocessor1_Model1
2 roc_auc     binary        0.981  Preprocessor1_Model1
3 brier_class binary        0.0346 Preprocessor1_Model1