CEO_Compensation_EDA.Rmd

---
title: "CEO Compensation EDA"
author: "Afsar Ali"
output:
  prettydoc::html_pretty:
    theme: Cayman
    highlight: github
    df_print: paged
    toc: yes
    toc_depth: '4'
---

```{r echo=TRUE}
# Course: BUAN 5210
# Title: CEO Compensation EDA 
# Purpose: Final Project StoryTelling
# Date: Dec 7th, 2017
# Author: Afsar Ali
```


```{r echo=TRUE, message=FALSE, warning=FALSE}
# Clear working environment
#m(list=ls(all=TRUE)) 
# The tidyverse package contains ggplot2, tibble, tidyr, readr, purr, and dplyr among others
library(tidyverse)
# The gridExtra package contains grid.arrange function used to combine plots
library(gridExtra)
# The GGally package contains ggpairs which is a custom correlation graph for ggplot2
library(GGally)
# Load gridExtra so can plot more than one graph with grid.arrange
library(gridExtra)
#load other packages
library(psych)

```


```{r echo=TRUE, message=FALSE, warning=FALSE}
#Load and Review data
dat <- read.csv("ECON5100_project_data.csv", header = TRUE)


#Make a subset of relevent data
dat1 <- select(dat, "AT","NI", "CH", "DLTT", "PRCH_C", "PRCL_C", "TDC2", "SALARY", "BONUS", "OTHCOMP", "AGE", "GENDER")
dat1<-  mutate (dat1, ageg = cut(AGE, 6)) #grouping age by 6
datm <- dat1 %>%  filter(GENDER =="MALE") #male only 
datf <- dat1 %>%  filter(GENDER =="FEMALE") #female only
                  
#attach the file for use
attach(dat1)
```

##Executive Summary

The focus of this analysis is to determine compensation of Chief Executive Officers (CEOs) in US publicly traded companies by age and gender. The data set is consisted of 114 factors (columns) and 8300 data points (rows). Following are the initial exploratory data analysis.


###Age and Gender Distribution
Let's explore Salary and Gender Distribution by Age  

+ The CEO Compensation Data shows: 
    - 93% of the CEOs are middle-aged men
    - Only 508 Female CEOs


```{r echo=TRUE, message=FALSE, warning=FALSE}
grid.arrange(
ggplot(dat, aes(x = AGE, y = SALARY, color = GENDER)) +
  geom_point() +
  stat_density2d() +
  ggtitle("Mostly Middle aged Men", sub = "Small number of Female observations"),
ggplot(dat, aes(x = AGE, y = SALARY, color = GENDER)) +
  geom_point() +
  stat_density2d(aes(fill =..density..), geom = "raster", contour = FALSE) +
  ggtitle("Mostly Middle aged Men", sub = "Heat map, light color indicates more observations"),
ncol = 2
)
```


###CEO Average Compensation by Gender and Age group  

+ Male CEO has larger outliers
+ Average female compensation seems lower than men  

Let's look closely to find deeper insight

```{r echo=TRUE, message=FALSE, warning=FALSE}

ggplot(dat1, aes(ageg, TDC2, fill= GENDER)) +
  geom_boxplot() + 
  theme(axis.text.x = element_text(angle=65, vjust=0.6)) + 
  labs(fill = "Gender") +
# Add and improve titles and labels
    ggtitle("Average female compensation seems lower than men") + 
    ylab("Average Compensation by Thousands") +
    xlab("Age Group") +
    scale_x_discrete(labels=c("Under 40", "40 to 51", "51 to 62", "62 to 73", "73 to 84", "84 +", "NA")) +
     ylim(-5000, 30000)

 
```


###Male Vs Female Average Compensation
Let's look at the difference in compensation by Gender   

+ Older females has higher compensation although they account for very small share of our observation 
+ Middle age males has higher compensation
    
Why are older females observed to have higher compensation?


