Organization 1

You are a member of the People Analytics team at Everhart Solutions, a professional services firm that has grown rapidly over the past year. As part of a broader initiative to improve new hire retention and engagement, the HR department has asked you to flag new employees hired in 2024 who may be at risk of early disengagement (i.e., are below the mean). In a new code chunk below, identify these individuals who may require early intervention (e.g., check-ins from managers, onboarding follow-ups, or mentoring support) to prevent disengagement or turnover. Provide the employee IDs of the individuals as an annotation.

Organization 2

You’ve recently been brought on as a consultant to Lindenbrook Manufacturing, a mid-sized company in the Midwest that has been operating for over 40 years. The organization has a reputation for promoting internally and values tradition in its HR practices.

You’re tasked with conducting a preliminary review of a recent promotion cycle at your firm, where promotions are typically awarded with year-end bonuses. Your firm takes a multi-factorial approach: considering personality characteristics and supervisor ratings.

Most managerial positions solely manage employees and do not interact with Lindenbrook’s clients. The HR team is concerned that the company may be promoting employees based on the wrong characteristics. In particular, there is concern that outgoing employees are being preferentially rated, even though this attribute is not the most important attribute for the day-to-day job responsibilities of managers.

Based on this information, create a code chunk below with the following:

1) Provide code and write in what the average extraversion score is among these individuals.

2) Analyze whether your company is disproportionately favoring extraversion when determining promotions? Provide both a metric and an interpretation to justify your answer. Is there a personality characteristic that does a better job at predicting job performance? This should be written to the head of the HR department. Consider what you know about the validity of personality traits as predictors of leadership potential or job performance in managerial roles based on class material.

The average extraversion in this cycle is 3.71. Promoted employees have a higher mean extraversion (4.49, n=41) than non-promoted employees (2.84, n=37); this difference is statistically significant (t=4.15, p=8.61e−05) with a large effect size (Cohen’s d=0.93). The point-biserial correlation between extraversion and promotion is r=0.427, indicating that promotions are favoring extraversion. In this dataset, simple correlations with supervisor-rated performance are small (openness −.186, conscientiousness −.185, extraversion −.073, agreeableness −.186, emotional stability −.186), so no trait clearly predicts ratings here; however, based on class material, conscientiousness is typically the most valid personality predictor for managerial performance.

3) Provide a brief written recommendation to the CEO of Lindenbrook regarding whether or not they should continue to use extraversion in the selection process. Based on what you know about selection, what other selection measures could Lindenbrook use to make better promotion decisions?

There is clear evidence that extraversion is being over-weighted in promotion decisions relative to job performance (4.49 vs 2.84; t=4.15, p=8.61e−05; d=0.93; r=0.427). I recommend reducing reliance on extraversion as a primary criterion and emphasizing job-relevant, higher-validity methods. Specifically, use structured behavior-based interviews mapped to managerial competencies, work-sample/in-basket exercises, cognitive/problem-solving measures aligned to the role, 360° leadership feedback, and objective performance metrics. These steps will better align promotions with actual job requirements and future performance.

getwd()

## [1] "/Users/timmydaly/Desktop/MGT HR"

library(readxl)
df <- read_xlsx("Practice_Org1.xlsx")
df$Start_Date <- as.Date(df$Start_Date)
df_2024 <- subset(df, format(Start_Date, "%Y") == "2024")
mean_engagement <- mean(df_2024$Engagement, na.rm = TRUE)
at_risk <- subset(df_2024, Engagement < mean_engagement)
print(at_risk)

## # A tibble: 15 × 6
##    ID    Last_Name First_Name  Start_Date Gender Engagement
##    <chr> <chr>     <chr>       <date>     <chr>       <dbl>
##  1 E0057 Holland   Kaylee      2024-07-08 Male         1.93
##  2 E0062 Gill      Sonia       2024-11-04 Male         3.06
##  3 E0083 Fernandez Christopher 2024-06-20 Male         3.47
##  4 E0120 Griffin   Willie      2024-06-18 Female       3.51
##  5 E0127 Orr       Dennis      2024-12-21 Female       3.76
##  6 E0151 Mcclure   Melanie     2024-01-17 Female       3.14
##  7 E0152 Levine    Amber       2024-02-05 Male         3.62
##  8 E0181 Miller    Kylie       2024-08-27 Male         1.96
##  9 E0235 Dunn      Shane       2024-10-06 Male         3.21
## 10 E0296 Ramirez   Andrew      2024-08-14 Female       2.87
## 11 E0305 Sandoval  Brittany    2024-06-15 Female       3.64
## 12 E0366 Chung     Lisa        2024-01-21 Male         2.65
## 13 E0390 Vasquez   Glenn       2024-08-16 Female       2.43
## 14 E0438 Day       Matthew     2024-06-09 Female       3.64
## 15 E0452 Turner    Anthony     2024-12-21 Female       3

