library(tidyverse)
## ── Attaching core tidyverse packages ──────────────────────── tidyverse 2.0.0 ──
## ✔ dplyr     1.1.3     ✔ readr     2.1.4
## ✔ forcats   1.0.0     ✔ stringr   1.5.0
## ✔ ggplot2   3.4.3     ✔ tibble    3.2.1
## ✔ lubridate 1.9.2     ✔ tidyr     1.3.0
## ✔ purrr     1.0.2     
## ── 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
members_raw <- readr::read_csv('https://raw.githubusercontent.com/rfordatascience/tidytuesday/master/data/2020/2020-09-22/members.csv')
## Rows: 76519 Columns: 21
## ── Column specification ────────────────────────────────────────────────────────
## Delimiter: ","
## chr (10): expedition_id, member_id, peak_id, peak_name, season, sex, citizen...
## dbl  (5): year, age, highpoint_metres, death_height_metres, injury_height_me...
## lgl  (6): hired, success, solo, oxygen_used, died, injured
## 
## ℹ 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.

Prepare Data

members_tidy <- members_raw %>%
  group_by(citizenship, sex) %>% 
  summarise(died = sum(died)) %>% 
  ungroup()
## `summarise()` has grouped output by 'citizenship'. You can override using the
## `.groups` argument.
members_tidy %>% 
    group_by(citizenship) %>% 
    summarise(total_deaths = sum(died)) %>% 
    ungroup()
## # A tibble: 213 × 2
##    citizenship           total_deaths
##    <chr>                        <int>
##  1 Albania                          0
##  2 Algeria                          0
##  3 Andorra                          0
##  4 Argentina                        4
##  5 Argentina/Canada                 0
##  6 Armenia                          0
##  7 Australia                       21
##  8 Australia/Greece                 0
##  9 Australia/Ireland                0
## 10 Australia/New Zealand            0
## # ℹ 203 more rows
members_demo <- members_tidy %>%
  filter(sex %in% c("M", "F")) %>% 
  pivot_wider(names_from = sex, values_from = died, values_fill = 0) %>% 
  left_join(members_tidy %>% 
                group_by(citizenship) %>% 
                summarise(total_deaths = sum(died)) %>% 
                ungroup()) %>% 
    
    filter(total_deaths > 0, total_deaths < 100) %>% 
    mutate(across(c(M, F), ~ . / total_deaths), 
           total_deaths = log(total_deaths), 
           across(where(is.numeric), ~ as.numeric(scale(.))))
## Joining with `by = join_by(citizenship)`
members_demo
## # A tibble: 53 × 4
##    citizenship            M      F total_deaths
##    <chr>              <dbl>  <dbl>        <dbl>
##  1 Argentina          0.464 -0.464       -0.359
##  2 Australia         -0.953  0.953        0.983
##  3 Austria            0.464 -0.464        1.09 
##  4 Azerbaijan/Russia  0.464 -0.464       -1.48 
##  5 Bangladesh         0.464 -0.464       -1.48 
##  6 Belarus            0.464 -0.464       -0.592
##  7 Belgium           -2.51   2.51        -0.178
##  8 Brazil             0.464 -0.464       -1.48 
##  9 Bulgaria          -1.19   1.19         0.298
## 10 Canada            -0.466  0.466        0.202
## # ℹ 43 more rows

Implementing k-means clustering

members_clust <- kmeans(select(members_demo, - citizenship), centers = 3)
summary(members_clust)
##              Length Class  Mode   
## cluster      53     -none- numeric
## centers       9     -none- numeric
## totss         1     -none- numeric
## withinss      3     -none- numeric
## tot.withinss  1     -none- numeric
## betweenss     1     -none- numeric
## size          3     -none- numeric
## iter          1     -none- numeric
## ifault        1     -none- numeric
library(broom)
tidy(members_clust)
## # A tibble: 3 × 6
##         M       F total_deaths  size withinss cluster
##     <dbl>   <dbl>        <dbl> <int>    <dbl> <fct>  
## 1 -3.07    3.07         -0.570     4     7.25 1      
## 2  0.464  -0.464        -0.812    25     5.98 2      
## 3  0.0282 -0.0282        0.941    24    17.6  3
augment(members_clust, members_demo) %>%
  ggplot(aes(total_deaths, F, color = .cluster)) +
  geom_point()

Choosing K

kclusts <-
  tibble(k = 1:9) %>%
  mutate(
    kclust = map(k, ~ kmeans(select(members_demo, - citizenship), .x)),
    tidied = map(kclust, tidy),
    glanced = map(kclust, glance),
    augmented = map(kclust, augment, members_demo)
  )

kclusts %>%
  unnest(glanced) %>%
  ggplot(aes(k, tot.withinss)) +
  geom_line(alpha = 0.8) +
  geom_point(size = 2)

library(plotly)
## 
## Attaching package: 'plotly'
## The following object is masked from 'package:ggplot2':
## 
##     last_plot
## The following object is masked from 'package:stats':
## 
##     filter
## The following object is masked from 'package:graphics':
## 
##     layout
members_clust <- kmeans(select(members_demo, - citizenship), centers = 4)

p <- augment(members_clust, members_demo) %>%
  ggplot(aes(total_deaths, M, color = .cluster, name = citizenship)) +
  geom_point(alpha = 0.8)

ggplotly(p)

#1 - The modeling goal was to use k means clustering to explore climbing deaths in relation to sex and citizenship. -The data consists of different mountains, seasons and years they were climbed, ages and citizenship of all involved, etc. - The main variables used in the analysis consist of sex, citizenship, and did they die or not.

#2 - The original data had more variables and data points, while the transformed data has selected the main data it wants to work with. For example it has selected just sex and citizenships instead of using all variables. We also removed outliers. This was all done to make the data best fit for the k means clustering models. #3 - k-means Clustering - To find optimal K value you can look at the total within-cluster squares and see if there is a drop off.

#4 - We were able to see what sex of each certain country were clustered together and were more alike based on the cluster they were in.