This week’s #TidyTuesday dataset is about CEO departures in S&P 1500 firms.TidyTuesday is a weekly data project aimed at the R ecosystem. I have taken 2000-2019 data and tried to plot the two decades of reason on why CEOs leave.

The Outcome

CEO departures have increased significantly in recent years. Signs of decreasing tolerance? May be. Also, reasons of exits are missing a lot recently. Companies becoming more secretive maybe.

Tips i.e. challenges I faced doing it

  • Tribble is an excellent way to create new small tibbles/dataframes. What you see (type) is what you get.

  • Ungroup is must to have long piping. Thumb-rule is always ungroup after any grouping

  • Patchwork is an amazing package to patch together plots. Check out the documentation to learn the difference between +, / and |. It was lots of trial and error before I got that layout right.

Full Code

### Load libraries

# Data wrangling
library(tidyverse)

# Tidy Tuesday datasets
library(tidytuesdayR)

# Patching plots together - literally like gluing things
library(patchwork)


### Get TidyTuesay data

tt_data<-tt_load("2021-04-27")

departures<-tt_data$departures

### Create a dataframe to make dismissal codes human readable

departure_codes<-tribble(
  ~departureCode,~type,~broadType,
  1, "Involuntary-Death","1. Involuntary",
  2,"Involuntary-Illness","1. Involuntary",
  3,"Involuntary-Dismissed-performance","1. Involuntary",
  4,"Involuntary-Dismissed-legal","1. Involuntary",
  5,"Voluntary-Retired","2. Voluntary",
  6,"Voluntary-Opportunity","2. Voluntary",
  7,"Other","3. Miscellaneous",
  8,"Missing","3. Miscellaneous",
  9,"Execucomp error","3. Miscellaneous",
  NA,"NA","4. NA"
)

### Creating an intermediate dataframe for my first two plots

df_all<-departures%>%
  left_join(departure_codes,by=c("departure_code"="departureCode"))%>%
  group_by(fyear,broadType)%>%
  summarize(
    count=n(),
  )%>%
  ungroup()%>%
  group_by(fyear)%>%
  mutate(
    percent=count/sum(count)*100
  )%>%
  ungroup()%>%
  arrange(fyear,desc(count))

### Plot-1 => Stack column chart showing counts

p1<-df_all%>%
  filter(fyear>=2000,fyear<=2019)%>%
  ggplot(aes(x=factor(fyear),y=count,fill=broadType,label=paste0(round(percent,0),"%")))+
  geom_col(stat='identity')+
  geom_text(aes(label=stat(y),group=fyear),
            stat='summary',fun=sum,vjust=-1,size=3)+
  scale_fill_manual(values=c('#BF0A3A','#AEF2C6','yellow','gray'))+
  scale_y_continuous(expand=expansion(mult=c(0,0.1)))+
  labs(
    title="# of Departures by Year",
    y="# of departures"
  )+
  theme_minimal()+
  theme(
    plot.title=element_text(color='#838383',hjust=0.5,size=12,
                            face='bold'),
    plot.caption=element_text(color='#BD1D10',face='italic',size=8),
    legend.position = "top",
    legend.text = element_text(size=8),
    legend.title = element_blank(),
    axis.title.x = element_blank(),
    axis.text.x=element_text(angle=90,size=8),
    axis.text.y=element_blank(),
    panel.grid=element_blank()
  )


p1

### Plot-2 => Stack fill chart showing percent distribution

p2<-df_all%>%
  filter(fyear>=2000,fyear<=2019)%>%
  ggplot(aes(x=factor(fyear),y=percent,fill=broadType,label=paste0(round(percent,0),"%")))+
  geom_col(stat='identity')+
  geom_text(position = position_stack(vjust=0.5),aes(angle=0),size=2)+
  scale_fill_manual(values=c('#BF0A3A','#AEF2C6','yellow','gray'))+
  scale_y_continuous(expand=expansion(mult=c(0,0.1)))+
  labs(
    title="Departure by reason (% contribution)",
    x="Year",
    y="% of departures"
  )+
  theme_minimal()+
  theme(
    plot.title=element_text(color='#838383',hjust=0.5,size=12,
                            face='bold'),
    plot.caption=element_text(color='#BD1D10',face='italic',size=8),
    legend.position = "None",
    legend.text = element_text(size=8),
    legend.title = element_blank(),
    axis.text.x=element_text(angle=90,size=8),
    axis.text.y=element_blank(),
    panel.grid=element_blank()
  )