```{r echo=TRUE, message=FALSE, warning=FALSE}
grid.arrange(
#Male Data
datf %>%
  group_by(ageg) %>%
  summarise(Avg_Com = mean(TDC2)) %>%
  ggplot(aes(x = ageg, y = Avg_Com, )) +
  geom_bar(stat="identity", position = "dodge", color = "black") +
  labs(fill = "Gender") +
# Add and improve titles and labels
    ggtitle("Older female higher compensation") + 
    ylab("Average Compensation by Thousands") +
    xlab("Female Age Group") +
    scale_x_discrete(labels=c("Under 40", "40 to 51", "51 to 62", "62 to 73", "73 to 84", "84 +", "NA")) +
    ylim(0, 6000) +
 theme_classic() + 
  theme(axis.ticks.x = element_blank(),
        axis.ticks.y = element_blank(),),
#Female Data
datm %>%
  group_by(ageg) %>%
  summarise(Avg_Com = mean(TDC2)) %>%
  ggplot(aes(x = ageg, y = Avg_Com, )) +
  geom_bar(stat="identity", position = "dodge", color = "black") +
  labs(fill = "Gender") +
# Add and improve titles and labels
    ggtitle("Middle-age males higher compensation") + 
    ylab("Average Compensation by Thousands") +
    xlab("Male Age Group") +
    scale_x_discrete(labels=c("Under 40", "40 to 51", "51 to 62", "62 to 73", "73 to 84", "84 +", "NA")) +
  ylim(0, 6000) +


  theme_classic() + 
  theme(  axis.ticks.x = element_blank(),
          axis.title.y = element_blank(),
          axis.text.y = element_blank(),
          axis.ticks.y = element_blank()),
     #     panel.background = element_blank()),
ncol = 2
)
```

###Average compensation for both genders
Let's compare total compensation side by side   
+ There are no female executives over 84
+ Female age group has larger growth from 62-73 to 73-84 


```{r echo=TRUE, message=FALSE, warning=FALSE}
# Average profit by region and category 
dat1 %>%
  group_by(ageg, GENDER) %>%
  summarise(Avg_Com = mean(TDC2)) %>%
  ggplot(aes(x = ageg, y = Avg_Com, fill = reorder(GENDER, desc(Avg_Com)))) +
  geom_bar(stat="identity", position = "dodge", color = "black") +
  geom_hline(yintercept = 0, color = "black") +
  labs(fill = "Gender") +
# Add and improve titles and labels
    ggtitle("Middle age female age groups has a high compensation") + 
    ylab("Average Compensation by Thousands") +
    xlab("Age Group") +
    scale_x_discrete(labels=c("Under 40", "40 to 51", "51 to 62", "62 to 73", "73 to 84", "84 +", "NA")) +
    scale_fill_manual(values = c("blue", "grey70"))+
 theme_classic() + 
  theme(axis.ticks.x = element_blank(),
        axis.ticks.y = element_blank(),)

```

###Older females observed to have significantly higher bonus 
+ Older females receive high bonus compared to males and other females
+ Older females high bonus makes the largest impact on why older females observed to have higher compensation. 



```{r echo=TRUE, message=FALSE, warning=FALSE}
grid.arrange(
#Male Data
  
datf %>%
  group_by(ageg) %>%
  summarise(Avg_Com = mean(BONUS)) %>%
  ggplot(aes(x = ageg, y = Avg_Com, )) +
  geom_bar(stat="identity", position = "dodge", color = "black") +
# Add and improve titles and labels
    ggtitle("Female 73 to 84 gets a large Bonus") + 
    ylab("Average Bonus by Thousands") +
    xlab("Female Age Group") +
    scale_x_discrete(labels=c("Under 40", "40 to 51", "51 to 62", "62 to 73", "73 to 84", "84 +", "NA")) +
    ylim(0, 2000) +
  

 theme_classic() + 
  theme(axis.ticks.x = element_blank(),
        axis.ticks.y = element_blank(),),
#Female Data
datm %>%
  group_by(ageg) %>%
  summarise(Avg_Com = mean(BONUS)) %>%
  ggplot(aes(x = ageg, y = Avg_Com, )) +
  geom_bar(stat="identity", position = "dodge", color = "black") +
# Add and improve titles and labels
    ggtitle("Male Bonus similar accross age group") + 
    ylab("Average Compensation by Thousands") +
    xlab("Male Age Group") +
    scale_x_discrete(labels=c("Under 40", "40 to 51", "51 to 62", "62 to 73", "73 to 84", "84 +", "NA")) +
  ylim(0, 2000) +


  theme_classic() + 
  theme(  axis.ticks.x = element_blank(),
          axis.title.y = element_blank(),
          axis.text.y = element_blank(),
          axis.ticks.y = element_blank()),
     #     panel.background = element_blank()),
ncol = 2
)
```

##Final Thoughts 
Analysis of Chief Executive Officers (CEOs) compensation seems to show us that Males and Females has different average compensation distribution. Older females having higher average compensation and Males having a normal distribution, due to higher bonus observed for older females