cat("Employee IDs flagged for early intervention:\n")

## Employee IDs flagged for early intervention:

cat(at_risk$ID, sep = ", ")

## E0057, E0062, E0083, E0120, E0127, E0151, E0152, E0181, E0235, E0296, E0305, E0366, E0390, E0438, E0452

library(readxl)
org2 <- read_xlsx("Practice_Org2.xlsx", sheet = "Sheet1")
names(org2) 

## [1] "employee_ID"                  "department"                  
## [3] "openness"                     "conscientiousness"           
## [5] "extraversion"                 "agreeableness"               
## [7] "emotional stability"          "supervisor_rated_performance"
## [9] "promoted"

org2$extraversion[org2$extraversion == -9999] <- NA
p <- tolower(as.character(org2$promoted))
p[p %in% c("yes","y","true","1")] <- "1"
p[p %in% c("no","n","false","0")]  <- "0"
org2$promoted <- as.integer(p)
avg_extraversion <- mean(org2$extraversion, na.rm = TRUE)
avg_extraversion  # report this

## [1] 3.705128

tt <- t.test(org2$extraversion ~ org2$promoted)
traits <- c("openness","conscientiousness","extraversion","agreeableness","emotional stability")
cors_to_perf <- sapply(traits, function(v) cor(org2[[v]], org2$supervisor_rated_performance, use = "complete.obs"))
cors_to_perf  

##            openness   conscientiousness        extraversion       agreeableness 
##         -0.18609348         -0.18459481         -0.07275869         -0.18607471 
## emotional stability 
##         -0.18606527

p <- tolower(as.character(org2$promoted))
p[p %in% c("yes","y","true","1")] <- "1"
p[p %in% c("no","n","false","0")]  <- "0"
org2$promoted01 <- as.integer(p)
tapply(org2$extraversion, org2$promoted01, mean, na.rm = TRUE)

##        0        1 
## 2.837838 4.487805

t.test(org2$extraversion ~ org2$promoted01)

## 
##  Welch Two Sample t-test
## 
## data:  org2$extraversion by org2$promoted01
## t = -4.1499, df = 75.848, p-value = 8.608e-05
## alternative hypothesis: true difference in means between group 0 and group 1 is not equal to 0
## 95 percent confidence interval:
##  -2.4418566 -0.8580775
## sample estimates:
## mean in group 0 mean in group 1 
##        2.837838        4.487805

x1 <- org2$extraversion[org2$promoted01 == 1]
x0 <- org2$extraversion[org2$promoted01 == 0]
m1 <- mean(x1, na.rm = TRUE); m0 <- mean(x0, na.rm = TRUE)
s1 <-  sd(x1,  na.rm = TRUE); s0 <-  sd(x0,  na.rm = TRUE)
n1 <- sum(!is.na(x1));        n0 <- sum(!is.na(x0))
sp <- sqrt(((n1-1)*s1^2 + (n0-1)*s0^2) / (n1+n0-2))
d  <- (m1 - m0) / sp
cor(org2$extraversion, org2$promoted01, use = "complete.obs")

## [1] 0.4271286

traits <- c("openness","conscientiousness","extraversion","agreeableness","emotional stability")
cors_to_perf <- sapply(traits, function(v) cor(org2[[v]], org2$supervisor_rated_performance, use = "complete.obs"))
cors_to_perf

##            openness   conscientiousness        extraversion       agreeableness 
##         -0.18609348         -0.18459481         -0.07275869         -0.18607471 
## emotional stability 
##         -0.18606527

org2$promoted01 <- as.integer(tolower(as.character(org2$promoted)) %in% c("yes","y","true","1"))