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
       )