p2


# Getting companies with most exits

top_5<-departures%>%
  filter(fyear>=2000,fyear<=2019)%>%
  group_by(coname)%>%
  summarize(
    Count=n()
  )%>%
  ungroup()%>%
  slice_max(Count,n=5)

### Plot-3 => Stack bar chart of companies with most exits


p3<-departures%>%
  left_join(departure_codes,by=c("departure_code"="departureCode"))%>%
  filter(fyear>=2000,fyear<=2019)%>%
  group_by(coname,broadType)%>%
  summarize(
    typeCount=n()
  )%>%
  ungroup()%>%
  inner_join(top_5,by='coname')%>%
  ggplot(aes(x=reorder(coname,Count),y=typeCount,fill=broadType,label=typeCount))+
  geom_col(stat='identity')+
  geom_text(position = position_stack(vjust=0.5),size=3)+
  geom_text(aes(label=stat(y),group=coname),
            stat='summary',fun=sum,hjust=-1,size=3)+
  scale_fill_manual(values=c('#BF0A3A','#AEF2C6','yellow','gray'))+
  scale_y_continuous(expand=expansion(mult=c(0,0.1)))+
  labs(
    title="Companies with highest CEO exits",
    y="# of departures"
  )+
  coord_flip()+
  theme_minimal()+
  theme(
    plot.title=element_text(color='#838383',hjust=0.5,size=12,
                            face='bold'),
    plot.subtitle=element_text(color='#838383',hjust=0.5,size=12,
                            face='bold'),
    plot.caption=element_text(color='#BD1D10',face='italic',size=8),
    legend.position = "None",
    legend.title = element_blank(),
    axis.title.y=element_blank(),
    axis.title.x=element_text(size=8),
    axis.text.y=element_text(size=8),
    axis.text.x=element_blank(),
    panel.grid=element_blank()
  )


p3

### Plot-4 => Pie plot of % contribution by reason over two decades


p4<-departures%>%
  left_join(departure_codes,by=c("departure_code"="departureCode"))%>%
  filter(fyear>=2000,fyear<=2019)%>%
  group_by(broadType)%>%
  summarise(
    total=n()
  )%>%
  ungroup()%>%
  mutate(
    percent=round(total/sum(total)*100,0)
  )%>%
  ggplot(aes(x=2,y=percent,fill=broadType,label=paste0(percent,"%")))+
  geom_bar(stat='identity')+
  coord_polar("y")+
  geom_text(position = position_stack(vjust=0.5))+
  xlim(0.5,2.5)+
  scale_fill_manual(values=c('#BF0A3A','#AEF2C6','yellow','gray'))+
  labs(
    title="CEO exits by type"
  )+  
  theme_minimal()+
  theme(
    plot.title=element_text(color='#838383',hjust=0.5,size=12,
                            face='bold'),
    plot.subtitle=element_text(color='#838383',hjust=0.5,size=12,
                               face='bold'),
    plot.caption=element_text(color='#BD1D10',face='italic',size=8),
    legend.position = "None",
    legend.title = element_blank(),
    axis.title=element_blank(),
    axis.text.y=element_blank(),
    axis.text.x=element_blank(),
    panel.grid=element_blank()
  )

p4


### Patching -em(plots) together

patch_1<-((p4/p3)|(p1/p2))+
  plot_layout(guides="collect")+
  plot_annotation(
  title="CEO departures #TidyTuesday ",
  subtitle = "2000-2019",
  theme=theme(
    plot.title =element_text(color='#838383',hjust=0.5,size=18,
                                       face='bold'),
    plot.subtitle =element_text(color='#838383',hjust=0.5,size=12,
                                       face='bold'),
    legend.position = "top"
              )
)
  
patch_1

### Saving the pic for uploading to twitter

ggsave(filename = "TidyTuesday20210427.png",plot=patch_1,
       dpi=300,
       width=16,
       height=9
       )