Goal: To Predict CEO Departures

#Import Data

library(tidyverse)
## Warning: package 'purrr' was built under R version 4.4.3
## ── 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(correlationfunnel)
## ══ correlationfunnel Tip #3 ════════════════════════════════════════════════════
## Using `binarize()` with data containing many columns or many rows can increase dimensionality substantially.
## Try subsetting your data column-wise or row-wise to avoid creating too many columns.
## You can always make a big problem smaller by sampling. :)
library(dplyr)


data <- readr::read_csv('https://raw.githubusercontent.com/rfordatascience/tidytuesday/main/data/2021/2021-04-27/departures.csv')
## Rows: 9423 Columns: 19
## ── Column specification ────────────────────────────────────────────────────────
## Delimiter: ","
## chr   (8): coname, exec_fullname, interim_coceo, still_there, notes, sources...
## dbl  (10): dismissal_dataset_id, gvkey, fyear, co_per_rol, departure_code, c...
## dttm  (1): leftofc
## 
## ℹ 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.

#Clean Data

skimr::skim(data)
Data summary
Name data
Number of rows 9423
Number of columns 19
_______________________
Column type frequency:
character 8
numeric 10
POSIXct 1
________________________
Group variables None

Variable type: character

skim_variable n_missing complete_rate min max empty n_unique whitespace
coname 0 1.00 2 30 0 3860 0
exec_fullname 0 1.00 5 790 0 8701 0
interim_coceo 9105 0.03 6 7 0 6 0
still_there 7311 0.22 3 10 0 77 0
notes 1644 0.83 5 3117 0 7755 0
sources 1475 0.84 18 1843 0 7915 0
eight_ks 4499 0.52 69 3884 0 4914 0
_merge 0 1.00 11 11 0 1 0

Variable type: numeric

skim_variable n_missing complete_rate mean sd p0 p25 p50 p75 p100 hist
dismissal_dataset_id 0 1.00 5684.10 25005.46 1 2305.5 4593 6812.5 559044 ▇▁▁▁▁
gvkey 0 1.00 40132.48 53921.34 1004 7337.0 14385 60900.5 328795 ▇▁▁▁▁
fyear 0 1.00 2007.74 8.19 1987 2000.0 2008 2016.0 2020 ▁▆▅▅▇
co_per_rol 0 1.00 25580.22 18202.38 -1 8555.5 22980 39275.5 64602 ▇▆▅▃▃
departure_code 1667 0.82 5.20 1.53 1 5.0 5 7.0 9 ▁▃▇▅▁
ceo_dismissal 1813 0.81 0.20 0.40 0 0.0 0 0.0 1 ▇▁▁▁▂
tenure_no_ceodb 0 1.00 1.03 0.17 0 1.0 1 1.0 3 ▁▇▁▁▁
max_tenure_ceodb 0 1.00 1.05 0.24 1 1.0 1 1.0 4 ▇▁▁▁▁
fyear_gone 1802 0.81 2006.64 13.63 1980 2000.0 2007 2013.0 2997 ▇▁▁▁▁
cik 245 0.97 741469.17 486551.43 1750 106413.0 857323 1050375.8 1808065 ▆▁▇▂▁

Variable type: POSIXct

skim_variable n_missing complete_rate min max median n_unique
leftofc 1802 0.81 1981-01-01 2998-04-27 2006-12-31 3627 
factors_vec <- data %>% select(dismissal_dataset_id,departure_code,ceo_dismissal,fyear_gone,max_tenure_ceodb,tenure_no_ceodb,coname,exec_fullname,sources) %>%
  names()

data_clean <- data %>%
    # Drop zero-variance variables, missing values, and non predictive values
  select(-c(`_merge`,interim_coceo,still_there,eight_ks,departure_code,gvkey,cik,co_per_rol,leftofc,fyear)) %>%
  filter(!fyear_gone == 2997,) %>%
  na.omit() %>%
  #Remove Duplicates in ID
distinct(dismissal_dataset_id, .keep_all = TRUE) %>%
  
   # Address factors imported as numeric
  mutate(across(where(is.character), as.factor))%>%
  
  mutate(across(where(is.logical), as.factor))

#Explore Data

data_clean %>% count(ceo_dismissal)
## # A tibble: 2 × 2
##   ceo_dismissal     n
##           <dbl> <int>
## 1             0  5970
## 2             1  1482
data_clean %>%
  ggplot(aes(ceo_dismissal))+
  geom_bar()

#CEO Dismissal vs year

data_clean %>%
  ggplot(aes(ceo_dismissal, fyear_gone)) +
  geom_boxplot()
## Warning: Continuous x aesthetic
## ℹ did you forget `aes(group = ...)`?

# Step 1: Binarize the data
data_binarized <- data_clean %>%
  select(-notes,-dismissal_dataset_id) %>%
  binarize()

data_binarized %>% glimpse()
## Rows: 7,452
## Columns: 18
## $ coname__BARRICK_GOLD_CORP                                                           <dbl> …
## $ `coname__-OTHER`                                                                    <dbl> …
## $ exec_fullname__John_W._Rowe                                                         <dbl> …
## $ `exec_fullname__-OTHER`                                                             <dbl> …
## $ ceo_dismissal__0                                                                    <dbl> …
## $ ceo_dismissal__1                                                                    <dbl> …
## $ tenure_no_ceodb__1                                                                  <dbl> …
## $ tenure_no_ceodb__2                                                                  <dbl> …
## $ `tenure_no_ceodb__-OTHER`                                                           <dbl> …
## $ max_tenure_ceodb__1                                                                 <dbl> …
## $ max_tenure_ceodb__2                                                                 <dbl> …
## $ `max_tenure_ceodb__-OTHER`                                                          <dbl> …
## $ `fyear_gone__-Inf_2000`                                                             <dbl> …
## $ fyear_gone__2000_2006                                                               <dbl> …
## $ fyear_gone__2006_2013                                                               <dbl> …
## $ fyear_gone__2013_Inf                                                                <dbl> …
## $ `sources__https://photronicsinc.gcs-web.com/directors/constantine-deno-macricostas` <dbl> …
## $ `sources__-OTHER`                                                                   <dbl> …
# Step 2: Correlation
data_correlation <- data_binarized %>%
  correlate(ceo_dismissal__1)

#Step #3: Plot
data_correlation %>%
  correlationfunnel::plot_correlation_funnel()

#Model Building