Data processing and analysis - AI Discrimination - Deciders
Alexia Gaudeul
02/09/2024
Loading libraries
……………..
Cleaning data and creating variables
……………..
data_HR <- read_sav("22-050944 JRC AI Discrimination Deciders_Employers_Main_Client.sav")
data_Bank <- read_sav("22-050944 JRC AI Discrimination Deciders_Lenders_Main_Client.sav")
# Combine the two datasets into one
data <- rbind(data_Bank, data_HR)
# Convert the combined data into a dataframe
data <- as.data.frame(data)
# Remove columns that are completely empty (i.e., all NA values)
data <- Filter(function(x)!all(is.na(x)), data)
# Assign numeric values for the index of presentation of pairs of applicants (Group)
data$Group <- as.numeric(data$QT_group)
# Create an 'Order' variable based on 'Order2' and 'Group' variables (the order was reversed half of the time)
data$Order <- ifelse(data$Order2 == 1, data$Group, 13 - data$Group)
# Check the Respondent_Serial variable to detect issues like duplicated IDs
# Filter the data for Group 1 and sort it by Respondent_Serial
datax <- subset.data.frame(data, Group == 1)
datax <- arrange(datax, Respondent_Serial)
# Plot the Respondent_Serial to visualize duplicates
#plot(datax$Respondent_Serial)
# Create a frequency table for index values and check for duplicates
index <- table(index(data), useNA = "ifany")
sum(duplicated(datax$Respondent_Serial))## [1] 131# Generate an ID variable for the data
data$ID <- c(t(matrix(rep(c(1:1411), 12), 1411, 12)))
# Assign Sector and Country variables with appropriate labels
data$Sector <- data$SCR1
data$SectorF <- as.factor(data$SCR1)
levels(data$SectorF) <- c("HR", "Banking")
data$CountryF <- as.factor(data$Country)
levels(data$CountryF)<-c("Germany", "Italy")
# Assign Treatment variable with appropriate labels
data$TreatmentF <- as.factor(data$Treatment)
levels(data$TreatmentF)<-c("Own","Discrim AI","Fair AI")
# Assign Pool variable (sets of 12 pairs of applicants for choice)
data$PoolF <- as.factor(data$Pool)Applicant and decider variables
# Gender and country of decider, applicant 1, and applicant 2
data$gender_dec <- data$resp_gender
data$Woman_dec <- data$gender_dec - 1
data$country_dec <- data$Country
data$Italian_dec <- data$country_dec - 1
# Gender variables for deciders and applicants
data$gender_decF <- as.factor(data$gender_dec)
levels(data$gender_decF)<-c("Male","Female")
data$gender_1F <- as.factor(data$gender_1)
levels(data$gender_1F)<-c("Male","Female")
data$gender_2F <- as.factor(data$gender_2)
levels(data$gender_2F)<-c("Male","Female")
# Country variables for deciders and applicants
data$country_decF <- as.factor(data$country_dec)
levels(data$country_decF)<-c("Germany", "Italy")
data$country_1F <- as.factor(data$country_1)
levels(data$country_1F)<-c("Germany", "Italy")
data$country_2F <- as.factor(data$country_2)
levels(data$country_2F)<-c("Germany", "Italy")
# Education level of decider categorized into Low, Middle, and High
data$education_dec <- data$ISCED2
data$education_decF <- as.factor(data$education_dec)
levels(data$education_decF)<- c("Low", "Middle", "High")
# Age categorization for deciders into 18-34, 35-54, and 55-65
score_measure <- function(x) {
ifelse(x <= 17, 0,
ifelse(x >= 18 & x <= 34, 1,
ifelse(x >= 35 & x <= 54, 2,
ifelse(x >= 55 & x <= 65, 3,
ifelse(x >= 66, 4, NA) # Handles cases outside the specified ranges
)
)
)
)
}
data$resp_age<-as.numeric(data$resp_age)
#data$resp_age <- ifelse(is.na(data$resp_age), 0, data$resp_age)
data$age_dec <- score_measure(data$resp_age)
data$age_decF <- as.factor(data$age_dec)
levels(data$age_decF)<- c("18-34", "35-54", "55-65")
# Income level categorization for deciders based on country
hist(data$D6_DE, xlim = c(0, 10), breaks = c(1:100) - 0.01)
income_level <- function(x) {
ifelse(x <= 3, 1,
ifelse(x == 4, 2,
ifelse(x == 5, 3,
ifelse(x >= 6, 0, NA) # Handles cases outside the specified ranges
)
)
)
}
data$D6_DE <- as.numeric(data$D6_DE) # Ensure conversion to numeric
data$D6_IT <- as.numeric(data$D6_IT) # Ensure conversion to numeric
data$income_dec <- ifelse(data$country_dec == 1, income_level(data$D6_DE), income_level(data$D6_IT))
data$income_decF <- as.factor(data$income_dec)
levels(data$income_decF) <- c("Low", "Middle", "High", "Unknown")Differences between applicant 1 and 2
# Create new variables that represent differences between two applicants
data <- transform(data,
# Difference in gender between applicant 1 and applicant 2
W_vs_M = gender_1 - gender_2,
# Difference in nationality between applicant 1 and applicant 2
Ita_vs_Ger = country_1 - country_2,
# Difference in age between applicant 1 and applicant 2
age_diff = age_1 - age_2,
# Difference in education level between applicant 1 and applicant 2
education_diff = education_1 - education_2,
# Difference in income between applicant 1 and applicant 2
# If income of either applicant is 0 (unknown), the difference is set to 0
income_diff = ifelse(income_1 == 0 | income_2 == 0, 0, income_1 - income_2),
# Difference in interview scores between applicant 1 and applicant 2
interview_diff = interview_1 - interview_2
)
# Summarize the income differences to understand the distribution
#summary(data$income_diff)
# Create a new factor variable to categorize the gender difference
# -1 -> Man vs Woman, 0 -> Same gender, 1 -> Woman vs Man
data$W_vs_M_F <- as.factor(data$W_vs_M) %>%
fct_recode("WM" = "-1", "Same" = "0", "MW" = "1")
# Create a new factor variable to categorize the nationality difference
# -1 -> Germany vs Italy, 0 -> Same country, 1 -> Italy vs Germany
data$Ita_vs_Ger_F <- as.factor(data$Ita_vs_Ger) %>%
fct_recode("GI" = "-1", "Same" = "0", "IG" = "1")
# Define the levels of age groups and education levels for further processing
# Age groups: "18-31" -> 1, "32-46" -> 2, "47-55" -> 3, "56-65" -> 4
# Education levels: "Low" -> 1, "Middle" -> 2, "High" -> 3
# Calculate differences in AI evaluations between two applicants
data <- transform(data,
# Difference in gender-based grade between applicant 1 and applicant 2
gender_grade_diff = gender_grade_1 - gender_grade_2,
# Difference in country-based grade between applicant 1 and applicant 2
country_grade_diff = country_grade_1 - country_grade_2,
# Difference in age-based grade between applicant 1 and applicant 2
age_grade_diff = age_grade_1 - age_grade_2,
# Difference in education-based grade between applicant 1 and applicant 2
education_grade_diff = education_grade_1 - education_grade_2,
# Difference in income-based grade between applicant 1 and applicant 2
income_grade_diff = income_grade_1 - income_grade_2,
# Difference in interview-based grade between applicant 1 and applicant 2
interview_grade_diff = interview_grade_1 - interview_grade_2,
# Difference in overall grade between applicant 1 and applicant 2
overall_grade_diff = overall_grade_1 - overall_grade_2
)
# Create a factor variable for overall grade differences to categorize it
data$overall_grade_diffF <- as.factor(data$overall_grade_diff)
# Determine which applicant is recommended based on the overall grade difference
# 0 -> Neither recommended, -1 -> Applicant 2 recommended, 1 -> Applicant 1 recommended
data$diff_recommended <- ifelse(data$overall_grade_diff == 0, 0, data$overall_grade_diff / abs(data$overall_grade_diff))Looking at pairs of applicants offered for choice
# Pairs of applicants analysis
# Filter the dataset to focus on the "Discriminatory AI" treatment within the first pool and the HR sector.
# Select relevant columns that include information about the treatment, group, sector, gender, nationality, and overall grades of the two applicants.
data %>%
filter(TreatmentF == "Discrim AI") %>% # Filter for the "Discrim AI" treatment
filter(Pool == 1) %>% # Further filter to only include Pool 1
filter(SectorF == "HR") %>% # Further filter to only include the HR sector
select("TreatmentF", "QT_group", "SectorF", "gender_1", "gender_2", "country_1", "country_2", "overall_grade_1", "overall_grade_2")TreatmentF | QT_group | SectorF | gender_1 | gender_2 | country_1 | country_2 | overall_grade_1 | overall_grade_2 |
|---|---|---|---|---|---|---|---|---|
factor | character | factor | haven_labelled | haven_labelled | haven_labelled | haven_labelled | numeric | numeric |
Discrim AI | 1 | HR | 2.0 | 2.0 | 1.0 | 2.0 | 1 | 3 |
Discrim AI | 2 | HR | 1.0 | 1.0 | 2.0 | 1.0 | 5 | 4 |
Discrim AI | 3 | HR | 2.0 | 2.0 | 1.0 | 1.0 | 1 | 2 |
Discrim AI | 4 | HR | 2.0 | 1.0 | 1.0 | 1.0 | 5 | 5 |
Discrim AI | 5 | HR | 2.0 | 1.0 | 1.0 | 1.0 | 1 | 2 |
Discrim AI | 6 | HR | 2.0 | 1.0 | 2.0 | 2.0 | 2 | 1 |
Discrim AI | 7 | HR | 1.0 | 1.0 | 1.0 | 2.0 | 5 | 5 |
Discrim AI | 8 | HR | 2.0 | 1.0 | 2.0 | 2.0 | 5 | 4 |
Discrim AI | 9 | HR | 2.0 | 2.0 | 1.0 | 1.0 | 5 | 4 |
Discrim AI | 10 | HR | 2.0 | 1.0 | 2.0 | 2.0 | 2 | 1 |
Discrim AI | 11 | HR | 2.0 | 2.0 | 1.0 | 2.0 | 4 | 5 |
Discrim AI | 12 | HR | 2.0 | 2.0 | 1.0 | 2.0 | 2 | 1 |
n: 96 | ||||||||
# Note: In most pools, applicants were matched based on gender or nationality, such as matching a man with a woman of the same nationality, or an Italian with a German of the same gender.
# Create a crosstable to analyze the distribution of the number of choices across different combinations of gender and nationality.
# The table shows the mean, standard deviation, and count (N) for each combination.
subset.data.frame(data) %>%
crosstable(
c("ID"), # Use the "ID" column to identify unique records
by = c("W_vs_M", "Ita_vs_Ger"), # Group by gender comparison (W_vs_M) and nationality comparison (Ita_vs_Ger)
funs = c(N), # Calculate the count for each group
margin = "row" # Calculate row margins (totals) in the table
) %>%
as_flextable() # Convert the crosstable to a flextable for easier visualizationlabel | variable | Ita_vs_Ger=-1 | Ita_vs_Ger=0 | Ita_vs_Ger=1 | ||||||
|---|---|---|---|---|---|---|---|---|---|---|
W_vs_M=-1 | W_vs_M=0 | W_vs_M=1 | W_vs_M=-1 | W_vs_M=0 | W_vs_M=1 | W_vs_M=-1 | W_vs_M=0 | W_vs_M=1 | ||
ID | c(N) | 0 | 7276 | 449 | 204 | 1035 | 6691 | 63 | 131 | 1083 |
# Analysis of choices based on country and gender combinations:
# Different country and same gender:
# Calculate the ratio for different countries but same gender: (7276 + 131) / 1411 = 5.24
# Different country and different gender:
# Calculate the ratio for different countries and different gender: (449 + 1083 + 63) / 1411 = 1.13
# Same country and same gender:
# Calculate the ratio for same country and same gender: 1035 / 1411 = 0.73
# Same country and different gender:
# Calculate the ratio for same country and different gender: (6691 + 204) / 1411 = 4.89
# The sum of these ratios (5.24 + 1.13 + 0.73 + 4.89) equals 12, which represents the total number of choices to be made.Choice variables
# Decoding the choice of applicant 1
# The original variable 'QT' is recoded so that 'choice_1' indicates whether applicant 1 was chosen.
# If 'QT' is 1, 'choice_1' becomes 1 (meaning applicant 1 was chosen).
# If 'QT' is 2, 'choice_1' becomes 0 (meaning applicant 2 was chosen).
data$choice_1 <- 2 - data$QT
# Determining if deciders are following AI's recommendation
# 'follow_AI' is a logical variable indicating whether the human decider followed the AI's recommendation.
# If 'diff_recommended' is 0 (no clear recommendation by AI), 'follow_AI' is set to NA.
# Otherwise, 'follow_AI' checks whether the choice made by the decider aligns with the AI's recommendation:
# - If 'diff_recommended' is 1 (AI recommends applicant 1) and 'choice_1' is 1 (decider chose applicant 1), 'follow_AI' is TRUE.
# - If 'diff_recommended' is -1 (AI recommends applicant 2) and 'choice_1' is 0 (decider chose applicant 2), 'follow_AI' is TRUE.
# - Otherwise, 'follow_AI' is FALSE.
data$follow_AI <- ifelse(data$diff_recommended == 0, NA,
(data$choice_1 == 1 & data$diff_recommended == 1) |
(data$choice_1 == 0 & data$diff_recommended == -1))
# Creating a variable to indicate if the decider chose a woman
# 'choice_woman' is a logical variable that is TRUE if the decider chose a female applicant:
# - If 'choice_1' is 1 and 'gender_1F' is "Female", the decider chose applicant 1 who is a woman.
# - If 'choice_1' is 0 and 'gender_2F' is "Female", the decider chose applicant 2 who is a woman.
data <- transform(data, choice_woman = (choice_1 == 1 & gender_1F == "Female") |
(choice_1 == 0 & gender_2F == "Female"))
# Creating a variable to indicate if the decider chose an Italian applicant
# 'choice_Italian' is a logical variable that is TRUE if the decider chose an Italian applicant:
# - If 'choice_1' is 1 and 'country_1F' is "Italy", the decider chose applicant 1 who is Italian.
# - If 'choice_1' is 0 and 'country_2F' is "Italy", the decider chose applicant 2 who is Italian.
data <- transform(data, choice_Italian = (choice_1 == 1 & country_1F == "Italy") |
(choice_1 == 0 & country_2F == "Italy"))Decider preference across candidates
# Recode the ranking of candidates by the decider
# The original rankings (QRANK1_1 to QRANK1_6) are in a scale where 1 is the best and 4 is the worst.
# The code subtracts each ranking from 4 to invert the scale, making 4 the best and 1 the worst.
# This makes higher values represent higher preferences in subsequent analyses.
data$QRANK1_1 <- 4 - data$QRANK1_1
data$QRANK1_2 <- 4 - data$QRANK1_2
data$QRANK1_3 <- 4 - data$QRANK1_3
data$QRANK1_4 <- 4 - data$QRANK1_4
data$QRANK1_5 <- 4 - data$QRANK1_5
data$QRANK1_6 <- 4 - data$QRANK1_6
# Recode gender ranking by the decider
# The original variable 'QRank2_Gender' is on a scale where 1 might represent a preference for males and 2 for females.
# The code inverts the scale so that higher values represent a preference for females.
# Then, the gender variable is converted into a factor with labels "Male" and "Female".
data$QRank2_Gender <- 3 - data$QRank2_Gender
data$QRank2_GenderF <- as.factor(data$QRank2_Gender) %>% fct_recode("Male" = "1", "Female" = "2")
# Recode country ranking by the decider
# The country variable 'QRank2_Country' is converted into a factor with labels "Germany" and "Italy".
data$QRank2_CountryF <- as.factor(data$QRank2_Country) %>% fct_recode("Germany" = "1", "Italy" = "2")
# Recode age ranking by the decider
# The age variable 'QRank2_Age' is converted into a factor with labels representing different age groups.
data$QRank2_AgeF <- as.factor(data$QRank2_Age) %>% fct_recode("18-34" = "1", "35-54" = "2", "55-65" = "3")
# Recode education level ranking by the decider
# The education variable 'QRank2_Education' is converted into a factor with labels "Low", "Middle", and "High".
data$QRank2_EducationF <- as.factor(data$QRank2_Education) %>% fct_recode("Low" = "1", "Middle" = "2", "High" = "3")
# Recode income level ranking by the decider
# The income variable 'QRank2_Income' is converted into a factor with labels "Low", "Middle", "High", and "Unknown".
data$QRank2_IncomeF <- as.factor(data$QRank2_Income) %>% fct_recode("Low" = "1", "Middle" = "2", "High" = "3", "Unknown" = "4")
# Recode interview assessment by the decider
# The interview variable 'QRank2_Interview' is converted into a factor with labels representing different interview ratings.
data$QRank2_InterviewF <- as.factor(data$QRank2_Interview) %>% fct_recode("Bad" = "1", "OK" = "2", "Good" = "3", "Very good" = "4")Inputting the performance and behavior of applicants in the two tasks (summing/lending)
# Processing to insert real performance data, formatted for final data from deciders
# Read the real performance grades for the "HR" group in the efficient treatment (Treatment 2)
grades_eff_HR <- read.xlsx("grading_HR_treatment_2_efficient.xlsx", 1)
# Create an "applicant" column that alternates between 1 and 2 for each row
grades_eff_HR$applicant <- rep(c(1:2), nrow(grades_eff_HR) / 2)
# Create an "id_var" column to uniquely identify each pair of applicants
grades_eff_HR$id_var <- c(rbind(c(1:(nrow(grades_eff_HR) / 2)), c(1:(nrow(grades_eff_HR) / 2))))
# Assign "GROUP" as 1 (assuming this is the HR group) and "Treatment" as 2 (efficient treatment)
grades_eff_HR$GROUP <- 1
grades_eff_HR$Treatment <- 2
# Reshape the data from long to wide format, with one row per pair of applicants
grades_eff_HR_wide <- reshape(grades_eff_HR, idvar = "id_var", timevar = "applicant", direction = "wide")
# Duplicate the HR grades data for the baseline treatment (Treatment 1)
grades_HR <- grades_eff_HR
grades_HR$Treatment <- 1
grades_HR_wide <- reshape(grades_HR, idvar = "id_var", timevar = "applicant", direction = "wide")
# Read the real performance grades for the "HR" group in the fair treatment (Treatment 3)
grades_fair_HR <- read.xlsx("grading_HR_treatment_3_fair.xlsx", 1)
grades_fair_HR$applicant <- rep(c(1:2), nrow(grades_fair_HR) / 2)
grades_fair_HR$id_var <- c(rbind(c(1:(nrow(grades_fair_HR) / 2)), c(1:(nrow(grades_fair_HR) / 2))))
grades_fair_HR$GROUP <- 1
grades_fair_HR$Treatment <- 3
grades_fair_HR_wide <- reshape(grades_fair_HR, idvar = "id_var", timevar = "applicant", direction = "wide")
# Repeat the above steps for the "Banking" group
grades_eff_banking <- read.xlsx("grading_banking_treatment_2_efficient.xlsx", 1)
grades_eff_banking$applicant <- rep(c(1:2), nrow(grades_eff_banking) / 2)
grades_eff_banking$id_var <- c(rbind(c(1:(nrow(grades_eff_banking) / 2)), c(1:(nrow(grades_eff_banking) / 2))))
grades_eff_banking$GROUP <- 2
grades_eff_banking$Treatment <- 2
grades_eff_banking_wide <- reshape(grades_eff_banking, idvar = "id_var", timevar = "applicant", direction = "wide")
grades_banking <- grades_eff_banking
grades_banking$Treatment <- 1
grades_banking_wide <- reshape(grades_banking, idvar = "id_var", timevar = "applicant", direction = "wide")
grades_fair_banking <- read.xlsx("grading_banking_treatment_3_fair.xlsx", 1)
grades_fair_banking$applicant <- rep(c(1:2), nrow(grades_fair_banking) / 2)
grades_fair_banking$id_var <- c(rbind(c(1:(nrow(grades_fair_banking) / 2)), c(1:(nrow(grades_fair_banking) / 2))))
grades_fair_banking$GROUP <- 2
grades_fair_banking$Treatment <- 3
grades_fair_banking_wide <- reshape(grades_fair_banking, idvar = "id_var", timevar = "applicant", direction = "wide")
# Combine all the grades data into one dataset
grades_wide <- rbind(grades_HR_wide, grades_eff_HR_wide, grades_fair_HR_wide, grades_banking_wide, grades_eff_banking_wide, grades_fair_banking_wide)
# Standardize variable names across the dataset
grades_wide$Group <- grades_wide$order.1
grades_wide$Pool <- grades_wide$pool.1
grades_wide$Treatment <- grades_wide$Treatment.1
grades_wide$GROUP <- grades_wide$GROUP.1
# Merge the grades data with the main dataset based on the identifiers "GROUP", "Treatment", "Group", and "Pool"
total <- merge(data, grades_wide, by = c("GROUP", "Treatment", "Group", "Pool"))
# View a subset of the merged dataset to check that the merge worked as expected
#View(total[, c("GROUP", "Treatment", "Group", "Pool", "GROUP.1", "Treatment.1", "order.1", "pool.2", "country_1", "gender_1", "income_1", "age_1", "education_1", "interview_1", "country.1", "gender.1", "income.1", "age.1", "education.1", "interview.1")])
# Update the main dataset with the merged data
data <- total
# Create a binary variable indicating whether the choice of applicant 1 was correct based on their real scores
data$choice_1_correct <- data$Real_Scores.1 > data$Real_Scores.2
# Calculate the difference in real scores between applicant 1 and applicant 2
data$choice_1_diff <- data$Real_Scores.1 - data$Real_Scores.2
# Plot the relationship between the overall grade difference and the score difference
# plot(data$overall_grade_diff, data$choice_1_diff, main = "Main title", xlab = "X axis title", ylab = "Y axis title", pch = 19)
# Create a similar plot using ggplot, with separate facets for each group and treatment
# ggplot(data, aes(x = overall_grade_diff, y = choice_1_diff)) + geom_point() + facet_grid(GROUP ~ Treatment)
# Create a variable representing the real score of the chosen applicant
data$Real_Scores_chosen <- ifelse(data$choice_1 == 0, data$Real_Scores.2, data$Real_Scores.1)
# Create a variable representing AI's recommendation based on the overall grade difference
# If the overall grade difference is positive, AI recommends applicant 1; if negative, applicant 2
# If there is no difference, AI is neutral (0.5).
data$choice_1_AI <- ifelse(data$overall_grade_diff > 0, 1, ifelse(data$overall_grade_diff < 0, 0, 0.5))
# Create a variable representing the real score of the AI-recommended applicant
# If AI is neutral, the average score of both applicants is taken
data$Real_Scores_recommended <- ifelse(data$choice_1_AI == 0, data$Real_Scores.2,
ifelse(data$choice_1_AI == 1, data$Real_Scores.1,
(data$Real_Scores.1 + data$Real_Scores.2) / 2))Work experience and environment
# Recode categorical variables for work experience and environment
# Q15: Years of experience in the current position
data$Q15F <- as.factor(data$Q15) %>%
fct_recode("Less than one year" = "1",
"Between one and two years" = "2",
"Between three and five years" = "3",
"More than five years" = "4")
# Q16: Number of employees the respondent manages in their current position
data$Q16F <- as.factor(data$Q16) %>%
fct_recode("In my current position no one reports to me" = "1",
"Between 1 and 5 employees" = "2",
"Between 6 and 10 employees" = "3",
"Between 11 and 20 employees" = "4",
"More than 20 employees" = "5",
"I don’t know" = "98")
# Q17: Size of the company the respondent works for
data$Q17F <- as.factor(data$Q17) %>%
fct_recode("Less than 10 employees" = "1",
"10-49 employees" = "2",
"50-249 employees" = "3",
"More than 250 employees" = "4",
"I don’t know" = "98")
# Q18: Frequency of dealing with data
data$Q18F <- as.factor(data$Q18) %>%
fct_recode("Very often" = "1",
"Sometimes" = "2",
"Rarely" = "3",
"Never" = "4")
# Q19: Frequency of dealing with DSS
data$Q19F <- as.factor(data$Q19) %>%
fct_recode("Very often" = "1",
"Sometimes" = "2",
"Rarely" = "3",
"Never" = "4",
"I don't know" = "98")
# Q21: Perceived diversity in the workplace
data$Q21F <- as.factor(data$Q21) %>%
fct_recode("Yes, there is a lot of diversity" = "1",
"Yes, there is some diversity" = "2",
"No, there is not much diversity" = "3",
"No, there is no diversity" = "4")
# Q22: Awareness of diversity policies in the workplace
data$Q22F <- as.factor(data$Q22) %>%
fct_recode("Yes" = "1",
"No" = "2",
"I don’t know" = "98")
# Q23: Perception of how well diversity is managed in the workplace
data$Q23F <- as.factor(data$Q23) %>%
fct_recode("Very well" = "1",
"Well" = "2",
"Average" = "3",
"Badly" = "4",
"Very badly" = "5",
"I don’t know" = "98")
# Handling NA values and reversing scales for analysis purposes
# Convert Q15 (years of experience) to a numeric variable, setting "I don't know" (98) as NA
data$Q15N <- ifelse(data$Q15 == 98, NA, data$Q15)
# Convert Q16 (number of employees managed) to a numeric variable, setting "I don't know" (98) as NA
data$Q16N <- ifelse(data$Q16 == 98, NA, data$Q16)
# Convert Q17 (size of the company) to a numeric variable, setting "I don't know" (98) as NA
data$Q17N <- ifelse(data$Q17 == 98, NA, data$Q17)
# Reverse the scale for Q18 (dealing with data) for consistency (higher number means more frequent)
data$Q18RN <- 5 - data$Q18
# Reverse the scale for Q19 (dealing with DSS) and handle NA for "I don't know"
data$Q19RN <- ifelse(data$Q19 == 98, NA, 5 - data$Q19)
# Reverse the scale for Q21 (perceived diversity in the workplace) for analysis
data$Q21RN <- 5 - data$Q21
# Recode Q22 (awareness of diversity policies) to a numeric scale and reverse it (1 for "Yes" becomes 2, and 2 becomes 1)
data$Q22RN <- ifelse(data$Q22 == 98, NA, 3 - data$Q22)
# Reverse the scale for Q23 (perception of how well diversity is managed) and handle NA for "I don't know"
data$Q23RN <- ifelse(data$Q23 == 98, NA, 6 - data$Q23)Summary measure of preference across applicants
# Check the consistency of recoded factors by creating contingency tables
# These tables help verify that the recoding was done correctly by comparing original and recoded variables
# table(data$QRank2_Gender, data$QRank2_GenderF)
# table(data$QRank2_Country, data$QRank2_CountryF)
# table(data$QRank2_Age, data$QRank2_AgeF)
# table(data$QRank2_Education, data$QRank2_EducationF)
# table(data$QRank2_Income, data$QRank2_IncomeF)
# table(data$QRank2_Interview, data$QRank2_InterviewF)
# Create numeric variables that quantify preferences
# Gender: If the gender rank is missing (i.e. the person thought the gender was irrelevant), set to 0, otherwise calculate based on gender (Male=1, Female=2), on a scale from -1 to 1.
data$QRank2_GenderN <- ifelse(is.na(data$QRank2_Gender), 0, (2 * data$QRank2_Gender - 3))
# Age: If the age rank is missing, set to 0, otherwise calculate based on age (18-34=1, 35-54=2, 55-65=3)
data$QRank2_AgeN <- ifelse(is.na(data$QRank2_Age), 0, (data$QRank2_Age - 2))
# Country: If the country rank is missing, set to 0, otherwise calculate based on country (Germany=1, Italy=2)
data$QRank2_CountryN <- ifelse(is.na(data$QRank2_Country), 0, (2 * data$QRank2_Country - 3))
# Education: If the education rank is missing, set to 0, otherwise calculate based on education (Low=1, Middle=2, High=3)
data$QRank2_EducationN <- ifelse(is.na(data$QRank2_Education), 0, (data$QRank2_Education - 2))
# Income: If the income rank is missing or the person preferred "unknown" income (4), set to 0, otherwise calculate based on income (Low=1, Middle=2, High=3)
data$QRank2_IncomeN <- ifelse(is.na(data$QRank2_Income), 0, ifelse(data$QRank2_Income == 4, 0, (data$QRank2_Income - 2)))
# Interview performance: If the interview rank is missing, set to 0, otherwise calculate based on interview (Bad=1 to Very good=4)
data$QRank2_InterviewN <- ifelse(is.na(data$QRank2_Interview), 0, (2 * data$QRank2_Interview - 5) / 3)
# Summarize the new numeric variables to understand their distributions
#with(data, summary(cbind(QRank2_GenderN, QRank2_AgeN, QRank2_CountryN, QRank2_EducationN, QRank2_IncomeN, QRank2_InterviewN)))
# Calculate preference scores by multiplying each numeric preference variable with the corresponding rank
data$Preference_Women <- data$QRANK1_1 * data$QRank2_GenderN
data$Preference_Old <- data$QRANK1_2 * data$QRank2_AgeN
data$Preference_Italy <- data$QRANK1_3 * data$QRank2_CountryN
data$Preference_Educated <- data$QRANK1_4 * data$QRank2_EducationN
data$Preference_Rich <- data$QRANK1_5 * data$QRank2_IncomeN
data$Preference_Interview <- data$QRANK1_6 * data$QRank2_InterviewN
# Summarize the preference scores to get an overview of how the preferences are distributed
#with(data, summary(cbind(Preference_Women, Preference_Old, Preference_Italy, Preference_Educated, Preference_Rich, Preference_Interview)))Prejudice index
# Recode responses for gender-based prejudice (Q7_1 to Q7_4)
# This recoding assigns descriptive labels to the numeric responses:
# 1 = "Men better", 2 = "Equal", 3 = "Women better"
data$Q7_1 <- as.factor(data$Q7_1) %>% fct_recode("Men better" = "1", "Equal" = "2", "Women better" = "3")
data$Q7_2 <- as.factor(data$Q7_2) %>% fct_recode("Men better" = "1", "Equal" = "2", "Women better" = "3")
data$Q7_3 <- as.factor(data$Q7_3) %>% fct_recode("Men better" = "1", "Equal" = "2", "Women better" = "3")
data$Q7_4 <- as.factor(data$Q7_4) %>% fct_recode("Men better" = "1", "Equal" = "2", "Women better" = "3")
# Recode responses for nationality-based prejudice (Q8_1 to Q8_4)
# This recoding assigns descriptive labels to the numeric responses:
# 1 = "German better", 2 = "Equal", 3 = "Italian better"
data$Q8_1 <- as.factor(data$Q8_1) %>% fct_recode("German better" = "1", "Equal" = "2", "Italian better" = "3")
data$Q8_2 <- as.factor(data$Q8_2) %>% fct_recode("German better" = "1", "Equal" = "2", "Italian better" = "3")
data$Q8_3 <- as.factor(data$Q8_3) %>% fct_recode("German better" = "1", "Equal" = "2", "Italian better" = "3")
data$Q8_4 <- as.factor(data$Q8_4) %>% fct_recode("German better" = "1", "Equal" = "2", "Italian better" = "3")
# Convert the gender prejudice factors to numeric values for calculation
data$Q7_1_N <- as.numeric(data$Q7_1)
data$Q7_2_N <- as.numeric(data$Q7_2)
data$Q7_3_N <- as.numeric(data$Q7_3)
data$Q7_4_N <- as.numeric(data$Q7_4)
# Calculate the average prejudice score for gender by taking the mean of Q7_1_N to Q7_4_N
# This index reflects an average bias level, with higher values indicating a preference for women
data <- transform(data, Q7 = (Q7_1_N + Q7_2_N + Q7_3_N + Q7_4_N) / 4)
# Summarize the average gender prejudice score
#summary(data$Q7)
# Calculate the index for prejudice against women
# Here, 2 is subtracted from the average score to center the index around neutrality (0)
# Positive values indicate prejudice against women, while negative values indicate prejudice in favor of women
data$Prejudice_vs_Women <- 2 - data$Q7
# Convert the nationality prejudice factors to numeric values for calculation
data$Q8_1_N <- as.numeric(data$Q8_1)
data$Q8_2_N <- as.numeric(data$Q8_2)
data$Q8_3_N <- as.numeric(data$Q8_3)
data$Q8_4_N <- as.numeric(data$Q8_4)
# Calculate the average prejudice score for nationality by taking the mean of Q8_1_N to Q8_4_N
# This index reflects an average bias level, with higher values indicating a preference for Italians
data <- transform(data, Q8 = (Q8_1_N + Q8_2_N + Q8_3_N + Q8_4_N) / 4)
# Summarize the average nationality prejudice score
#summary(data$Q8)
# Calculate the index for prejudice against Italians
# Similar to gender, 2 is subtracted from the average score to center the index around neutrality (0)
# Positive values indicate prejudice against Italians, while negative values indicate prejudice in favor of Italians
data$Prejudice_vs_Italy <- 2 - data$Q8Index of similarity between applicants and the decider
# Calculate differences between the decider's characteristics and applicant 1's characteristics
# Differences are calculated as absolute values, with some adjustments for scaling
data <- transform(data,
diff_applicant_1_gender = abs(gender_dec - gender_1),
diff_applicant_1_age = abs(age_dec - age_1) / 3,
diff_applicant_1_country = abs(country_dec - country_1),
diff_applicant_1_education = abs(education_dec - education_1) / 2,
diff_applicant_1_income = ifelse(income_1 == 0 | income_dec == 0, 0, abs(income_dec - income_1) / 2))
# Summarize differences to understand the range and distribution of these values
# summary(abs(data$income_dec - data$income_1))
# summary(data$diff_applicant_1_gender)
# summary(data$diff_applicant_1_income)
# summary(data$diff_applicant_1_age)
# summary(data$diff_applicant_1_education)
# Combine the individual differences into a single index for applicant 1
# Average the absolute differences to get an overall similarity score
data <- transform(data,
diff_applicant_1 = (diff_applicant_1_gender + diff_applicant_1_age + diff_applicant_1_country + diff_applicant_1_education + diff_applicant_1_income) / 5)
# Calculate differences between the decider's characteristics and applicant 2's characteristics
# Similar to above, but for applicant 2
data <- transform(data,
diff_applicant_2_gender = abs(gender_dec - gender_2),
diff_applicant_2_age = abs(age_dec - age_2) / 3,
diff_applicant_2_country = abs(country_dec - country_2),
diff_applicant_2_education = abs(education_dec - education_2) / 2,
diff_applicant_2_income = ifelse(income_2 == 0 | income_dec == 0, 0, abs(income_dec - income_2) / 2))
# Combine the individual differences into a single index for applicant 2
# Average the absolute differences to get an overall similarity score
data <- transform(data,
diff_applicant_2 = (diff_applicant_2_gender + diff_applicant_2_age + diff_applicant_2_country + diff_applicant_2_education + diff_applicant_2_income) / 5)
# Calculate the difference in similarity indices between applicant 1 and applicant 2
# This indicates which applicant is more similar to the decider
data$diff_diff_applicant = data$diff_applicant_1 - data$diff_applicant_2
# Calculate the differences in individual characteristics between the two applicants
# This provides insight into which specific areas contribute to the overall similarity difference
data$diff_diff_applicant_gender = data$diff_applicant_1_gender - data$diff_applicant_2_gender
data$diff_diff_applicant_age = data$diff_applicant_1_age - data$diff_applicant_2_age
data$diff_diff_applicant_country = data$diff_applicant_1_country - data$diff_applicant_2_country
data$diff_diff_applicant_education = data$diff_applicant_1_education - data$diff_applicant_2_education
data$diff_diff_applicant_income = data$diff_applicant_1_income - data$diff_applicant_2_incomeInputting AI preferences as shown to deciders
# AI preferences
# from 0 to 3, irrelevant to very important, as communicated to participants
# Importance ratings assigned based on Treatment and Sector
# 3 = High importance, 2 = Middle importance, 1 = Low importance, 0 = Irrelevant
# Gender importance rating
data$QRANK1_1_AI <- with(data, case_when(
TreatmentF == "Discrim AI" & SectorF == "HR" ~ 3, # High importance for Discrim AI in HR sector
TreatmentF == "Fair AI" & SectorF == "HR" ~ 0, # Irrelevant for Fair AI in HR sector
TreatmentF == "Discrim AI" & SectorF == "Banking" ~ 3, # High importance for Discrim AI in Banking sector
TreatmentF == "Fair AI" & SectorF == "Banking" ~ 0 # Irrelevant for Fair AI in Banking sector
))
# Age importance rating
data$QRANK1_2_AI <- with(data, case_when(
TreatmentF == "Discrim AI" & SectorF == "HR" ~ 2, # Middle importance for Discrim AI in HR sector
TreatmentF == "Fair AI" & SectorF == "HR" ~ 1, # Low importance for Fair AI in HR sector
TreatmentF == "Discrim AI" & SectorF == "Banking" ~ 2, # Middle importance for Discrim AI in Banking sector
TreatmentF == "Fair AI" & SectorF == "Banking" ~ 1 # Low importance for Fair AI in Banking sector
))
# Nationality importance rating
data$QRANK1_3_AI <- with(data, case_when(
TreatmentF == "Discrim AI" & SectorF == "HR" ~ 1, # Low importance for Discrim AI in HR sector
TreatmentF == "Fair AI" & SectorF == "HR" ~ 0, # Irrelevant for Fair AI in HR sector
TreatmentF == "Discrim AI" & SectorF == "Banking" ~ 1, # Low importance for Discrim AI in Banking sector
TreatmentF == "Fair AI" & SectorF == "Banking" ~ 0 # Irrelevant for Fair AI in Banking sector
))
# Education importance rating
data$QRANK1_4_AI <- with(data, case_when(
TreatmentF == "Discrim AI" & SectorF == "HR" ~ 3, # High importance for Discrim AI in HR sector
TreatmentF == "Fair AI" & SectorF == "HR" ~ 3, # High importance for Fair AI in HR sector
TreatmentF == "Discrim AI" & SectorF == "Banking" ~ 2, # Middle importance for Discrim AI in Banking sector
TreatmentF == "Fair AI" & SectorF == "Banking" ~ 1 # Low importance for Fair AI in Banking sector
))
# Income importance rating
data$QRANK1_5_AI <- with(data, case_when(
TreatmentF == "Discrim AI" & SectorF == "HR" ~ 2, # Middle importance for Discrim AI in HR sector
TreatmentF == "Fair AI" & SectorF == "HR" ~ 2, # Middle importance for Fair AI in HR sector
TreatmentF == "Discrim AI" & SectorF == "Banking" ~ 2, # Middle importance for Discrim AI in Banking sector
TreatmentF == "Fair AI" & SectorF == "Banking" ~ 3 # High importance for Fair AI in Banking sector
))
# Interview importance rating
data$QRANK1_6_AI <- with(data, case_when(
TreatmentF == "Discrim AI" & SectorF == "HR" ~ 2, # Middle importance for Discrim AI in HR sector
TreatmentF == "Fair AI" & SectorF == "HR" ~ 1, # Low importance for Fair AI in HR sector
TreatmentF == "Discrim AI" & SectorF == "Banking" ~ 1, # Low importance for Discrim AI in Banking sector
TreatmentF == "Fair AI" & SectorF == "Banking" ~ 1 # Low importance for Fair AI in Banking sector
))
# Preferred type (gender, country, etc.)
# If the importance is NA (i.e., irrelevant), the preference is also set to NA
# Gender preference (1 = Male, 2 = Female)
data$QRank2_Gender_AI <- with(data, case_when(
TreatmentF == "Discrim AI" & SectorF == "HR" ~ 1, # Prefers Male for Discrim AI in HR sector
TreatmentF == "Fair AI" & SectorF == "HR" ~ NA, # No preference (NA) for Fair AI in HR sector
TreatmentF == "Discrim AI" & SectorF == "Banking" ~ 1, # Prefers Male for Discrim AI in Banking sector
TreatmentF == "Fair AI" & SectorF == "Banking" ~ NA # No preference (NA) for Fair AI in Banking sector
))
# Nationality preference (1 = Germany, 2 = Italy)
data$QRank2_Country_AI <- with(data, case_when(
TreatmentF == "Discrim AI" & SectorF == "HR" ~ 1, # Prefers Germany for Discrim AI in HR sector
TreatmentF == "Fair AI" & SectorF == "HR" ~ NA, # No preference (NA) for Fair AI in HR sector
TreatmentF == "Discrim AI" & SectorF == "Banking" ~ 1, # Prefers Germany for Discrim AI in Banking sector
TreatmentF == "Fair AI" & SectorF == "Banking" ~ NA # No preference (NA) for Fair AI in Banking sector
))
# Age preference (1 = 18-34, 2 = 35-54, 3 = 55-65)
data$QRank2_Age_AI <- with(data, case_when(
TreatmentF == "Discrim AI" & SectorF == "HR" ~ 2, # Prefers 35-54 age group for Discrim AI in HR sector
TreatmentF == "Fair AI" & SectorF == "HR" ~ 1, # Prefers 18-34 age group for Fair AI in HR sector
TreatmentF == "Discrim AI" & SectorF == "Banking" ~ 1, # Prefers 18-34 age group for Discrim AI in Banking sector
TreatmentF == "Fair AI" & SectorF == "Banking" ~ 1 # Prefers 18-34 age group for Fair AI in Banking sector
))
# Education preference (1 = Low, 2 = Middle, 3 = High)
data$QRank2_Education_AI <- with(data, case_when(
TreatmentF == "Discrim AI" & SectorF == "HR" ~ 2, # Prefers Middle education for Discrim AI in HR sector
TreatmentF == "Fair AI" & SectorF == "HR" ~ 2, # Prefers Middle education for Fair AI in HR sector
TreatmentF == "Discrim AI" & SectorF == "Banking" ~ 2, # Prefers Middle education for Discrim AI in Banking sector
TreatmentF == "Fair AI" & SectorF == "Banking" ~ 2 # Prefers Middle education for Fair AI in Banking sector
))
# Income preference (1 = Low, 2 = Middle, 3 = High, 4 = Unknown)
data$QRank2_Income_AI <- with(data, case_when(
TreatmentF == "Discrim AI" & SectorF == "HR" ~ 3, # Prefers High income for Discrim AI in HR sector
TreatmentF == "Fair AI" & SectorF == "HR" ~ 3, # Prefers High income for Fair AI in HR sector
TreatmentF == "Discrim AI" & SectorF == "Banking" ~ 3, # Prefers High income for Discrim AI in Banking sector
TreatmentF == "Fair AI" & SectorF == "Banking" ~ 3 # Prefers High income for Fair AI in Banking sector
))
# Interview performance preference (1 = Bad, 2 = OK, 3 = Good, 4 = Very good)
data$QRank2_Interview_AI <- with(data, case_when(
TreatmentF == "Discrim AI" & SectorF == "HR" ~ 4, # Prefers Very good interview performance for Discrim AI in HR sector
TreatmentF == "Fair AI" & SectorF == "HR" ~ 4, # Prefers Very good interview performance for Fair AI in HR sector
TreatmentF == "Discrim AI" & SectorF == "Banking" ~ 3, # Prefers Good interview performance for Discrim AI in Banking sector
TreatmentF == "Fair AI" & SectorF == "Banking" ~ 3 # Prefers Good interview performance for Fair AI in Banking sector
))
# Recode AI preferences to be between 0 and 1
# If the value is NA (i.e., irrelevant), recode as 0; otherwise, transform the scale
# Gender recode
data$QRank2_Gender_AIN <- ifelse(is.na(data$QRank2_Gender_AI), 0, (2 * data$QRank2_Gender_AI - 3))
# Age recode
data$QRank2_Age_AIN <- ifelse(is.na(data$QRank2_Age_AI), 0, (2 * data$QRank2_Age_AI - 3))
# Country recode
data$QRank2_Country_AIN <- ifelse(is.na(data$QRank2_Country_AI), 0, (2 * data$QRank2_Country_AI - 3))
# Education recode
data$QRank2_Education_AIN <- ifelse(is.na(data$QRank2_Education_AI), 0, (2 * data$QRank2_Education_AI - 3))
# Income recode
data$QRank2_Income_AIN <- ifelse(is.na(data$QRank2_Income_AI), 0, ifelse(data$QRank2_Income_AI == 4, 0, data$QRank2_Income_AI - 2))
# Interview performance recode
data$QRank2_Interview_AIN <- ifelse(is.na(data$QRank2_Interview_AI), 0, ((data$QRank2_Interview_AI - 2) / 3))
# Calculate weighted preferences by multiplying importance by preference
data$Preference_Women_AI <- data$QRANK1_1_AI * data$QRank2_Gender_AIN
data$Preference_Old_AI <- data$QRANK1_2_AI * data$QRank2_Age_AIN
data$Preference_Italy_AI <- data$QRANK1_3_AI * data$QRank2_Country_AIN
data$Preference_Educated_AI <- data$QRANK1_4_AI * data$QRank2_Education_AIN
data$Preference_Rich_AI <- data$QRANK1_5_AI * data$QRank2_Income_AIN
data$Preference_Interview_AI <- data$QRANK1_6_AI * data$QRank2_Interview_AIN
# Set AI preference to NA for non-AI treatments
# This ensures only AI treatments are considered in the final preference calculations
data$Preference_Women_AI <- ifelse(data$TreatmentF == "Own", NA, data$Preference_Women_AI)
data$Preference_Old_AI <- ifelse(data$TreatmentF == "Own", NA, data$Preference_Old_AI)
data$Preference_Italy_AI <- ifelse(data$TreatmentF == "Own", NA, data$Preference_Italy_AI)
data$Preference_Educated_AI <- ifelse(data$TreatmentF == "Own", NA, data$Preference_Educated_AI)
data$Preference_Rich_AI <- ifelse(data$TreatmentF == "Own", NA, data$Preference_Rich_AI)
data$Preference_Interview_AI <- ifelse(data$TreatmentF == "Own", NA, data$Preference_Interview_AI)Figure 23 How the AI discriminates
# Summarize AI preferences for group 1 by treatment and sector
# Create a crosstable for AI preferences, grouped by treatment and sector.
# Calculate the mean, standard deviation, and count for each preference category.
# Convert the crosstable to a flextable for presentation.
subset.data.frame(data, Group == 1) %>%
crosstable(
c("Preference_Women_AI", "Preference_Italy_AI", "Preference_Old_AI", "Preference_Educated_AI", "Preference_Rich_AI", "Preference_Interview_AI"), # Columns to summarize
by = c("TreatmentF", "SectorF"), # Group by treatment and sector
funs = c(mean, sd, N), # Calculate mean, standard deviation, and count
margin = "col", # Calculate column margins
total = "row" # Include total for each row
) %>%
as_flextable() # Convert to flextable for easy viewinglabel | variable | SectorF=Banking | SectorF=HR | Total | ||||
|---|---|---|---|---|---|---|---|---|
TreatmentF=Discrim AI | TreatmentF=Fair AI | TreatmentF=Own | TreatmentF=Discrim AI | TreatmentF=Fair AI | TreatmentF=Own | |||
Preference_Women_AI | -3 | 241 (100.00%) | 0 (0%) | 0 (NA%) | 236 (100.00%) | 0 (0%) | 0 (NA%) | 477 (50.16%) |
0 | 0 (0%) | 239 (100.00%) | 0 (NA%) | 0 (0%) | 235 (100.00%) | 0 (NA%) | 474 (49.84%) | |
NA | 0 | 0 | 225 | 0 | 0 | 235 | 460 | |
Preference_Italy_AI | -1 | 241 (100.00%) | 0 (0%) | 0 (NA%) | 236 (100.00%) | 0 (0%) | 0 (NA%) | 477 (50.16%) |
0 | 0 (0%) | 239 (100.00%) | 0 (NA%) | 0 (0%) | 235 (100.00%) | 0 (NA%) | 474 (49.84%) | |
NA | 0 | 0 | 225 | 0 | 0 | 235 | 460 | |
Preference_Old_AI | -2 | 241 (100.00%) | 0 (0%) | 0 (NA%) | 0 (0%) | 0 (0%) | 0 (NA%) | 241 (25.34%) |
-1 | 0 (0%) | 239 (100.00%) | 0 (NA%) | 0 (0%) | 235 (100.00%) | 0 (NA%) | 474 (49.84%) | |
2 | 0 (0%) | 0 (0%) | 0 (NA%) | 236 (100.00%) | 0 (0%) | 0 (NA%) | 236 (24.82%) | |
NA | 0 | 0 | 225 | 0 | 0 | 235 | 460 | |
Preference_Educated_AI | 1 | 0 (0%) | 239 (100.00%) | 0 (NA%) | 0 (0%) | 0 (0%) | 0 (NA%) | 239 (25.13%) |
2 | 241 (100.00%) | 0 (0%) | 0 (NA%) | 0 (0%) | 0 (0%) | 0 (NA%) | 241 (25.34%) | |
3 | 0 (0%) | 0 (0%) | 0 (NA%) | 236 (100.00%) | 235 (100.00%) | 0 (NA%) | 471 (49.53%) | |
NA | 0 | 0 | 225 | 0 | 0 | 235 | 460 | |
Preference_Rich_AI | 2 | 241 (100.00%) | 0 (0%) | 0 (NA%) | 236 (100.00%) | 235 (100.00%) | 0 (NA%) | 712 (74.87%) |
3 | 0 (0%) | 239 (100.00%) | 0 (NA%) | 0 (0%) | 0 (0%) | 0 (NA%) | 239 (25.13%) | |
NA | 0 | 0 | 225 | 0 | 0 | 235 | 460 | |
Preference_Interview_AI | 0.333333333333333 | 241 (100.00%) | 239 (100.00%) | 0 (NA%) | 0 (0%) | 0 (0%) | 0 (NA%) | 480 (50.47%) |
0.666666666666667 | 0 (0%) | 0 (0%) | 0 (NA%) | 0 (0%) | 235 (100.00%) | 0 (NA%) | 235 (24.71%) | |
1.33333333333333 | 0 (0%) | 0 (0%) | 0 (NA%) | 236 (100.00%) | 0 (0%) | 0 (NA%) | 236 (24.82%) | |
NA | 0 | 0 | 225 | 0 | 0 | 235 | 460 | |
# Alternative way to analyze data: summarize grades by various factors
# Create a crosstable for gender grades, grouped by gender, sector, and treatment.
# Calculate mean, standard deviation, and count, and convert to a flextable.
subset.data.frame(data) %>%
crosstable(
c("gender_grade_1"), # Column to summarize
by = c("gender_1F", "SectorF", "TreatmentF"), # Group by gender, sector, and treatment
funs = c(mean, sd, N), # Calculate mean, standard deviation, and count
margin = "row" # Calculate row margins
) %>%
as_flextable() # Convert to flextable for easy viewinglabel | variable | TreatmentF=Discrim AI | TreatmentF=Fair AI | TreatmentF=Own | |||||||||
|---|---|---|---|---|---|---|---|---|---|---|---|---|---|
SectorF=Banking | SectorF=HR | SectorF=Banking | SectorF=HR | SectorF=Banking | SectorF=HR | ||||||||
gender_1F=Female | gender_1F=Male | gender_1F=Female | gender_1F=Male | gender_1F=Female | gender_1F=Male | gender_1F=Female | gender_1F=Male | gender_1F=Female | gender_1F=Male | gender_1F=Female | gender_1F=Male | ||
gender_grade_1 | 1 | 2152 (50.30%) | 0 (0%) | 2126 (49.70%) | 0 (0%) | 0 (0%) | 0 (0%) | 0 (0%) | 0 (0%) | 0 (0%) | 0 (0%) | 0 (0%) | 0 (0%) |
3 | 0 (0%) | 0 (0%) | 0 (0%) | 0 (0%) | 2243 (39.43%) | 625 (10.99%) | 2137 (37.57%) | 683 (12.01%) | 0 (0%) | 0 (0%) | 0 (0%) | 0 (0%) | |
5 | 0 (0%) | 740 (51.18%) | 0 (0%) | 706 (48.82%) | 0 (0%) | 0 (0%) | 0 (0%) | 0 (0%) | 0 (0%) | 0 (0%) | 0 (0%) | 0 (0%) | |
NA | 0 | 0 | 0 | 0 | 0 | 0 | 0 | 0 | 2030 | 670 | 2191 | 629 | |
# Analyze country-specific grades by sector and treatment
# Calculate mean, standard deviation, and count for country grades grouped by country, sector, and treatment.
# Convert the crosstable to a flextable.
subset.data.frame(data) %>%
crosstable(
c("country_grade_1"), # Column to summarize
by = c("country_1F", "SectorF", "TreatmentF"), # Group by country, sector, and treatment
funs = c(mean, sd, N), # Calculate mean, standard deviation, and count
margin = "row" # Calculate row margins
) %>%
as_flextable() # Convert to flextable for easy viewinglabel | variable | TreatmentF=Discrim AI | TreatmentF=Fair AI | TreatmentF=Own | |||||||||
|---|---|---|---|---|---|---|---|---|---|---|---|---|---|
SectorF=Banking | SectorF=HR | SectorF=Banking | SectorF=HR | SectorF=Banking | SectorF=HR | ||||||||
country_1F=Germany | country_1F=Italy | country_1F=Germany | country_1F=Italy | country_1F=Germany | country_1F=Italy | country_1F=Germany | country_1F=Italy | country_1F=Germany | country_1F=Italy | country_1F=Germany | country_1F=Italy | ||
country_grade_1 | 2 | 58 (7.49%) | 438 (56.59%) | 65 (8.40%) | 213 (27.52%) | 0 (0%) | 0 (0%) | 0 (0%) | 0 (0%) | 0 (0%) | 0 (0%) | 0 (0%) | 0 (0%) |
3 | 1273 (13.08%) | 389 (4.00%) | 1685 (17.31%) | 698 (7.17%) | 1770 (18.19%) | 1098 (11.28%) | 1867 (19.18%) | 953 (9.79%) | 0 (0%) | 0 (0%) | 0 (0%) | 0 (0%) | |
4 | 703 (77.68%) | 31 (3.43%) | 171 (18.90%) | 0 (0%) | 0 (0%) | 0 (0%) | 0 (0%) | 0 (0%) | 0 (0%) | 0 (0%) | 0 (0%) | 0 (0%) | |
NA | 0 | 0 | 0 | 0 | 0 | 0 | 0 | 0 | 1880 | 820 | 1919 | 901 | |
# Note on bias: There is evidence of bias against men in both HR and banking sectors.
# Plotting AI preferences using a radar chart
subset.data.frame(data,TreatmentF!="Own") %>% select("Preference_Women_AI","Preference_Italy_AI","Preference_Old_AI","Preference_Educated_AI","Preference_Rich_AI","Preference_Interview_AI","TreatmentF", "SectorF") %>% group_by(TreatmentF,SectorF) %>%
summarise(across(where(is.numeric), ~mean(., na.rm = TRUE), .names = "{.col}"),.groups = "keep") -> df
# Prepare data for radar chart visualization.
# Rename columns by removing "_AI" and "Preference_" prefixes.
for (col in 1:ncol(df)) {
colnames(df)[col] <- sub("_AI", "", colnames(df)[col])
}
for (col in 1:ncol(df)) {
colnames(df)[col] <- sub("Preference_", "", colnames(df)[col])
}
# Set row names for the data frame.
rownames(df) <- with(df, paste(TreatmentF, SectorF, sep = " "))## Warning: Setting row names on a tibble is deprecated.names<-rownames(df)
df2<- rbind(rep(3,6) , rep(-3,6) , df[,-c(1:2)], rep(0,6))
# Define radar chart function for plotting.
cb_radarchart <- function(
data,
color = "#00AFBB",
vlabels = colnames(data),
vlcex = 0.7,
caxislabels = seq(-3, 3, 1),
title = NULL,
...
) {
radarchart(
data,
# Customize the polygon colors and line styles
pcol = c(rgb(0.2, 0.5, 0.5, 0.9), rgb(0.8, 0.2, 0.5, 0.9)),
plwd = 2,
plty = 1,
# Customize the grid
cglcol = "grey",
cglty = 1,
cglwd = 0.8,
# Customize the axis labels
axislabcol = "grey",
# Variable labels
vlcex = vlcex,
vlabels = vlabels,
caxislabels = caxislabels,
title = title,
...
)
}
# Save radar charts to a PNG file.
png(file = "AI_preferences2.png", width = 1200, height = 1050, unit = "px", res = 300)
layout(matrix(c(1, 2, 3, 4), nrow = 2, ncol = 2, byrow = TRUE)) # Set up layout for 2x2 grid of plots
for (i in 1:4) {
par(mar = c(1, 1, 1, 1) + 0.1) # Set margins for plots
cb_radarchart(df2[c(1:2, i + 2, 7),], title = names[i]) # Generate radar chart for each combination
}
dev.off() # Close the PNG device## png
## 2Index of difference between preferences of the AI and of the decider
# An issue is that we get 0 in cases where the characteristic is not important,
# but also in cases where the middle option is preferred, particularly when there are three categories.
# This can create ambiguity in the interpretation of 0 values.
# Calculating the difference between AI preference and decider preference for each attribute
data <- transform(data,
diff_dec_AI_Women = Preference_Women - Preference_Women_AI, # Difference for gender preference
diff_dec_AI_Old = Preference_Old - Preference_Old_AI, # Difference for age preference
diff_dec_AI_Italy = Preference_Italy - Preference_Italy_AI, # Difference for nationality preference
diff_dec_AI_Educated = Preference_Educated - Preference_Educated_AI, # Difference for education preference
diff_dec_AI_Rich = Preference_Rich - Preference_Rich_AI, # Difference for income preference
diff_dec_AI_Interview = Preference_Interview - Preference_Interview_AI # Difference for interview performance preference
)
# To account for discrepancies, we calculate the sum of absolute differences between AI and decider preferences.
# This is done to capture the magnitude of discrepancy without considering the direction (positive or negative).
data <- transform(data,
diff_dec_AI = (abs(diff_dec_AI_Women) + abs(diff_dec_AI_Old) +
abs(diff_dec_AI_Italy) + abs(diff_dec_AI_Educated) +
abs(diff_dec_AI_Rich) + abs(diff_dec_AI_Interview)) / 6
)Index of similarity between applicant and ideal applicants of the decider
# Convert the preferences for gender, age, country, education, income, and interview for the first applicant into numeric scales
# NA values are converted to 0. The transformation is based on the following:
# - Gender and country: values are centered around 0 (1 becomes -1, 2 becomes 1)
# - Age and education: values are centered around 0 (e.g., 1 becomes -1, 2 becomes 0, etc.)
# - Income: special handling for the 'Unknown' category (value 4), which is converted to 0
# - Interview: scale transformed so that "OK" is 0, "Good" and "Very good" are positive, and "Bad" is negative
data$QRank2_Gender_1N <- ifelse(is.na(data$gender_1), 0, (2 * data$gender_1 - 3))
data$QRank2_Age_1N <- ifelse(is.na(data$age_1), 0, (data$age_1 - 2))
data$QRank2_Country_1N <- ifelse(is.na(data$country_1), 0, (2 * data$country_1 - 3))
data$QRank2_Education_1N <- ifelse(is.na(data$education_1), 0, (data$education_1 - 2))
data$QRank2_Income_1N <- ifelse(is.na(data$income_1), 0, ifelse(data$income_1 == 4, 0, data$income_1 - 2))
data$QRank2_Interview_1N <- ifelse(is.na(data$interview_1), 0, (2 * data$interview_1 - 5) / 3)
# Calculate the discrepancy between the 'ideal' attributes (from QRANK1_x) and the first applicant's attributes
# The discrepancy is weighted by the importance of each attribute (QRANK1_x) and summed for each attribute
data <- transform(data,
diff_ideal_applicant_1_gender = QRANK1_1 * abs(QRank2_GenderN - QRank2_Gender_1N),
diff_ideal_applicant_1_age = QRANK1_2 * abs(QRank2_AgeN - QRank2_Age_1N),
diff_ideal_applicant_1_country = QRANK1_3 * abs(QRank2_CountryN - QRank2_Country_1N),
diff_ideal_applicant_1_education = QRANK1_4 * abs(QRank2_EducationN - QRank2_Education_1N),
diff_ideal_applicant_1_income = QRANK1_5 * abs(QRank2_IncomeN - QRank2_Income_1N),
diff_ideal_applicant_1_interview = QRANK1_6 * abs(QRank2_InterviewN - QRank2_Interview_1N)
)
# Calculate the overall discrepancy score for the first applicant by averaging the discrepancies across all attributes
data <- transform(data,
diff_ideal_applicant_1 = (diff_ideal_applicant_1_gender + diff_ideal_applicant_1_age +
diff_ideal_applicant_1_country + diff_ideal_applicant_1_education +
diff_ideal_applicant_1_income) / 6
)
# Repeat the same process for the second applicant
data$QRank2_Gender_2N <- ifelse(is.na(data$gender_2), 0, (2 * data$gender_2 - 3))
data$QRank2_Age_2N <- ifelse(is.na(data$age_2), 0, (data$age_2 - 2))
data$QRank2_Country_2N <- ifelse(is.na(data$country_2), 0, (2 * data$country_2 - 3))
data$QRank2_Education_2N <- ifelse(is.na(data$education_2), 0, (data$education_2 - 2))
data$QRank2_Income_2N <- ifelse(is.na(data$income_2), 0, ifelse(data$income_2 == 4, 0, data$income_2 - 2))
data$QRank2_Interview_2N <- ifelse(is.na(data$interview_2), 0, (2 * data$interview_2 - 5) / 3)
# Calculate the discrepancy between the 'ideal' attributes and the second applicant's attributes
data <- transform(data,
diff_ideal_applicant_2_gender = QRANK1_1 * abs(QRank2_GenderN - QRank2_Gender_2N),
diff_ideal_applicant_2_age = QRANK1_2 * abs(QRank2_AgeN - QRank2_Age_2N),
diff_ideal_applicant_2_country = QRANK1_3 * abs(QRank2_CountryN - QRank2_Country_2N),
diff_ideal_applicant_2_education = QRANK1_4 * abs(QRank2_EducationN - QRank2_Education_2N),
diff_ideal_applicant_2_income = QRANK1_5 * abs(QRank2_IncomeN - QRank2_Income_2N),
diff_ideal_applicant_2_interview = QRANK1_6 * abs(QRank2_InterviewN - QRank2_Interview_2N)
)
# Calculate the overall discrepancy score for the second applicant by averaging the discrepancies across all attributes
data <- transform(data,
diff_ideal_applicant_2 = (diff_ideal_applicant_2_gender + diff_ideal_applicant_2_age +
diff_ideal_applicant_2_country + diff_ideal_applicant_2_education +
diff_ideal_applicant_2_income) / 6
)
# Calculate the difference in overall discrepancy between the first and second applicant
# This gives the difference in how closely each applicant aligns with the 'ideal' preferences
data <- transform(data,
diff_diff_ideal_applicant = diff_ideal_applicant_1 - diff_ideal_applicant_2,
diff_diff_ideal_applicant_gender = diff_ideal_applicant_1_gender - diff_ideal_applicant_2_gender,
diff_diff_ideal_applicant_age = diff_ideal_applicant_1_age - diff_ideal_applicant_2_age,
diff_diff_ideal_applicant_country = diff_ideal_applicant_1_country - diff_ideal_applicant_2_country,
diff_diff_ideal_applicant_education = diff_ideal_applicant_1_education - diff_ideal_applicant_2_education,
diff_diff_ideal_applicant_income = diff_ideal_applicant_1_income - diff_ideal_applicant_2_income,
diff_diff_ideal_applicant_interview = diff_ideal_applicant_1_interview - diff_ideal_applicant_2_interview
)……………..
Opening cleaned data and labeling variables
……………..
data<- readRDS("cleaned_data.Rds")
# Apply labels to variables related to the recommendation and choice
# 'overall_grade_diffF' indicates the recommendation for or against candidate 1
# 'choice_1' represents whether candidate 1 was chosen
data <- apply_labels(data,
overall_grade_diffF = "Recommendation against or for candidate 1",
choice_1 = "Choice of candidate 1"
)
# Apply labels to variables that represent the importance of different candidate attributes
# QRANK1_1 through QRANK1_6 capture the importance assigned to gender, age, nationality, education, income, and interview, respectively
data <- apply_labels(data,
QRANK1_1 = "Gender Importance",
QRANK1_2 = "Age Importance",
QRANK1_3 = "Nationality Importance",
QRANK1_4 = "Education Importance",
QRANK1_5 = "Income Importance",
QRANK1_6 = "Interview Importance"
)
# Apply labels to variables that represent different decision-making values
# Q3 to Q5 cover the importance of fairness, instinct, and making correct decisions
# 'Q6': Overall confidence in the decision
# - This question asked how confident the decider was in their choice, with options ranging from very confident (1) to not confident at all (4).
# - 'Q6' is recoded so that higher values in the new variable 'Confidence' represent greater confidence.
# - A special case is handled: if 'Q6' is 99 (representing "I don't know"), it is recoded as NA.
data$Confidence <- ifelse(data$Q6 == 99, NA, 5 - data$Q6)
data <- apply_labels(data,
Q3 = "Importance of fairness",
Q4 = "Importance of instinct",
Q5 = "Importance of correct decisions",
Confidence = "Confidence in choice"
)
# Apply labels to variables related to perceived honesty, hard work, reliability, and performance based on gender and nationality
# Q7_1 to Q7_4 capture these perceptions related to gender
# Q8_1 to Q8_4 capture these perceptions related to nationality
data <- apply_labels(data,
Q7_1 = "Honesty - Gender",
Q7_2 = "Hard work - Gender",
Q7_3 = "Reliability - Gender",
Q7_4 = "Performance - Gender",
Q8_1 = "Honesty - Nationality",
Q8_2 = "Hard work - Nationality",
Q8_3 = "Reliability - Nationality",
Q8_4 = "Performance - Nationality"
)
# Apply labels to variables that indicate whether gender or country discrimination is considered acceptable
# Q9 covers views on gender discrimination, and Q10 covers views on country discrimination
data <- apply_labels(data,
Q9 = "Gender Discr OK",
Q10 = "Country Discr OK"
)
# Apply labels to variables related to perceptions of AI in decision-making
# 'AIRelied': Measures how much the decider relied on AI (original scale reversed).
data$AIRelied <- 5 - data$Q11
# 'AIUnderstood': Measures how well the decider felt they understood AI recommendations (original scale reversed).
data$AIUnderstood <- 5 - data$Q12
# 'AIFair': Measures the decider's perception of AI fairness (original scale reversed).
data$AIFair <- 5 - data$Q13
# 'AIAccurate': Measures the decider's perception of AI accuracy (original scale reversed).
data$AIAccurate <- 5 - data$Q14
data <- apply_labels(data,
AIRelied = "I relied on AI",
AIUnderstood = "I understood AI",
AIFair = "AI was fair",
AIAccurate = "AI was accurate"
)
# Apply labels to variables that capture various characteristics of the work environment, such as experience, level, and diversity
# Q15F to Q23F apply to the current work environment
data <- apply_labels(data,
Q15F = "Work experience",
Q16F = "Hierarchical level",
Q17F = "Company size",
Q18F = "Data experience",
Q19F = "DSS experience",
Q21F = "Diversity",
Q22F = "Diversity policy",
Q23F = "Implementation policy"
)
# Apply labels to the same variables but in numeric form
data <- apply_labels(data,
Q15N = "Work experience",
Q16N = "Hierarchical level",
Q17N = "Company size",
Q18RN = "Data experience",
Q19RN = "DSS experience",
Q21RN = "Diversity",
Q22RN = "Diversity policy",
Q23RN = "Implementation policy"
)
# Apply labels to the same variable in original form
data <- apply_labels(data,
Q15 = "Work experience",
Q16 = "Hierarchical level",
Q17 = "Company size",
Q18 = "Data experience",
Q19 = "DSS experience",
Q21 = "Diversity",
Q22 = "Diversity policy",
Q23 = "Implementation policy"
)
# Apply labels to variables that capture prejudices against specific groups
# 'Prejudice_vs_Women' captures prejudice against women, and 'Prejudice_vs_Italy' captures prejudice against Italians
data <- apply_labels(data,
Prejudice_vs_Women = "Prejudice vs. Women",
Prejudice_vs_Italy = "Prejudice vs. Italians"
)……………..
Descriptive statistics
……………..
Table 2: Sample distribution
# Summarize treatment frequencies by country and sector
# Filter the data for Group == 1 to have one datapoint per person
subset.data.frame(data, Group == 1) %>%
# Create a crosstable to count the number of occurrences for each treatment
# Group by CountryF and SectorF
crosstable(
c(TreatmentF), # Column to summarize
by = c("CountryF", "SectorF"), # Group by country and sector
funs = c(N), # Calculate count (N) for each group
total = "both", # Include totals for both columns and rows
margin = "none" # No margin calculations
) %>%
# Convert the crosstable to a flextable for better presentation
as_flextable() %>%
# Save the flextable to a Word document
save_as_docx(path = "sample.docx")Table 8: Socio-demographics
# Summarize sociodemographic data by country and sector
# Filter the data for Group == 1 to have one datapoint per person
subset.data.frame(data, Group == 1) %>%
# Create a crosstable with summary statistics for sociodemographic variables
# Group by CountryF and SectorF
crosstable(
c(gender_decF, age_decF, education_decF, income_decF), # Variables to summarize
by = c("CountryF", "SectorF"), # Group by country and sector
funs = c(mean, sd, N), # Calculate mean, standard deviation, and count (N) for each group
margin = "col", # Calculate statistics across columns
percent_digits = 0, # Format percentage with 0 decimal places
cor_method = "pearson" # Compute Pearson correlation for the variables
) %>%
# Convert the crosstable to a flextable for better presentation
as_flextable() %>%
# Save the flextable to a Word document
save_as_docx(path = "sociodemo.docx")Tables 9-10: Work environment and experience
# Summarize work experience data by country and sector
# Filter the data for Group == 1 to have one datapoint per person
subset.data.frame(data, Group == 1) %>%
# Create a crosstable with summary statistics for work experience variables
# Group by CountryF and SectorF
crosstable(
c(Q15F, Q16F, Q17F, Q18F, Q19F), # Variables to summarize (work experience-related)
by = c("CountryF", "SectorF"), # Group by country and sector
funs = c(mean, sd, N), # Calculate mean, standard deviation, and count (N) for each group
margin = "col", # Calculate statistics across columns
percent_digits = 0, # Format percentages with 0 decimal places
cor_method = "pearson" # Compute Pearson correlation for the variables
) %>%
# Convert the crosstable to a flextable for better presentation
as_flextable() %>%
# Autofit the columns to the content of the table
autofit() %>%
# Set table properties to adjust width and layout
set_table_properties(width = 1, layout = "autofit") %>%
# Further adjust the autofit properties for additional width and height adjustments
autofit(add_w = 0, add_h = 0) %>%
# Save the formatted flextable to a Word document
save_as_docx(path = "work_experience.docx")Table 11: Diversity policies
# Subset the data for Group 1 and perform cross-tabulations
subset.data.frame(data, Group == 1) %>%
crosstable(c(Q21F, Q22F, Q23F), # Variables to be cross-tabulated
by = c("CountryF", "SectorF"), # Grouping variables
funs = c(mean, sd, N), # Functions to calculate: mean, standard deviation, and count
margin = "col", # Margins to include in the table
percent_digits = 0, # Number of decimal places for percentages
cor_method = "pearson") %>% # Correlation method used for Pearson
as_flextable() %>% # Convert to a flextable object for Word formatting
autofit() %>% # Auto-fit column widths
set_table_properties(width = 1, layout = "autofit") %>% # Set table properties for autofit
autofit(add_w = 0, add_h = 0) %>% # Additional adjustments for autofit
save_as_docx(path = "diversity_policy.docx") # Save the formatted table to a Word documentLooking at written feedback
Q1: What do you think this survey was about
##
## Attaching package: 'officer'## The following object is masked from 'package:readxl':
##
## read_xlsx# Function to create and save a document based on a subset of data
create_document <- function(subset_data, filename) {
# Combine all text into a single string with paragraph breaks
combined_text <- paste(subset_data$Q1, collapse = "\n")
# Create a new Word document
doc <- read_docx()
# Add the combined text as a single paragraph
doc <- body_add_par(doc, value = combined_text, style = "Normal")
# Save the document
print(doc, target = filename)
}
# Generate documents for each combination of var1 and var2
for (country in c("Italy","Germany")) {
for (sector in c("HR","Banking")) {
# Filter data based on the current combination of var1 and var2
subset_data <- subset(data, CountryF == country & SectorF == sector)
# Define a filename based on the combination
filename <- paste0("text_summary_Q1_var1_", country, "_var2_", sector, ".docx")
# Create and save the document for this subset
create_document(subset_data, filename)
}
}
# Analysis by chatGPT about the answers, by country and sector ("This document reports answers to the question "What do you think this survey was about?". Please summarize the answers.")
# Germany/Banking
# The document contains various responses that primarily suggest the survey was about assessing creditworthiness and understanding the criteria used by banks or credit analysts when granting loans. The responses mention factors like age, gender, income, education level, and nationality as key determinants in loan approval processes. Additionally, some answers point to the survey exploring banking procedures, customer satisfaction in loan applications, and the role of personal and demographic information in financial decision - making.
# In summary:The survey was perceived to focus on understanding how banks decide to grant loans based on factors like age, gender, education, and income. It involved evaluating the qualifications of potential borrowers and assessing the risks associated with lending. Some respondents also saw it as a study on improving banking services, credit products, and ensuring fair lending practices.
# Germany/HR
# The responses in the document indicate that participants believe the survey focused on various aspects of the hiring process within organizations.
# Key themes include:
# 1. **Hiring Practices and Decision - Making ** :Many responses suggest the survey was about understanding hiring criteria, such as qualifications, skills, experience, and personal attributes (e.g., age, gender, nationality). It also aimed to identify biases and preferences in recruitment decisions.
# 2. ** Diversity and Equity ** :Several participants mentioned that the survey addressed issues related to equal opportunities in the job market, particularly concerning discrimination based on nationality, education level, and other personal characteristics.
# 3. ** HR Tools and Systems ** :There was a significant focus on the role of HR software and tools (e.g., EUS) in the hiring process, including how these tools help assess candidates and streamline recruitment.
# 4. ** Employee Evaluation and Selection ** :The survey was perceived to assess various methods and criteria used by HR departments to evaluate and select candidates, including interviews, assessments, and matching candidates with company culture.
# 5. ** Improving Hiring Processes ** :Some participants believed the survey aimed to gather feedback on current hiring practices to identify areas for improvement, particularly in promoting diversity and refining selection strategies.
# Overall, the survey seemed to explore the intricacies of recruitment, from evaluating candidate qualifications to addressing biases and using HR technology to enhance the hiring process.
#Italy/Banking
# The survey mentioned in the document appears to be related to the decision-making process in the banking sector, specifically concerning the granting of loans. Respondents provided various interpretations and purposes of the survey, including:
# 1. Understanding the criteria used by banking decision-makers to evaluate potential clients' socio-demographic and income characteristics before granting loans.
# 2. Assessing the impact of different factors on individuals' choices and their reliability in the context of loan approval.
# 3. Evaluating the creditworthiness of loan applicants based on personal interviews, education levels, and other selection criteria.
# 4. Investigating the recruitment methods within financial organizations and the qualifications required for employment.
# 5. Analyzing the financial situation and debt burden of private individuals and families.
# 6. Examining the quality of credit institutions to determine whether to grant a loan.
# 7. Collecting data on retail banking services and the competencies and qualifications of employees.
# 8. Understanding the differences in financial knowledge and borrowing behavior among credit institutions with different education levels.
# 9. Identifying potential problems or areas needing improvement in legal compliance before providing a loan to a customer.
# 10. Exploring the use of loan conditions to choose a scientific evaluation method.
# 11. Investigating the implementation of policies and regulations in the banking and private lending sector and the evaluation criteria of financiers.
# 12. Understanding the preferences of lending personnel when searching for borrowers, which can clearly indicate their preferences in this regard.
# 13. Assessing the risk of credit for borrowers using a questionnaire that provides information about their personal, occupational, and financial situation.
# 14. Monitoring economic loans based on precise information.
# 15. Understanding the sensitivity of financiers to interest rates and loan conditions for different qualifications to develop targeted pricing strategies and reduction measures.
#
# Overall, the survey seems to focus on the lending process, risk management, recruitment in the financial sector, and the factors influencing loan approval decisions
#Italy/HR
# The survey responses suggest that participants believe the survey was about various aspects of human resources and recruitment practices. Respondents mentioned that the survey could be useful for understanding the criteria used to select employees, evaluating the adaptability and potential of candidates, and investigating cognitive biases in hiring. Some thought it was about understanding the preferences of Italian workers or the importance of certain characteristics in hiring decisions. Others mentioned the use of DSS (Decision Support Systems) in recruitment to improve efficiency, reduce subjective judgments, and provide better decision-making support. The survey also seemed to address issues such as discrimination, the impact of nationality and gender on hiring, and the evaluation of candidates' skills and cultural fit. Additionally, some responses indicated uncertainty about the survey's purpose, with some respondents expressing a desire for more informationQ2: Please explain how you could have made better decisions, and what prevented you from doing so.
create_document2 <- function(subset_data, filename) {
# Combine all text into a single string with paragraph breaks
combined_text <- paste(subset_data$Q2, collapse = "\n")
# Create a new Word document
doc <- read_docx()
# Add the combined text as a single paragraph
doc <- body_add_par(doc, value = combined_text, style = "Normal")
# Save the document
print(doc, target = filename)
}
# Generate documents for each combination of var1 and var2
for (country in c("Italy","Germany")) {
for (sector in c("HR","Banking")) {
# Filter data based on the current combination of var1 and var2
subset_data <- subset(data, CountryF == country & SectorF == sector)
# Define a filename based on the combination
filename <- paste0("text_summary_Q2_var1_", country, "_var2_", sector, ".docx")
# Create and save the document for this subset
create_document2(subset_data, filename)
}
}
# Analysis by chatGPT about the answers, by country and sector ("This document reports answers to the question "Please explain how you could have made better decisions, and what prevented you from doing so" Please summarize the answers.")
# Germany/Banking
# The document contains reflections on decision-making processes, particularly in the context of banking and credit assessments. Respondents highlighted several factors that could have led to better decisions:
#
# Information Gathering: Respondents emphasized the importance of collecting comprehensive and accurate data, including creditworthiness, financial reports, employment history, and outstanding debts, to make informed decisions. Incomplete or inaccurate information often hindered the decision-making process.
#
# Avoiding Bias: There was a recognition of the need to avoid personal biases and prejudices, such as those based on gender, age, or education level. Some respondents wished they could have made decisions without considering these factors, as they do not necessarily determine a person's wealth or future earnings.
#
# Systematic Approach: Utilizing algorithms and established protocols was seen as a way to make more objective decisions and avoid personal or emotional biases. A systematic approach, including adherence to internal credit policies and procedures, could lead to more consistent and fair decisions.
#
# Collaboration and Teamwork: The lack of collaboration with other departments or team members was mentioned as a factor that could impair the quality of decisions. Good teamwork and diverse perspectives were seen as beneficial for decision-making.
#
# Time Pressure: Some respondents noted that being under time pressure to make decisions could prevent them from gathering complete information, which could lead to suboptimal outcomes.
#
# Cognitive Resources: The exhaustion of cognitive resources due to the need to make numerous decisions was mentioned as a factor that could weaken decision-making capabilities.
#
# External Influences: Pressure from superiors, peers, or clients, as well as economic downturns, could influence decisions and potentially lead to less favorable outcomes.
#
# Risk Management: Conducting credit assessments and risk management, setting credit limits, and considering interest rates were mentioned as part of a thorough decision-making process. However, challenges such as legal reasons or complex financial situations could complicate these assessments.
#
# Personal Conditions: Decisions were sometimes based on the personal conditions of the clients, which could be subjective and vary from case to case.
#
# Overall, the respondents indicated that better decisions could have been made by following a more structured, unbiased, and information-rich approach, but various obstacles, including incomplete information, biases, time constraints, and external pressures, often prevented this ideal process.
# Germany/HR
# The document outlines several factors that could have led to better decision-making, as well as obstacles that hindered the process. The key points for improved decisions include:
# 1. Taking more time to fully evaluate situations and potential consequences.
# 2. Engaging with external referral sources like professional networks and career websites for additional talent pools.
# 3. Including candidate competency assessments, reference checks, or personality tests in the decision-making process.
# 4. Considering the candidate's experience throughout the hiring process.
# 5. Seeking advice from colleagues, stakeholders, or experts to gain different perspectives and eliminate biases [1].
# 6. Conducting more research before making decisions to ensure alignment with desired goals.
# 7. Using technology and artificial intelligence to obtain better data and information.
# 8. Ensuring that decisions are fair and unbiased, and align with diversity and inclusion goals.
#
# The obstacles that prevented better decision-making include:
#
# 1. Uncertainty and changes in the external economic environment, and lack of performance evaluation and feedback mechanisms.
# 2. Lack of clear decision-making processes and assignment of responsibilities, as well as insufficient collaboration and coordination with other departments, leading to unstable decision-making in HR.
# 3. Constraints on decision-making, such as organizational spending limits for the HR department, which restrict access to resources like technology and AI.
# 4. Personal biases, subjective judgments, and political considerations that can lead to unfair or irrational decisions.
# 5. Overwhelming mobility and employee turnover, lack of transparency and communication, which can lead to hasty decisions.
# 6. The individual's own experience and reasoning, which may hold them back from making different choices.
#
# These points suggest that while there are clear strategies for improving decision-making, there are also significant structural and personal challenges that need to be addressed to enable better outcomes.
# Italy/Banking
# The document contains multiple responses to the question "Please explain how you could have made better decisions, and what prevented you from doing so." Here's a summary of the key points from these responses:
#
# Awareness and Information: Many respondents acknowledged that better decisions could have been made with more information or a deeper understanding of the context. A lack of awareness or limited access to necessary data often hindered optimal decision-making.
#
# External Influences: Several respondents mentioned that external factors, such as economic conditions, social pressures, or organizational policies, played a significant role in shaping their decisions. These influences sometimes led to choices that were not entirely within their control.
#
# Bias and Assumptions: Some individuals recognized that personal biases or preconceived notions impacted their decisions. These biases might have been conscious or unconscious, affecting the fairness and accuracy of their judgments.
#
# Risk Management: The responses highlighted that an improved approach to assessing and managing risks could have led to better decisions. A more thorough risk evaluation process was often suggested as a way to enhance decision quality.
#
# Time Constraints: A common theme was the limitation imposed by time. Many respondents felt that more time for reflection and analysis would have allowed them to make more informed and deliberate decisions.
#
# Communication and Collaboration: Some noted that better communication and collaboration with colleagues or stakeholders could have contributed to more effective decision-making. A lack of input from others sometimes led to incomplete or suboptimal decisions.
#
# Learning and Adaptation: There was an acknowledgment that past mistakes were valuable learning experiences. Respondents expressed that hindsight provided insights that could improve future decision-making processes.
#
# Technological Tools: A few responses mentioned that access to better technological tools or data analytics could have supported more accurate and efficient decisions.
#
# Overall, the responses suggest that while various internal and external factors impacted decision-making, there was a strong desire to improve by learning from past experiences and enhancing processes, tools, and collaboration.
# Italy/HR
# The responses to the question "Please explain how you could have made better decisions, and what prevented you from doing so" highlight several key themes:
#
# 1. **Lack of Information**: Many respondents mentioned that insufficient information about candidates, such as their backgrounds, education, and specific skills, hindered their ability to make optimal decisions. They expressed that having more detailed candidate profiles would have improved decision-making.
#
# 2. **Importance of In-Person Interviews**: Several respondents noted that conducting in-person interviews would have allowed for a better assessment of candidates' personalities and abilities, leading to more accurate decisions. The absence of in-person interactions was seen as a limitation.
#
# 3. **Balancing Different Factors**: Respondents often struggled with balancing various candidate qualities, such as technical skills versus soft skills, or good interview performance versus strong educational background. Some felt that they had to make compromises, which impacted the quality of their decisions.
#
# 4. **Time Constraints**: Limited time for interviews and assessments was frequently mentioned as a barrier to making better decisions. Respondents felt that with more time, they could have conducted deeper evaluations.
#
# 5. **Bias and Subjectivity**: Some respondents acknowledged that unconscious biases or reliance on personal judgment might have affected their decisions. They suggested that a more systematic approach could have reduced bias.
#
# 6. **Need for Better Tools and Processes**: There was a consensus on the need for more efficient and creative methods for candidate assessment. Some suggested the use of data-driven decision-making tools to improve the accuracy of their choices.
#
# 7. **Organizational Fit**: Assessing whether candidates aligned with the company's culture and values was identified as crucial. However, respondents noted that this was challenging without more comprehensive evaluations.
#
# 8. **Continuous Learning**: A recurring theme was the importance of learning from past experiences to enhance future decision-making. Respondents emphasized the need for ongoing professional development and knowledge accumulation in the recruitment process.
#
# Overall, the responses reflect a desire for more thorough, informed, and unbiased decision-making processes, with a particular emphasis on the value of in-person interactions and comprehensive candidate assessments.Table 12: Way choices made
# Way made choice
subset.data.frame(data, Group == 1) %>%
crosstable(c("Q3", "Q4", "Q5", "Confidence"), # Variables to cross-tabulate
by = c("CountryF", "SectorF"), # Grouping variables
funs = c(meansd, N), # Summary statistics: mean, standard deviation, count
margin = "col") %>% # Margin to include in the table
as_flextable() %>% # Convert to flextable format for Word
save_as_docx(path = "choices_made.docx") # Save the table to a Word documentTable 13: Reliance on AI
# Reliance on AI
# AIRelied is relying, AIUnderstood is understanding, AIFair is fairness of AI, AIAccurate is accuracy of AI
# 4 Yes, to a large extent 3 Yes, somewhat 2 No, not really 1 No, not at all
subset.data.frame(data,Group==1) %>%
crosstable(c("AIRelied","AIUnderstood","AIFair","AIAccurate"), by=c("CountryF", "SectorF"), funs=c(meansd,N), margin="col", cor_method = "pearson") %>%
as_flextable() %>% save_as_docx( path = "RelianceAI.docx")Figure 10: Discriminatory preferences of deciders by sector
# Important characteristics of applicant (from 0 to 3, not important to very important)
subset.data.frame(data,Group==1) %>%
crosstable(c("QRANK1_1","QRANK1_2","QRANK1_3","QRANK1_4","QRANK1_5","QRANK1_6","QRank2_GenderF","QRank2_AgeF","QRank2_CountryF","QRank2_EducationF","QRank2_IncomeF","QRank2_InterviewF" ), by=c(), funs=c(mean,sd,N), margin="col", total = "none") %>%
as_flextable()label | variable | value |
|---|---|---|
Gender Importance | mean | 1.7 |
sd | 1.0 | |
N | 1411 | |
Age Importance | mean | 2.0 |
sd | 0.8 | |
N | 1411 | |
Nationality Importance | mean | 2.0 |
sd | 1.0 | |
N | 1411 | |
Education Importance | mean | 2.4 |
sd | 0.8 | |
N | 1411 | |
Income Importance | mean | 2.3 |
sd | 0.9 | |
N | 1411 | |
Interview Importance | mean | 2.4 |
sd | 0.7 | |
N | 1411 | |
QRank2_GenderF | Male | 601 (51.28%) |
Female | 571 (48.72%) | |
NA | 239 | |
QRank2_AgeF | 18-34 | 482 (36.21%) |
35-54 | 834 (62.66%) | |
55-65 | 15 (1.13%) | |
NA | 80 | |
QRank2_CountryF | Germany | 764 (60.06%) |
Italy | 508 (39.94%) | |
NA | 139 | |
QRank2_EducationF | Low | 23 (1.69%) |
Middle | 482 (35.36%) | |
High | 858 (62.95%) | |
NA | 48 | |
QRank2_IncomeF | Low | 27 (2.00%) |
Middle | 513 (38.06%) | |
High | 771 (57.20%) | |
Unknown | 37 (2.74%) | |
NA | 63 | |
QRank2_InterviewF | Bad | 17 (1.23%) |
OK | 387 (28.08%) | |
Good | 511 (37.08%) | |
Very good | 463 (33.60%) | |
NA | 33 |
subset.data.frame(data,Group==1) %>%
crosstable(c("QRANK1_1","QRANK1_2","QRANK1_3","QRANK1_4","QRANK1_5","QRANK1_6","QRank2_GenderF","QRank2_AgeF","QRank2_CountryF","QRank2_EducationF","QRank2_IncomeF","QRank2_InterviewF"), by=c("SectorF"), funs=c(mean,sd,N), margin="col", total = "row", cor_method = "pearson", test = TRUE) %>%
as_flextable()## Warning in crosstable(., c("QRANK1_1", "QRANK1_2", "QRANK1_3", "QRANK1_4", : Be aware that automatic global testing should only be done in an exploratory
## context, as it would cause extensive alpha inflation otherwise.
## This warning is displayed once every 8 hours.label | variable | SectorF | Total | test | |
|---|---|---|---|---|---|
HR | Banking | ||||
Gender Importance | mean | 1.6 | 1.7 | 1.7 | p value: 0.0368 |
sd | 1.0 | 1.0 | 1.0 | ||
N | 706 | 705 | 1411 | ||
Age Importance | mean | 2.0 | 2.1 | 2.0 | p value: 0.0081 |
sd | 0.8 | 0.9 | 0.8 | ||
N | 706 | 705 | 1411 | ||
Nationality Importance | mean | 1.9 | 2.0 | 2.0 | p value: 0.0795 |
sd | 1.0 | 0.9 | 1.0 | ||
N | 706 | 705 | 1411 | ||
Education Importance | mean | 2.6 | 2.3 | 2.4 | p value: <0.0001 |
sd | 0.6 | 0.9 | 0.8 | ||
N | 706 | 705 | 1411 | ||
Income Importance | mean | 2.1 | 2.4 | 2.3 | p value: <0.0001 |
sd | 0.9 | 0.8 | 0.9 | ||
N | 706 | 705 | 1411 | ||
Interview Importance | mean | 2.6 | 2.3 | 2.4 | p value: <0.0001 |
sd | 0.6 | 0.8 | 0.7 | ||
N | 706 | 705 | 1411 | ||
QRank2_GenderF | Male | 318 (55.59%) | 283 (47.17%) | 601 (51.28%) | p value: 0.0039 |
Female | 254 (44.41%) | 317 (52.83%) | 571 (48.72%) | ||
NA | 134 | 105 | 239 | ||
QRank2_AgeF | 18-34 | 317 (47.10%) | 165 (25.08%) | 482 (36.21%) | p value: <0.0001 |
35-54 | 355 (52.75%) | 479 (72.80%) | 834 (62.66%) | ||
55-65 | 1 (0.15%) | 14 (2.13%) | 15 (1.13%) | ||
NA | 33 | 47 | 80 | ||
QRank2_CountryF | Germany | 359 (58.37%) | 405 (61.64%) | 764 (60.06%) | p value: 0.2341 |
Italy | 256 (41.63%) | 252 (38.36%) | 508 (39.94%) | ||
NA | 91 | 48 | 139 | ||
QRank2_EducationF | Low | 5 (0.71%) | 18 (2.72%) | 23 (1.69%) | p value: 0.0150 |
Middle | 248 (35.33%) | 234 (35.40%) | 482 (35.36%) | ||
High | 449 (63.96%) | 409 (61.88%) | 858 (62.95%) | ||
NA | 4 | 44 | 48 | ||
QRank2_IncomeF | Low | 10 (1.52%) | 17 (2.46%) | 27 (2.00%) | p value: <0.0001 |
Middle | 294 (44.82%) | 219 (31.65%) | 513 (38.06%) | ||
High | 326 (49.70%) | 445 (64.31%) | 771 (57.20%) | ||
Unknown | 26 (3.96%) | 11 (1.59%) | 37 (2.74%) | ||
NA | 50 | 13 | 63 | ||
QRank2_InterviewF | Bad | 2 (0.28%) | 15 (2.23%) | 17 (1.23%) | p value: <0.0001 |
OK | 175 (24.82%) | 212 (31.50%) | 387 (28.08%) | ||
Good | 263 (37.30%) | 248 (36.85%) | 511 (37.08%) | ||
Very good | 265 (37.59%) | 198 (29.42%) | 463 (33.60%) | ||
NA | 1 | 32 | 33 | ||
subset.data.frame(data,Group==1) %>%
crosstable(c("QRANK1_1","QRANK1_2","QRANK1_3","QRANK1_4","QRANK1_5","QRANK1_6","QRank2_GenderF","QRank2_AgeF","QRank2_CountryF","QRank2_EducationF","QRank2_IncomeF","QRank2_InterviewF"), by=c("country_dec"), funs=c(mean,sd,N), margin="col", total = "row", cor_method = "pearson", test = TRUE) %>%
as_flextable()label | variable | Country | Total | test | |
|---|---|---|---|---|---|
1 | 2 | ||||
Gender Importance | mean | 1.8 | 1.5 | 1.7 | p value: <0.0001 |
sd | 0.9 | 1.1 | 1.0 | ||
N | 708 | 703 | 1411 | ||
Age Importance | mean | 2.1 | 2.0 | 2.0 | p value: 0.2840 |
sd | 0.8 | 0.9 | 0.8 | ||
N | 708 | 703 | 1411 | ||
Nationality Importance | mean | 2.1 | 1.8 | 2.0 | p value: <0.0001 |
sd | 0.9 | 1.0 | 1.0 | ||
N | 708 | 703 | 1411 | ||
Education Importance | mean | 2.5 | 2.4 | 2.4 | p value: 0.0047 |
sd | 0.7 | 0.8 | 0.8 | ||
N | 708 | 703 | 1411 | ||
Income Importance | mean | 2.4 | 2.1 | 2.3 | p value: <0.0001 |
sd | 0.8 | 0.9 | 0.9 | ||
N | 708 | 703 | 1411 | ||
Interview Importance | mean | 2.5 | 2.3 | 2.4 | p value: 0.0020 |
sd | 0.6 | 0.8 | 0.7 | ||
N | 708 | 703 | 1411 | ||
QRank2_GenderF | Male | 379 (59.22%) | 222 (41.73%) | 601 (51.28%) | p value: <0.0001 |
Female | 261 (40.78%) | 310 (58.27%) | 571 (48.72%) | ||
NA | 68 | 171 | 239 | ||
QRank2_AgeF | 18-34 | 269 (39.27%) | 213 (32.97%) | 482 (36.21%) | p value: 0.0222 |
35-54 | 406 (59.27%) | 428 (66.25%) | 834 (62.66%) | ||
55-65 | 10 (1.46%) | 5 (0.77%) | 15 (1.13%) | ||
NA | 23 | 57 | 80 | ||
QRank2_CountryF | Germany | 657 (98.50%) | 107 (17.69%) | 764 (60.06%) | p value: <0.0001 |
Italy | 10 (1.50%) | 498 (82.31%) | 508 (39.94%) | ||
NA | 41 | 98 | 139 | ||
QRank2_EducationF | Low | 18 (2.58%) | 5 (0.75%) | 23 (1.69%) | p value: <0.0001 |
Middle | 279 (39.97%) | 203 (30.53%) | 482 (35.36%) | ||
High | 401 (57.45%) | 457 (68.72%) | 858 (62.95%) | ||
NA | 10 | 38 | 48 | ||
QRank2_IncomeF | Low | 13 (1.87%) | 14 (2.15%) | 27 (2.00%) | p value: 0.8218 |
Middle | 259 (37.21%) | 254 (38.96%) | 513 (38.06%) | ||
High | 403 (57.90%) | 368 (56.44%) | 771 (57.20%) | ||
Unknown | 21 (3.02%) | 16 (2.45%) | 37 (2.74%) | ||
NA | 12 | 51 | 63 | ||
QRank2_InterviewF | Bad | 8 (1.14%) | 9 (1.34%) | 17 (1.23%) | p value: 0.6864 |
OK | 206 (29.26%) | 181 (26.85%) | 387 (28.08%) | ||
Good | 252 (35.80%) | 259 (38.43%) | 511 (37.08%) | ||
Very good | 238 (33.81%) | 225 (33.38%) | 463 (33.60%) | ||
NA | 4 | 29 | 33 | ||
subset.data.frame(data,Group==1) %>%
crosstable(c("QRANK1_1","QRANK1_2","QRANK1_3","QRANK1_4","QRANK1_5","QRANK1_6","QRank2_GenderF","QRank2_AgeF","QRank2_CountryF","QRank2_EducationF","QRank2_IncomeF","QRank2_InterviewF"), by=c("gender_dec"), funs=c(mean,sd,N), margin="col", total = "row", cor_method = "pearson", test = TRUE) %>%
as_flextable()label | variable | Are you…? | Total | test | |
|---|---|---|---|---|---|
1 | 2 | ||||
Gender Importance | mean | 1.6 | 1.7 | 1.7 | p value: 0.1793 |
sd | 1.0 | 1.0 | 1.0 | ||
N | 698 | 713 | 1411 | ||
Age Importance | mean | 2.1 | 2.0 | 2.0 | p value: 0.0111 |
sd | 0.8 | 0.9 | 0.8 | ||
N | 698 | 713 | 1411 | ||
Nationality Importance | mean | 2.0 | 1.9 | 2.0 | p value: 0.0071 |
sd | 1.0 | 1.0 | 1.0 | ||
N | 698 | 713 | 1411 | ||
Education Importance | mean | 2.6 | 2.3 | 2.4 | p value: <0.0001 |
sd | 0.6 | 0.9 | 0.8 | ||
N | 698 | 713 | 1411 | ||
Income Importance | mean | 2.3 | 2.2 | 2.3 | p value: <0.0001 |
sd | 0.8 | 0.9 | 0.9 | ||
N | 698 | 713 | 1411 | ||
Interview Importance | mean | 2.5 | 2.4 | 2.4 | p value: 0.1403 |
sd | 0.6 | 0.8 | 0.7 | ||
N | 698 | 713 | 1411 | ||
QRank2_GenderF | Male | 414 (71.63%) | 187 (31.48%) | 601 (51.28%) | p value: <0.0001 |
Female | 164 (28.37%) | 407 (68.52%) | 571 (48.72%) | ||
NA | 120 | 119 | 239 | ||
QRank2_AgeF | 18-34 | 250 (36.98%) | 232 (35.42%) | 482 (36.21%) | p value: 0.8078 |
35-54 | 419 (61.98%) | 415 (63.36%) | 834 (62.66%) | ||
55-65 | 7 (1.04%) | 8 (1.22%) | 15 (1.13%) | ||
NA | 22 | 58 | 80 | ||
QRank2_CountryF | Germany | 389 (61.75%) | 375 (58.41%) | 764 (60.06%) | p value: 0.2247 |
Italy | 241 (38.25%) | 267 (41.59%) | 508 (39.94%) | ||
NA | 68 | 71 | 139 | ||
QRank2_EducationF | Low | 6 (0.87%) | 17 (2.54%) | 23 (1.69%) | p value: <0.0001 |
Middle | 187 (26.98%) | 295 (44.03%) | 482 (35.36%) | ||
High | 500 (72.15%) | 358 (53.43%) | 858 (62.95%) | ||
NA | 5 | 43 | 48 | ||
QRank2_IncomeF | Low | 7 (1.04%) | 20 (2.97%) | 27 (2.00%) | p value: <0.0001 |
Middle | 213 (31.60%) | 300 (44.51%) | 513 (38.06%) | ||
High | 432 (64.09%) | 339 (50.30%) | 771 (57.20%) | ||
Unknown | 22 (3.26%) | 15 (2.23%) | 37 (2.74%) | ||
NA | 24 | 39 | 63 | ||
QRank2_InterviewF | Bad | 4 (0.57%) | 13 (1.91%) | 17 (1.23%) | p value: <0.0001 |
OK | 167 (23.96%) | 220 (32.31%) | 387 (28.08%) | ||
Good | 249 (35.72%) | 262 (38.47%) | 511 (37.08%) | ||
Very good | 277 (39.74%) | 186 (27.31%) | 463 (33.60%) | ||
NA | 1 | 32 | 33 | ||
subset.data.frame(data,Group==1) %>%
crosstable(c("QRANK1_1","QRANK1_2","QRANK1_3","QRANK1_4","QRANK1_5","QRANK1_6","QRank2_Gender","QRank2_Age","QRank2_Country","QRank2_Education","QRank2_Income","QRank2_Interview"), by=c("SectorF","country_dec"), funs=c(mean,sd,N), margin="col", total = "row") %>%
as_flextable()label | variable | country_dec=1 | country_dec=2 | Total | ||
|---|---|---|---|---|---|---|
SectorF=Banking | SectorF=HR | SectorF=Banking | SectorF=HR | |||
Gender Importance | mean | 1.9 | 1.7 | 1.5 | 1.5 | 1.7 |
sd | 0.9 | 1.0 | 1.0 | 1.1 | 1.0 | |
N | 355 | 353 | 350 | 353 | 1411 | |
Age Importance | mean | 2.2 | 2.0 | 2.0 | 2.0 | 2.0 |
sd | 0.7 | 0.8 | 1.0 | 0.9 | 0.8 | |
N | 355 | 353 | 350 | 353 | 1411 | |
Nationality Importance | mean | 2.3 | 2.0 | 1.7 | 1.8 | 2.0 |
sd | 0.8 | 1.0 | 1.0 | 1.1 | 1.0 | |
N | 355 | 353 | 350 | 353 | 1411 | |
Education Importance | mean | 2.4 | 2.6 | 2.1 | 2.6 | 2.4 |
sd | 0.7 | 0.6 | 1.0 | 0.6 | 0.8 | |
N | 355 | 353 | 350 | 353 | 1411 | |
Income Importance | mean | 2.5 | 2.3 | 2.4 | 1.9 | 2.3 |
sd | 0.7 | 0.8 | 0.8 | 1.0 | 0.9 | |
N | 355 | 353 | 350 | 353 | 1411 | |
Interview Importance | mean | 2.4 | 2.6 | 2.2 | 2.5 | 2.4 |
sd | 0.7 | 0.6 | 0.9 | 0.6 | 0.7 | |
N | 355 | 353 | 350 | 353 | 1411 | |
QRank2_Gender | 1 | 186 (56.88%) | 193 (61.66%) | 97 (35.53%) | 125 (48.26%) | 601 (51.28%) |
2 | 141 (43.12%) | 120 (38.34%) | 176 (64.47%) | 134 (51.74%) | 571 (48.72%) | |
NA | 28 | 40 | 77 | 94 | 239 | |
Among variables that you said were of some importance, please now tell us what type of loan applicant you would favour when deciding who to lend to? | 1 | 98 (28.49%) | 171 (50.15%) | 67 (21.34%) | 146 (43.98%) | 482 (36.21%) |
2 | 236 (68.60%) | 170 (49.85%) | 243 (77.39%) | 185 (55.72%) | 834 (62.66%) | |
3 | 10 (2.91%) | 0 (0%) | 4 (1.27%) | 1 (0.30%) | 15 (1.13%) | |
NA | 11 | 12 | 36 | 21 | 80 | |
Among variables that you said were of some importance, please now tell us what type of loan applicant you would favour when deciding who to lend to? | 1 | 339 (97.98%) | 318 (99.07%) | 66 (21.22%) | 41 (13.95%) | 764 (60.06%) |
2 | 7 (2.02%) | 3 (0.93%) | 245 (78.78%) | 253 (86.05%) | 508 (39.94%) | |
NA | 9 | 32 | 39 | 59 | 139 | |
Among variables that you said were of some importance, please now tell us what type of loan applicant you would favour when deciding who to lend to? | 1 | 14 (4.05%) | 4 (1.14%) | 4 (1.27%) | 1 (0.29%) | 23 (1.69%) |
2 | 133 (38.44%) | 146 (41.48%) | 101 (32.06%) | 102 (29.14%) | 482 (35.36%) | |
3 | 199 (57.51%) | 202 (57.39%) | 210 (66.67%) | 247 (70.57%) | 858 (62.95%) | |
NA | 9 | 1 | 35 | 3 | 48 | |
Among variables that you said were of some importance, please now tell us what type of loan applicant you would favour when deciding who to lend to? | mean | NA | NA | NA | NA | NA |
sd | NA | NA | NA | NA | NA | |
N | 352 | 344 | 340 | 312 | 1348 | |
Among variables that you said were of some importance, please now tell us what type of loan applicant you would favour when deciding who to lend to? | mean | NA | NA | NA | 3.1 | NA |
sd | NA | NA | NA | 0.8 | NA | |
N | 352 | 352 | 321 | 353 | 1378 | |
subset.data.frame(data,Group==1) %>%
crosstable(c("QRANK1_1","QRANK1_2","QRANK1_3","QRANK1_4","QRANK1_5","QRANK1_6","QRank2_Gender","QRank2_Age","QRank2_Country","QRank2_Education","QRank2_Income","QRank2_Interview"), by=c("SectorF","gender_dec"), funs=c(mean,sd,N), margin="col", total = "row") %>%
as_flextable()label | variable | gender_dec=1 | gender_dec=2 | Total | ||
|---|---|---|---|---|---|---|
SectorF=Banking | SectorF=HR | SectorF=Banking | SectorF=HR | |||
Gender Importance | mean | 1.7 | 1.6 | 1.7 | 1.7 | 1.7 |
sd | 1.0 | 1.0 | 1.0 | 1.1 | 1.0 | |
N | 352 | 346 | 353 | 360 | 1411 | |
Age Importance | mean | 2.2 | 2.0 | 2.0 | 2.0 | 2.0 |
sd | 0.7 | 0.8 | 0.9 | 0.8 | 0.8 | |
N | 352 | 346 | 353 | 360 | 1411 | |
Nationality Importance | mean | 2.1 | 1.9 | 1.9 | 1.9 | 2.0 |
sd | 0.9 | 1.0 | 0.9 | 1.0 | 1.0 | |
N | 352 | 346 | 353 | 360 | 1411 | |
Education Importance | mean | 2.5 | 2.7 | 2.1 | 2.5 | 2.4 |
sd | 0.7 | 0.6 | 1.0 | 0.6 | 0.8 | |
N | 352 | 346 | 353 | 360 | 1411 | |
Income Importance | mean | 2.6 | 2.1 | 2.3 | 2.0 | 2.3 |
sd | 0.6 | 0.9 | 0.8 | 0.9 | 0.9 | |
N | 352 | 346 | 353 | 360 | 1411 | |
Interview Importance | mean | 2.4 | 2.5 | 2.1 | 2.6 | 2.4 |
sd | 0.7 | 0.6 | 0.9 | 0.6 | 0.7 | |
N | 352 | 346 | 353 | 360 | 1411 | |
QRank2_Gender | 1 | 200 (67.57%) | 214 (75.89%) | 83 (27.30%) | 104 (35.86%) | 601 (51.28%) |
2 | 96 (32.43%) | 68 (24.11%) | 221 (72.70%) | 186 (64.14%) | 571 (48.72%) | |
NA | 56 | 64 | 49 | 70 | 239 | |
Among variables that you said were of some importance, please now tell us what type of loan applicant you would favour when deciding who to lend to? | 1 | 83 (24.06%) | 167 (50.45%) | 82 (26.20%) | 150 (43.86%) | 482 (36.21%) |
2 | 255 (73.91%) | 164 (49.55%) | 224 (71.57%) | 191 (55.85%) | 834 (62.66%) | |
3 | 7 (2.03%) | 0 (0%) | 7 (2.24%) | 1 (0.29%) | 15 (1.13%) | |
NA | 7 | 15 | 40 | 18 | 80 | |
Among variables that you said were of some importance, please now tell us what type of loan applicant you would favour when deciding who to lend to? | 1 | 214 (65.24%) | 175 (57.95%) | 191 (58.05%) | 184 (58.79%) | 764 (60.06%) |
2 | 114 (34.76%) | 127 (42.05%) | 138 (41.95%) | 129 (41.21%) | 508 (39.94%) | |
NA | 24 | 44 | 24 | 47 | 139 | |
Among variables that you said were of some importance, please now tell us what type of loan applicant you would favour when deciding who to lend to? | 1 | 4 (1.15%) | 2 (0.58%) | 14 (4.49%) | 3 (0.84%) | 23 (1.69%) |
2 | 104 (29.80%) | 83 (24.13%) | 130 (41.67%) | 165 (46.09%) | 482 (35.36%) | |
3 | 241 (69.05%) | 259 (75.29%) | 168 (53.85%) | 190 (53.07%) | 858 (62.95%) | |
NA | 3 | 2 | 41 | 2 | 48 | |
Among variables that you said were of some importance, please now tell us what type of loan applicant you would favour when deciding who to lend to? | mean | 2.7 | NA | NA | NA | NA |
sd | 0.5 | NA | NA | NA | NA | |
N | 352 | 322 | 340 | 334 | 1348 | |
Among variables that you said were of some importance, please now tell us what type of loan applicant you would favour when deciding who to lend to? | mean | NA | 3.2 | NA | NA | NA |
sd | NA | 0.8 | NA | NA | NA | |
N | 351 | 346 | 322 | 359 | 1378 | |
# by order of importance, we have education, interview,income, age, nationality and finally gender
# if a variable is rated as not important at all, we do not ask for the preferred type
# we see that out of 1411 participants
# 239 rate gender as irrelevant,
# 139 rate nationality as irrelevant,
# 80 rate age as irrelevant,
# 63 rate income as irrelevant
# 48 rate education as irrelevant,
# 33 rate interview as irrelevant
# for those who have a preference,
# 51% prefer men, but this depends on the gender of the decider (preference for men by men, for women by women), on the field (more preference for men in HR), and on the country (Germans prefer males, and Italians prefer women)
# 63% prefer age 32-46, especially in banking
# 60% prefer Germans (!, very clear preference for own country!),
# 63% prefer highly educated.
# 57% prefer high income
# 37% prefer good (more than very good) interview
# examination of preferences
subset.data.frame(data, ((Group==1))) %>%
crosstable(c("Preference_Women","Preference_Italy","Preference_Old","Preference_Educated","Preference_Rich","Preference_Interview"), funs=c(meansd,N), margin="col", cor_method = "pearson", test = TRUE) %>%
as_flextable()label | variable | value |
|---|---|---|
Preference_Women | meansd | -0.02 (2.0) |
N | 1411 | |
Preference_Italy | meansd | -0.4 (2.1) |
N | 1411 | |
Preference_Old | meansd | -0.7 (1.2) |
N | 1411 | |
Preference_Educated | meansd | 1.6 (1.4) |
N | 1411 | |
Preference_Rich | meansd | 1.3 (1.4) |
N | 1411 | |
Preference_Interview | meansd | 0.9 (1.4) |
N | 1411 |
subset.data.frame(data, ((Group==1))) %>%
crosstable(c("Preference_Women","Preference_Italy","Preference_Old","Preference_Educated","Preference_Rich","Preference_Interview"), by=c("CountryF", "SectorF"), funs=c(meansd,N), margin="col", cor_method = "pearson") %>%
as_flextable()label | variable | SectorF=Banking | SectorF=HR | ||
|---|---|---|---|---|---|
CountryF=Germany | CountryF=Italy | CountryF=Germany | CountryF=Italy | ||
Preference_Women | meansd | -0.2 (2.1) | 0.4 (1.8) | -0.4 (1.9) | 0.1 (1.9) |
N | 355 | 350 | 353 | 353 | |
Preference_Italy | meansd | -2.2 (1.0) | 1.1 (1.7) | -2.0 (1.0) | 1.4 (1.6) |
N | 355 | 350 | 353 | 353 | |
Preference_Old | meansd | -0.6 (1.2) | -0.4 (0.9) | -1.0 (1.2) | -0.9 (1.2) |
N | 355 | 350 | 353 | 353 | |
Preference_Educated | meansd | 1.4 (1.5) | 1.5 (1.4) | 1.6 (1.5) | 1.9 (1.3) |
N | 355 | 350 | 353 | 353 | |
Preference_Rich | meansd | 1.5 (1.5) | 1.6 (1.4) | 1.3 (1.4) | 0.9 (1.3) |
N | 355 | 350 | 353 | 353 | |
Preference_Interview | meansd | 0.7 (1.4) | 0.7 (1.3) | 1.2 (1.5) | 1.1 (1.4) |
N | 355 | 350 | 353 | 353 | |
# Graph of preferences by sector
subset.data.frame(data) %>% select("Preference_Women","Preference_Italy","Preference_Old","Preference_Educated","Preference_Rich","Preference_Interview","CountryF", "SectorF","gender_decF","country_decF") %>% group_by(SectorF) %>%
summarise(across(where(is.numeric), ~mean(., na.rm = TRUE), .names = "{.col}"),.groups = "keep") -> df
dfSectorF | Preference_Women | Preference_Italy | Preference_Old | Preference_Educated | Preference_Rich | Preference_Interview |
|---|---|---|---|---|---|---|
factor | numeric | numeric | numeric | numeric | numeric | numeric |
HR | -0.1 | -0.3 | -1.0 | 1.7 | 1.1 | 1.2 |
Banking | 0.1 | -0.6 | -0.5 | 1.4 | 1.6 | 0.7 |
n: 2 | ||||||
# web or radar chart
for ( col in 1:ncol(df)){
colnames(df)[col] <- sub("Preference_", "", colnames(df)[col])
}
rownames(df) <- with(df, paste(SectorF, sep = " "))## Warning: Setting row names on a tibble is deprecated.SectorF | Women | Italy | Old | Educated | Rich | Interview |
|---|---|---|---|---|---|---|
factor | numeric | numeric | numeric | numeric | numeric | numeric |
HR | -0.1 | -0.3 | -1.0 | 1.7 | 1.1 | 1.2 |
Banking | 0.1 | -0.6 | -0.5 | 1.4 | 1.6 | 0.7 |
n: 2 | ||||||
df2<- rbind(rep(3,6) , rep(-3,6) , df[,-c(1)], rep(0,6))
cb_radarchart <- function(data,
color = "#00AFBB",
vlabels = colnames(data),
vlcex = 0.7,
caxislabels = seq(-3, 3, 1),
title = NULL,
...) {
radarchart(
data,
# Customize the polygon
pcol = c(rgb(0.2, 0.5, 0.5, 0.9), rgb(0.8, 0.2, 0.5, 0.9)) ,
plwd = 2,
plty = 1,
# Customize the grid
cglcol = "grey",
cglty = 1,
cglwd = 0.8,
# Customize the axis
axislabcol = "grey",
# Variable labels
vlcex = vlcex,
vlabels = vlabels,
caxislabels = seq(-3, 3, 1),
title = title,
...
)
}
png(file = "Deciders_preferences_sector.png", width=1200, height=1050, res=300)
layout(matrix(c(1, 2), nrow = 1,
ncol = 2, byrow = TRUE))
for (i in 1:2){
par(mar=c(1,1,1,1)+0.1)
cb_radarchart(df2[c(1:2,i+2,5),],title=names[i])}
dev.off()## png
## 2Figure 24: Discriminatory preferences of deciders by gender and country
subset.data.frame(data) %>% select("Preference_Women","Preference_Italy","Preference_Old","Preference_Educated","Preference_Rich","Preference_Interview","TreatmentF", "SectorF","gender_decF","country_decF") %>% group_by(gender_decF,country_decF) %>%
summarise(across(where(is.numeric), ~mean(., na.rm = TRUE), .names = "{.col}"),.groups = "keep") -> df
# web or radar chart
for ( col in 1:ncol(df)){
colnames(df)[col] <- sub("Preference_", "", colnames(df)[col])
}
rownames(df) <- with(df, paste(gender_decF, country_decF, sep = " "))## Warning: Setting row names on a tibble is deprecated.names<-rownames(df)
df2<- rbind(rep(3,6) , rep(-3,6) , df[,-c(1:2)], rep(0,6))
cb_radarchart <- function(data,
color = "#00AFBB",
vlabels = colnames(data),
vlcex = 0.7,
caxislabels = seq(-3, 3, 1),
title = NULL,
...) {
radarchart(
data,
# Customize the polygon
pcol = c(rgb(0.2, 0.5, 0.5, 0.9), rgb(0.8, 0.2, 0.5, 0.9)) ,
plwd = 2,
plty = 1,
# Customize the grid
cglcol = "grey",
cglty = 1,
cglwd = 0.8,
# Customize the axis
axislabcol = "grey",
# Variable labels
vlcex = vlcex,
vlabels = vlabels,
caxislabels = seq(-3, 3, 1),
title = title,
...
)
}
png(file = "Deciders_preferences_gender_country.png", width=1200, height=1050, res=200)
layout(matrix(c(1, 2, 3, 4), nrow = 2,
ncol = 2, byrow = TRUE))
for (i in 1:4){
par(mar=c(1,1,1,1)+0.1)
cb_radarchart(df2[c(1:2,i+2,7),],title=names[i])}
dev.off()## png
## 2difference between AI and people preferences
#summary(with(data,cbind(diff_dec_AI_Women,diff_dec_AI_Old,diff_dec_AI_Italy,diff_dec_AI_Educated,diff_dec_AI_Rich,diff_dec_AI_Interview)))
# on average, more discrepancy with discrim AI.
# on average, people less keen on men than AI, more keen on old, same on country, more keen on educated, less keen on rich, and same on interview.
# Generate a summary table of the discrepancies by TreatmentF and SectorF using dplyr
subset.data.frame(data, Group == 1) %>%
select(TreatmentF, SectorF, diff_dec_AI_Women, diff_dec_AI_Old,
diff_dec_AI_Italy, diff_dec_AI_Educated, diff_dec_AI_Rich,
diff_dec_AI_Interview, diff_dec_AI) %>%
group_by(TreatmentF, SectorF) %>%
summarise(across(
.cols = is.numeric,
.fns = list(Mean = mean), na.rm = TRUE, # Calculate mean
.names = "{col}" #Naming convention for the resulting columns
)) -> table## Warning: There were 2 warnings in `summarise()`.
## The first warning was:
## ℹ In argument: `across(...)`.
## ℹ In group 1: `TreatmentF = Own`, `SectorF = HR`.
## Caused by warning:
## ! Use of bare predicate functions was deprecated in tidyselect 1.1.0.
## ℹ Please use wrap predicates in `where()` instead.
## # Was:
## data %>% select(is.numeric)
##
## # Now:
## data %>% select(where(is.numeric))
## ℹ Run `dplyr::last_dplyr_warnings()` to see the 1 remaining warning.## `summarise()` has grouped output by 'TreatmentF'. You can override using the
## `.groups` argument.TreatmentF | SectorF | diff_dec_AI_Women | diff_dec_AI_Old | diff_dec_AI_Italy | diff_dec_AI_Educated | diff_dec_AI_Rich | diff_dec_AI_Interview | diff_dec_AI |
|---|---|---|---|---|---|---|---|---|
factor | factor | numeric | numeric | numeric | numeric | numeric | numeric | numeric |
Own | HR | |||||||
Own | Banking | |||||||
Discrim AI | HR | 2.8 | -3.0 | 0.6 | -1.3 | -0.8 | -0.2 | 1.9 |
Discrim AI | Banking | 3.2 | 1.5 | 0.4 | -0.5 | -0.4 | 0.4 | 1.7 |
Fair AI | HR | -0.1 | 0.1 | -0.2 | -1.3 | -0.9 | 0.4 | 1.4 |
Fair AI | Banking | -0.1 | 0.5 | -0.5 | 0.5 | -1.4 | 0.3 | 1.5 |
n: 6 | ||||||||
# We can see also that diff in preference are diff by sector, e.g. HR prefer younger than discrim AI in HR, but older in Banking.
subset.data.frame(data,TreatmentF!="Own") %>% select("diff_dec_AI_Women","diff_dec_AI_Old","diff_dec_AI_Italy","diff_dec_AI_Educated","diff_dec_AI_Rich","diff_dec_AI_Interview","TreatmentF", "SectorF","gender_decF","country_decF") %>% group_by(SectorF,TreatmentF) %>%
summarise(across(where(is.numeric), ~mean(., na.rm = TRUE), .names = "{.col}"),.groups = "keep") -> df
df_long <- pivot_longer(df, cols = c("diff_dec_AI_Women","diff_dec_AI_Old","diff_dec_AI_Italy","diff_dec_AI_Educated","diff_dec_AI_Rich","diff_dec_AI_Interview"), names_to = "Variable", values_to = "diff_dec_AI")
# Create a bar graph using ggplot2 with C and D side by side starting from 0
plot<-ggplot(df_long, aes(x = Variable, y = diff_dec_AI, fill = Variable)) +
geom_col(position = "dodge", alpha = 0.7) +
#geom_text(aes(label = Variable), position = position_dodge(width = 0.8), vjust = -0.5, angle = 45, size = 3) +
#labs(x = "Treatments", y = "diff_dec_AI") +
scale_x_discrete(labels = c()) +
#scale_fill_manual(values = c("C" = "blue", "D" = "green")) +
facet_grid(TreatmentF ~ SectorF, scales = "fixed") +
theme_minimal()
plot
Table 14: Prejudice re. Gender and nationality
subset.data.frame(data,Group==1) %>%
crosstable(c("Q7_1","Q7_2","Q7_3","Q7_4","Q8_1","Q8_2","Q8_3","Q8_4"), by=c("SectorF"), funs=c(mean,sd,N), margin="col", total = "row") %>%
as_flextable()label | variable | SectorF | Total | |
|---|---|---|---|---|
HR | Banking | |||
Honesty - Gender | Men better | 98 (13.88%) | 135 (19.15%) | 233 (16.51%) |
Equal | 516 (73.09%) | 471 (66.81%) | 987 (69.95%) | |
Women better | 92 (13.03%) | 99 (14.04%) | 191 (13.54%) | |
Hard work - Gender | Men better | 117 (16.57%) | 162 (22.98%) | 279 (19.77%) |
Equal | 477 (67.56%) | 445 (63.12%) | 922 (65.34%) | |
Women better | 112 (15.86%) | 98 (13.90%) | 210 (14.88%) | |
Reliability - Gender | Men better | 111 (15.72%) | 158 (22.41%) | 269 (19.06%) |
Equal | 493 (69.83%) | 441 (62.55%) | 934 (66.19%) | |
Women better | 102 (14.45%) | 106 (15.04%) | 208 (14.74%) | |
Performance - Gender | Men better | 125 (17.71%) | 185 (26.24%) | 310 (21.97%) |
Equal | 493 (69.83%) | 457 (64.82%) | 950 (67.33%) | |
Women better | 88 (12.46%) | 63 (8.94%) | 151 (10.70%) | |
Honesty - Nationality | German better | 129 (18.27%) | 203 (28.79%) | 332 (23.53%) |
Equal | 488 (69.12%) | 435 (61.70%) | 923 (65.41%) | |
Italian better | 89 (12.61%) | 67 (9.50%) | 156 (11.06%) | |
Hard work - Nationality | German better | 153 (21.67%) | 216 (30.64%) | 369 (26.15%) |
Equal | 464 (65.72%) | 432 (61.28%) | 896 (63.50%) | |
Italian better | 89 (12.61%) | 57 (8.09%) | 146 (10.35%) | |
Reliability - Nationality | German better | 149 (21.10%) | 240 (34.04%) | 389 (27.57%) |
Equal | 466 (66.01%) | 392 (55.60%) | 858 (60.81%) | |
Italian better | 91 (12.89%) | 73 (10.35%) | 164 (11.62%) | |
Performance - Nationality | German better | 135 (19.12%) | 205 (29.08%) | 340 (24.10%) |
Equal | 478 (67.71%) | 433 (61.42%) | 911 (64.56%) | |
Italian better | 93 (13.17%) | 67 (9.50%) | 160 (11.34%) | |
# Q7 is comparing men and women, Q8 is comparing Germans and Italians
# 1 is honesty, 2 is hard work, 3 is reliability, 4 is performance
# men slightly more often rated as more honest, hard working, reliable and performant
# germans rated as more honest, hard working, reliable, performing
subset.data.frame(data,Group==1) %>%
crosstable(c("Q7_1","Q7_2","Q7_3","Q7_4","Q8_1","Q8_2","Q8_3","Q8_4"), by=c("gender_dec"), funs=c(mean,sd,N), margin="col", total = "row") %>%
as_flextable()label | variable | Are you…? | Total | |
|---|---|---|---|---|
1 | 2 | |||
Honesty - Gender | Men better | 120 (17.19%) | 113 (15.85%) | 233 (16.51%) |
Equal | 490 (70.20%) | 497 (69.71%) | 987 (69.95%) | |
Women better | 88 (12.61%) | 103 (14.45%) | 191 (13.54%) | |
Hard work - Gender | Men better | 144 (20.63%) | 135 (18.93%) | 279 (19.77%) |
Equal | 463 (66.33%) | 459 (64.38%) | 922 (65.34%) | |
Women better | 91 (13.04%) | 119 (16.69%) | 210 (14.88%) | |
Reliability - Gender | Men better | 139 (19.91%) | 130 (18.23%) | 269 (19.06%) |
Equal | 482 (69.05%) | 452 (63.39%) | 934 (66.19%) | |
Women better | 77 (11.03%) | 131 (18.37%) | 208 (14.74%) | |
Performance - Gender | Men better | 148 (21.20%) | 162 (22.72%) | 310 (21.97%) |
Equal | 493 (70.63%) | 457 (64.10%) | 950 (67.33%) | |
Women better | 57 (8.17%) | 94 (13.18%) | 151 (10.70%) | |
Honesty - Nationality | German better | 181 (25.93%) | 151 (21.18%) | 332 (23.53%) |
Equal | 454 (65.04%) | 469 (65.78%) | 923 (65.41%) | |
Italian better | 63 (9.03%) | 93 (13.04%) | 156 (11.06%) | |
Hard work - Nationality | German better | 171 (24.50%) | 198 (27.77%) | 369 (26.15%) |
Equal | 465 (66.62%) | 431 (60.45%) | 896 (63.50%) | |
Italian better | 62 (8.88%) | 84 (11.78%) | 146 (10.35%) | |
Reliability - Nationality | German better | 200 (28.65%) | 189 (26.51%) | 389 (27.57%) |
Equal | 432 (61.89%) | 426 (59.75%) | 858 (60.81%) | |
Italian better | 66 (9.46%) | 98 (13.74%) | 164 (11.62%) | |
Performance - Nationality | German better | 161 (23.07%) | 179 (25.11%) | 340 (24.10%) |
Equal | 465 (66.62%) | 446 (62.55%) | 911 (64.56%) | |
Italian better | 72 (10.32%) | 88 (12.34%) | 160 (11.34%) | |
# gender attitudes do not seem so dependent on gender of the respondent
subset.data.frame(data,Group==1) %>%
crosstable(c("Q7_1","Q7_2","Q7_3","Q7_4","Q8_1","Q8_2","Q8_3","Q8_4"), by=c("country_dec"), funs=c(mean,sd,N), margin="col", total = "row") %>%
as_flextable()label | variable | Country | Total | |
|---|---|---|---|---|
1 | 2 | |||
Honesty - Gender | Men better | 139 (19.63%) | 94 (13.37%) | 233 (16.51%) |
Equal | 491 (69.35%) | 496 (70.55%) | 987 (69.95%) | |
Women better | 78 (11.02%) | 113 (16.07%) | 191 (13.54%) | |
Hard work - Gender | Men better | 167 (23.59%) | 112 (15.93%) | 279 (19.77%) |
Equal | 471 (66.53%) | 451 (64.15%) | 922 (65.34%) | |
Women better | 70 (9.89%) | 140 (19.91%) | 210 (14.88%) | |
Reliability - Gender | Men better | 161 (22.74%) | 108 (15.36%) | 269 (19.06%) |
Equal | 456 (64.41%) | 478 (67.99%) | 934 (66.19%) | |
Women better | 91 (12.85%) | 117 (16.64%) | 208 (14.74%) | |
Performance - Gender | Men better | 168 (23.73%) | 142 (20.20%) | 310 (21.97%) |
Equal | 488 (68.93%) | 462 (65.72%) | 950 (67.33%) | |
Women better | 52 (7.34%) | 99 (14.08%) | 151 (10.70%) | |
Honesty - Nationality | German better | 195 (27.54%) | 137 (19.49%) | 332 (23.53%) |
Equal | 486 (68.64%) | 437 (62.16%) | 923 (65.41%) | |
Italian better | 27 (3.81%) | 129 (18.35%) | 156 (11.06%) | |
Hard work - Nationality | German better | 195 (27.54%) | 174 (24.75%) | 369 (26.15%) |
Equal | 480 (67.80%) | 416 (59.17%) | 896 (63.50%) | |
Italian better | 33 (4.66%) | 113 (16.07%) | 146 (10.35%) | |
Reliability - Nationality | German better | 243 (34.32%) | 146 (20.77%) | 389 (27.57%) |
Equal | 434 (61.30%) | 424 (60.31%) | 858 (60.81%) | |
Italian better | 31 (4.38%) | 133 (18.92%) | 164 (11.62%) | |
Performance - Nationality | German better | 200 (28.25%) | 140 (19.91%) | 340 (24.10%) |
Equal | 481 (67.94%) | 430 (61.17%) | 911 (64.56%) | |
Italian better | 27 (3.81%) | 133 (18.92%) | 160 (11.34%) | |
# Germany has better view of men, but maybe due to different gender composition
# Germans definitely see themselves as better on everything, italians agree, but not as much...
subset.data.frame(data,Group==1) %>%
crosstable(c("Q7_1","Q7_2","Q7_3","Q7_4","Q8_1","Q8_2","Q8_3","Q8_4"), by=c("gender_dec","country_dec"), funs=c(mean,sd,N), margin="col", total = "row") %>%
as_flextable()label | variable | country_dec=1 | country_dec=2 | Total | ||
|---|---|---|---|---|---|---|
gender_dec=1 | gender_dec=2 | gender_dec=1 | gender_dec=2 | |||
Honesty - Gender | Men better | 79 (22.44%) | 60 (16.85%) | 41 (11.85%) | 53 (14.85%) | 233 (16.51%) |
Equal | 239 (67.90%) | 252 (70.79%) | 251 (72.54%) | 245 (68.63%) | 987 (69.95%) | |
Women better | 34 (9.66%) | 44 (12.36%) | 54 (15.61%) | 59 (16.53%) | 191 (13.54%) | |
Hard work - Gender | Men better | 92 (26.14%) | 75 (21.07%) | 52 (15.03%) | 60 (16.81%) | 279 (19.77%) |
Equal | 237 (67.33%) | 234 (65.73%) | 226 (65.32%) | 225 (63.03%) | 922 (65.34%) | |
Women better | 23 (6.53%) | 47 (13.20%) | 68 (19.65%) | 72 (20.17%) | 210 (14.88%) | |
Reliability - Gender | Men better | 82 (23.30%) | 79 (22.19%) | 57 (16.47%) | 51 (14.29%) | 269 (19.06%) |
Equal | 237 (67.33%) | 219 (61.52%) | 245 (70.81%) | 233 (65.27%) | 934 (66.19%) | |
Women better | 33 (9.38%) | 58 (16.29%) | 44 (12.72%) | 73 (20.45%) | 208 (14.74%) | |
Performance - Gender | Men better | 83 (23.58%) | 85 (23.88%) | 65 (18.79%) | 77 (21.57%) | 310 (21.97%) |
Equal | 259 (73.58%) | 229 (64.33%) | 234 (67.63%) | 228 (63.87%) | 950 (67.33%) | |
Women better | 10 (2.84%) | 42 (11.80%) | 47 (13.58%) | 52 (14.57%) | 151 (10.70%) | |
Honesty - Nationality | German better | 104 (29.55%) | 91 (25.56%) | 77 (22.25%) | 60 (16.81%) | 332 (23.53%) |
Equal | 238 (67.61%) | 248 (69.66%) | 216 (62.43%) | 221 (61.90%) | 923 (65.41%) | |
Italian better | 10 (2.84%) | 17 (4.78%) | 53 (15.32%) | 76 (21.29%) | 156 (11.06%) | |
Hard work - Nationality | German better | 95 (26.99%) | 100 (28.09%) | 76 (21.97%) | 98 (27.45%) | 369 (26.15%) |
Equal | 247 (70.17%) | 233 (65.45%) | 218 (63.01%) | 198 (55.46%) | 896 (63.50%) | |
Italian better | 10 (2.84%) | 23 (6.46%) | 52 (15.03%) | 61 (17.09%) | 146 (10.35%) | |
Reliability - Nationality | German better | 132 (37.50%) | 111 (31.18%) | 68 (19.65%) | 78 (21.85%) | 389 (27.57%) |
Equal | 212 (60.23%) | 222 (62.36%) | 220 (63.58%) | 204 (57.14%) | 858 (60.81%) | |
Italian better | 8 (2.27%) | 23 (6.46%) | 58 (16.76%) | 75 (21.01%) | 164 (11.62%) | |
Performance - Nationality | German better | 108 (30.68%) | 92 (25.84%) | 53 (15.32%) | 87 (24.37%) | 340 (24.10%) |
Equal | 236 (67.05%) | 245 (68.82%) | 229 (66.18%) | 201 (56.30%) | 911 (64.56%) | |
Italian better | 8 (2.27%) | 19 (5.34%) | 64 (18.50%) | 69 (19.33%) | 160 (11.34%) | |
# German men see themselves more frequently better than women than German women do, but women do also see men as better.
# this is not so much the case in Germany, where actually there is less bias against men, sometimes a bias for women, and less differences between gender
# prejudice is an index summarizing answers to 1,2,3,4.
# Q9 and Q10 are about acceptability to discriminate based on gender or nationality
subset.data.frame(data,Group==1) %>%
crosstable(c("Prejudice_vs_Women","Prejudice_vs_Italy", "Q9","Q10"), by=c("SectorF",country_decF,gender_decF), funs=c(mean,sd,N), margin="col", total = "row") %>%
as_flextable()label | variable | gender_decF=Female | gender_decF=Male | Total | ||||||
|---|---|---|---|---|---|---|---|---|---|---|
country_decF=Germany | country_decF=Italy | country_decF=Germany | country_decF=Italy | |||||||
SectorF=Banking | SectorF=HR | SectorF=Banking | SectorF=HR | SectorF=Banking | SectorF=HR | SectorF=Banking | SectorF=HR | |||
Prejudice vs. Women | mean | 0.1 | 0.1 | 0.1 | -0.1 | 0.2 | 0.1 | -0.02 | 0.02 | 0.1 |
sd | 0.4 | 0.4 | 0.4 | 0.4 | 0.4 | 0.3 | 0.4 | 0.3 | 0.4 | |
N | 171 | 185 | 182 | 175 | 184 | 168 | 168 | 178 | 1411 | |
Prejudice vs. Italians | mean | 0.2 | 0.2 | 0.1 | -0.1 | 0.4 | 0.2 | 0.1 | -0.01 | 0.1 |
sd | 0.3 | 0.4 | 0.5 | 0.5 | 0.3 | 0.3 | 0.5 | 0.4 | 0.4 | |
N | 171 | 185 | 182 | 175 | 184 | 168 | 168 | 178 | 1411 | |
Gender Discr OK | mean | 2.1 | 2.2 | 2.0 | 2.1 | 2.2 | 2.3 | 2.2 | 2.1 | 2.1 |
sd | 1.0 | 1.0 | 1.0 | 1.1 | 0.9 | 0.9 | 1.0 | 0.9 | 1.0 | |
N | 171 | 185 | 182 | 175 | 184 | 168 | 168 | 178 | 1411 | |
Country Discr OK | mean | 2.4 | 2.3 | 2.4 | 2.1 | 2.3 | 2.4 | 2.2 | 2.1 | 2.3 |
sd | 1.0 | 1.0 | 1.1 | 1.1 | 0.9 | 1.1 | 1.0 | 0.9 | 1.0 | |
N | 171 | 185 | 182 | 175 | 184 | 168 | 168 | 178 | 1411 | |
subset.data.frame(data,Group==1) %>%
crosstable(c(Prejudice_vs_Women, Prejudice_vs_Italy, "Q9","Q10"), by=c(SectorF), funs=c(meansd,N), margin="col", cor_method = "pearson", test = TRUE) %>% as_flextable()label | variable | SectorF | test | |
|---|---|---|---|---|
HR | Banking | |||
Prejudice vs. Women | meansd | 0.02 (0.3) | 0.1 (0.4) | p value: <0.0001 |
N | 706 | 705 | ||
Prejudice vs. Italians | meansd | 0.1 (0.4) | 0.2 (0.4) | p value: <0.0001 |
N | 706 | 705 | ||
Gender Discr OK | meansd | 2.2 (1.0) | 2.1 (1.0) | p value: 0.4009 |
N | 706 | 705 | ||
Country Discr OK | meansd | 2.2 (1.0) | 2.3 (1.0) | p value: 0.1000 |
N | 706 | 705 | ||
subset.data.frame(data,Group==1) %>%
crosstable(c(Prejudice_vs_Women, Prejudice_vs_Italy, "Q9","Q10"), by=c(CountryF), funs=c(meansd,N), margin="col", cor_method = "pearson", test = TRUE) %>% as_flextable()label | variable | CountryF | test | |
|---|---|---|---|---|
Germany | Italy | |||
Prejudice vs. Women | meansd | 0.1 (0.4) | -0.005 (0.4) | p value: <0.0001 |
N | 708 | 703 | ||
Prejudice vs. Italians | meansd | 0.3 (0.3) | 0.03 (0.5) | p value: <0.0001 |
N | 708 | 703 | ||
Gender Discr OK | meansd | 2.2 (1.0) | 2.1 (1.0) | p value: 0.0165 |
N | 708 | 703 | ||
Country Discr OK | meansd | 2.4 (1.0) | 2.2 (1.0) | p value: 0.0248 |
N | 708 | 703 | ||
subset.data.frame(data,Group==1) %>%
crosstable(c(Prejudice_vs_Women, Prejudice_vs_Italy, "Q9","Q10"), by=c(gender_dec), funs=c(meansd,N), margin="col", cor_method = "pearson", test = TRUE) %>% as_flextable()label | variable | Are you…? | test | |
|---|---|---|---|---|
1 | 2 | |||
Prejudice vs. Women | meansd | 0.1 (0.3) | 0.03 (0.4) | p value: 0.0613 |
N | 698 | 713 | ||
Prejudice vs. Italians | meansd | 0.2 (0.4) | 0.1 (0.5) | p value: 0.5639 |
N | 698 | 713 | ||
Gender Discr OK | meansd | 2.2 (0.9) | 2.1 (1.0) | p value: 0.0270 |
N | 698 | 713 | ||
Country Discr OK | meansd | 2.3 (1.0) | 2.3 (1.1) | p value: 0.5296 |
N | 698 | 713 | ||
subset.data.frame(data,Group==1) %>%
crosstable(c(Prejudice_vs_Women, Prejudice_vs_Italy, "Q9","Q10"), by=c(CountryF, SectorF), funs=c(meansd,N), margin="col", total = "row") %>% as_flextable()label | variable | SectorF=Banking | SectorF=HR | Total | ||
|---|---|---|---|---|---|---|
CountryF=Germany | CountryF=Italy | CountryF=Germany | CountryF=Italy | |||
Prejudice vs. Women | meansd | 0.2 (0.4) | 0.04 (0.4) | 0.1 (0.3) | -0.05 (0.4) | 0.1 (0.4) |
N | 355 | 350 | 353 | 353 | 1411 | |
Prejudice vs. Italians | meansd | 0.3 (0.3) | 0.1 (0.5) | 0.2 (0.3) | -0.04 (0.5) | 0.1 (0.4) |
N | 355 | 350 | 353 | 353 | 1411 | |
Gender Discr OK | meansd | 2.2 (0.9) | 2.1 (1.0) | 2.2 (1.0) | 2.1 (1.0) | 2.1 (1.0) |
N | 355 | 350 | 353 | 353 | 1411 | |
Country Discr OK | meansd | 2.3 (0.9) | 2.3 (1.1) | 2.4 (1.0) | 2.1 (1.0) | 2.3 (1.0) |
N | 355 | 350 | 353 | 353 | 1411 | |
Figure 25: Correlation between own characteristics and preferences + prejudices
names<-c("Woman_dec","Italian_dec", "age_dec", "education_dec", "income_dec", "Preference_Women","Preference_Italy","Preference_Old","Preference_Educated","Preference_Rich","Prejudice_vs_Women","Prejudice_vs_Italy")
names<-names[12:1]
cat(paste(shQuote(names, type="cmd"), collapse=", "))## "Prejudice_vs_Italy", "Prejudice_vs_Women", "Preference_Rich", "Preference_Educated", "Preference_Old", "Preference_Italy", "Preference_Women", "income_dec", "education_dec", "age_dec", "Italian_dec", "Woman_dec"corr_data<-select(subset(data,Group==1), "Prejudice_vs_Italy", "Prejudice_vs_Women", "Preference_Rich", "Preference_Educated", "Preference_Old", "Preference_Italy", "Preference_Women", "income_dec", "education_dec", "age_dec", "Italian_dec", "Woman_dec")
cormat <- round(cor(corr_data),2)
#cormat
# correlations preferences and own characteristics
pref_prej<-cormat[c(6:10),c(1:5,11:12)]
#pref_prej
library(corrplot)## corrplot 0.92 loadedcorrplot(pref_prej, type="upper", addCoef.col = 'black', tl.col = 'black', cl.ratio = 0.2, tl.srt = 45)
plot<-ggcorrmat(
data = corr_data,
type = "parametric", # parametric for Pearson, nonparametric for Spearman's correlation
colors = c("darkred", "white", "steelblue"), # change default colors
matrix.type = "upper"
)
plot
Table 15: Performance of AI, human, AI+Human
data %>%
group_by(ID, TreatmentF,SectorF) %>%
summarise(mean_Real_Scores_chosen = mean(Real_Scores_chosen, na.rm = TRUE), mean_Real_Scores_recommended = mean(Real_Scores_recommended, na.rm = TRUE)) -> dataID## `summarise()` has grouped output by 'ID', 'TreatmentF'. You can override using
## the `.groups` argument.ID | TreatmentF | SectorF | mean_Real_Scores_chosen | mean_Real_Scores_recommended |
|---|---|---|---|---|
integer | factor | factor | numeric | numeric |
1 | Fair AI | Banking | 110.8 | 113.8 |
2 | Own | Banking | 113.3 | |
3 | Discrim AI | Banking | 111.2 | 114.8 |
4 | Fair AI | Banking | 94.9 | 114.1 |
5 | Discrim AI | Banking | 122.5 | 114.2 |
6 | Own | Banking | 95.8 | |
7 | Discrim AI | Banking | 131.8 | 129.4 |
8 | Fair AI | Banking | 96.7 | 98.3 |
9 | Discrim AI | Banking | 93.8 | 120.0 |
10 | Own | Banking | 94.6 | |
11 | Fair AI | Banking | 108.3 | 107.5 |
12 | Fair AI | Banking | 109.9 | 111.7 |
n: 1411 | ||||
dataID %>% crosstable(c(mean_Real_Scores_chosen,mean_Real_Scores_recommended), by=c("TreatmentF", "SectorF"), funs=c(mean,sd,N), margin="col", percent_digits = 0, cor_method = "pearson") %>% as_flextable() %>% save_as_docx( path = "performance.docx")
# we see that AI does not lead to improvement overall, even though following it all the time would have improved things.
#now to be seen if any person did better than the AI --> compute mean score_chosen by individual and by AI and see % above.
# tests
subset(dataID,SectorF=="HR") %>% crosstable(c(mean_Real_Scores_chosen,mean_Real_Scores_recommended), by=c("TreatmentF"), funs=c(mean,sd,N), margin="col", percent_digits = 0, cor_method = "pearson", test = TRUE) %>% as_flextable() label | variable | TreatmentF | test | ||
|---|---|---|---|---|---|
Own | Discrim AI | Fair AI | |||
mean_Real_Scores_chosen | mean | 59.1 | 59.9 | 59.9 | p value: 0.2964 |
sd | 4.2 | 5.0 | 5.3 | ||
N | 235 | 236 | 235 | ||
mean_Real_Scores_recommended | mean | NA | 64.8 | 61.2 | p value: <0.0001 |
sd | NA | 4.0 | 4.1 | ||
N | 0 | 236 | 235 | ||
subset(dataID,SectorF=="Banking") %>% crosstable(c(mean_Real_Scores_chosen,mean_Real_Scores_recommended), by=c("TreatmentF"), funs=c(mean,sd,N), margin="col", percent_digits = 0, cor_method = "pearson", test = TRUE) %>% as_flextable() label | variable | TreatmentF | test | ||
|---|---|---|---|---|---|
Own | Discrim AI | Fair AI | |||
mean_Real_Scores_chosen | mean | 109.1 | 109.8 | 107.2 | p value: 0.0362 |
sd | 13.0 | 12.2 | 13.6 | ||
N | 225 | 241 | 239 | ||
mean_Real_Scores_recommended | mean | NA | 119.8 | 114.9 | p value: <0.0001 |
sd | NA | 10.3 | 12.4 | ||
N | 0 | 241 | 239 | ||
## Warning: package 'BSDA' was built under R version 4.3.3## Loading required package: lattice
##
## Attaching package: 'BSDA'
##
## The following objects are masked from 'package:carData':
##
## Vocab, Wool
##
## The following object is masked from 'package:datasets':
##
## Orange##
## Welch Modified Two-Sample t-Test
##
## data: Summarized x and y
## t = -9.7229, df = 466.87, p-value < 2.2e-16
## alternative hypothesis: true difference in means is not equal to 0
## 95 percent confidence interval:
## -12.021051 -7.978949
## sample estimates:
## mean of x mean of y
## 109.8 119.8##
## Welch Modified Two-Sample t-Test
##
## data: Summarized x and y
## t = -6.468, df = 472, p-value = 2.486e-10
## alternative hypothesis: true difference in means is not equal to 0
## 95 percent confidence interval:
## -10.039293 -5.360707
## sample estimates:
## mean of x mean of y
## 107.2 114.9##
## Welch Modified Two-Sample t-Test
##
## data: Summarized x and y
## t = -11.731, df = 446.49, p-value < 2.2e-16
## alternative hypothesis: true difference in means is not equal to 0
## 95 percent confidence interval:
## -5.72089 -4.07911
## sample estimates:
## mean of x mean of y
## 59.9 64.8##
## Welch Modified Two-Sample t-Test
##
## data: Summarized x and y
## t = -2.9741, df = 440.22, p-value = 0.0031
## alternative hypothesis: true difference in means is not equal to 0
## 95 percent confidence interval:
## -2.1590788 -0.4409212
## sample estimates:
## mean of x mean of y
## 59.9 61.2……………..
Testing of hypothese
……………..
Individual discriminatory preferences and behavior
H1: In the treatment without AI, DMs make discriminatory decisions in terms of gender and country.
Figure 11
# DESCRIPTIVE
# Gender
subset.data.frame(data, TreatmentF=="Own") %>%
crosstable(c("choice_1"), by=c("W_vs_M"), funs=c(mean,sd,N), margin="col") %>%
as_flextable()label | variable | W_vs_M | ||
|---|---|---|---|---|
-1 | 0 | 1 | ||
Choice of candidate 1 | 0 | 27 (51.92%) | 1334 (46.58%) | 1199 (46.04%) |
1 | 25 (48.08%) | 1530 (53.42%) | 1405 (53.96%) | |
#"WM" = "-1", "Same" = "0", "MW"="1"
# no clear favoring of women, since chosen 54% of the time when in position 1, but this is not more than 53% of the time when no diff in gender and in position 1
# split by gender
subset.data.frame(data, TreatmentF=="Own") %>%
crosstable(c("choice_1"), by=c("W_vs_M", "gender_decF"), funs=c(mean,sd,N), margin="col") %>%
as_flextable()label | variable | gender_decF=Female | gender_decF=Male | ||||
|---|---|---|---|---|---|---|---|
W_vs_M=-1 | W_vs_M=0 | W_vs_M=1 | W_vs_M=-1 | W_vs_M=0 | W_vs_M=1 | ||
Choice of candidate 1 | 0 | 17 (68.00%) | 696 (47.25%) | 625 (46.43%) | 10 (37.04%) | 638 (45.87%) | 574 (45.63%) |
1 | 8 (32.00%) | 777 (52.75%) | 721 (53.57%) | 17 (62.96%) | 753 (54.13%) | 684 (54.37%) | |
# here again no clear sign of favoring men or women by either gender
# CountryF
# "GI" = "-1", "Same" = "0", "IG"="1"
subset.data.frame(data, TreatmentF=="Own") %>%
crosstable(c("choice_1"), by=c("Ita_vs_Ger"), funs=c(mean,sd,N), margin="col") %>%
as_flextable()label | variable | Ita_vs_Ger | ||
|---|---|---|---|---|
-1 | 0 | 1 | ||
Choice of candidate 1 | 0 | 1178 (45.01%) | 1165 (46.94%) | 217 (51.54%) |
1 | 1439 (54.99%) | 1317 (53.06%) | 204 (48.46%) | |
# here we go from 53% 1 chosen if no diff to 45% 1 chosen if Ger vs Ital --> an effect
subset.data.frame(data, TreatmentF=="Own") %>%
crosstable(c("choice_1"), by=c("Ita_vs_Ger","country_decF"), funs=c(mean,sd,N), margin="col") %>%
as_flextable()label | variable | country_decF=Germany | country_decF=Italy | ||||
|---|---|---|---|---|---|---|---|
Ita_vs_Ger=-1 | Ita_vs_Ger=0 | Ita_vs_Ger=1 | Ita_vs_Ger=-1 | Ita_vs_Ger=0 | Ita_vs_Ger=1 | ||
Choice of candidate 1 | 0 | 535 (40.62%) | 602 (47.55%) | 111 (52.11%) | 643 (49.46%) | 563 (46.30%) | 106 (50.96%) |
1 | 782 (59.38%) | 664 (52.45%) | 102 (47.89%) | 657 (50.54%) | 653 (53.70%) | 102 (49.04%) | |
# true in Germany, not in Italy
# linearity of logit function close to the middle
p<-(0:100)/100
plot(p, log(p/(1-p)))
# TESTING
random1 <-plm(choice_1 ~ W_vs_M+Ita_vs_Ger+education_diff+age_diff+income_diff+interview_diff, data=subset.data.frame(data, TreatmentF=="Own"), index=c("ID", "Group"), model="random")
# controlling for Ita vs. ger, we now see favoring women. This effect was hidden otherwise.
# need also to control by profession
randomHR <-plm(choice_1 ~ (W_vs_M+Ita_vs_Ger+education_diff+age_diff+income_diff+interview_diff), data=subset.data.frame(data, TreatmentF=="Own"&SectorF=="HR"), index=c("ID", "Group"), model="random")
randomBank <-plm(choice_1 ~ (W_vs_M+Ita_vs_Ger+education_diff+age_diff+income_diff+interview_diff), data=subset.data.frame(data, TreatmentF=="Own"&SectorF=="Banking"), index=c("ID", "Group"), model="random")
# discrimination against men is mostly in HR, against Italians is in both fields
randomFemale <-plm(choice_1 ~ (W_vs_M+Ita_vs_Ger+education_diff+age_diff+income_diff+interview_diff), data=subset.data.frame(data, TreatmentF=="Own"&gender_decF=="Female"), index=c("ID", "Group"), model="random")
randomMale <-plm(choice_1 ~ (W_vs_M+Ita_vs_Ger+education_diff+age_diff+income_diff+interview_diff), data=subset.data.frame(data, TreatmentF=="Own"&gender_decF=="Male"), index=c("ID", "Group"), model="random")
randomItaly <-plm(choice_1 ~ (W_vs_M+Ita_vs_Ger+education_diff+age_diff+income_diff+interview_diff), data=subset.data.frame(data, TreatmentF=="Own"&CountryF=="Italy"), index=c("ID", "Group"), model="random")
randomGermany <-plm(choice_1 ~ (W_vs_M+Ita_vs_Ger+education_diff+age_diff+income_diff+interview_diff), data=subset.data.frame(data, TreatmentF=="Own"&CountryF=="Germany"), index=c("ID", "Group"), model="random")
stargazer(random1,randomBank,randomHR,randomGermany,randomItaly, type = "text", out = "regression_biases1.html", no.space=TRUE, single.row=TRUE, align=TRUE, star.cutoffs = c(0.05, 0.01, 0.001),report = "vc*", header = FALSE, df=FALSE, digits=3, se = NULL, column.labels = c("Overall", "Banking", "HR","Germany","Italy"))##
## ==================================================================
## Dependent variable:
## ---------------------------------------------------
## choice_1
## Overall Banking HR Germany Italy
## (1) (2) (3) (4) (5)
## ------------------------------------------------------------------
## W_vs_M 0.042* 0.009 0.054* 0.039 0.046
## Ita_vs_Ger -0.028 0.005 -0.049* -0.065** 0.008
## education_diff 0.031*** 0.030** 0.025* 0.027** 0.037***
## age_diff -0.013* 0.002 -0.028** -0.023** -0.001
## income_diff 0.036*** 0.074*** 0.001 0.041*** 0.030***
## interview_diff 0.032*** 0.038*** 0.027*** 0.032*** 0.032***
## Constant 0.501*** 0.537*** 0.483*** 0.505*** 0.495***
## ------------------------------------------------------------------
## Observations 5,520 2,700 2,820 2,796 2,724
## R2 0.028 0.058 0.016 0.034 0.026
## Adjusted R2 0.027 0.056 0.014 0.032 0.024
## F Statistic 156.255*** 164.920*** 46.605*** 99.116*** 73.242***
## ==================================================================
## Note: *p<0.05; **p<0.01; ***p<0.001stargazer(randomFemale,randomMale, type = "text", out = "regression_biases2.html", no.space=TRUE, single.row=TRUE, align=TRUE, star.cutoffs = c(0.05, 0.01, 0.001),report = "vc*", header = FALSE, df=FALSE, digits=3, se = NULL, column.labels = c("Female","Male"))##
## =============================================
## Dependent variable:
## ------------------------------
## choice_1
## Female Male
## (1) (2)
## ---------------------------------------------
## W_vs_M 0.046* 0.037
## Ita_vs_Ger -0.025 -0.032
## education_diff 0.031** 0.031**
## age_diff -0.008 -0.018
## income_diff 0.024** 0.049***
## interview_diff 0.034*** 0.029***
## Constant 0.492*** 0.509***
## ---------------------------------------------
## Observations 2,844 2,676
## R2 0.024 0.033
## Adjusted R2 0.022 0.031
## F Statistic 71.125*** 91.568***
## =============================================
## Note: *p<0.05; **p<0.01; ***p<0.001plot<-plot_summs(random1,randomBank,randomHR,randomGermany,randomItaly,randomFemale,randomMale, coefs = c("Female" = "W_vs_M", "Italian" = "Ita_vs_Ger", "More Education" = "education_diff", "Older" = "age_diff", "Richer" = "income_diff", "Interview" = "interview_diff"), model.names = c("Overall", "Banking", "HR","Germany","Italy","Female","Male"))## Registered S3 methods overwritten by 'broom':
## method from
## tidy.glht jtools
## tidy.summary.glht jtools## Loading required namespace: broom.mixed
H2: In each treatment, DMs are more likely to choose applicants that are more similar to them in terms of their characteristics
# We include an index of similarity between an applicant and the DM (differences in the characteristics of the DMs and those of the two applicants). The higher the similarity, the more likely to choose the applicant.
# We thus run the following regressions in each treatment:
random0 <-plm(choice_1 ~ W_vs_M+Ita_vs_Ger+education_diff+age_diff+income_diff+interview_diff+diff_diff_applicant, data=subset.data.frame(data, TreatmentF=="Own"), index=c("ID", "Group"), model="random")
#summary(random0)
# this confirms the hypothesis. we can differentiate for different dimensions of similarity
random1 <-plm(choice_1 ~ W_vs_M+Ita_vs_Ger+education_diff+age_diff+income_diff+interview_diff+diff_diff_applicant_gender + diff_diff_applicant_country + diff_diff_applicant_age + diff_diff_applicant_education+ diff_diff_applicant_income, data=subset.data.frame(data, TreatmentF=="Own"), index=c("ID", "Group"), model="random")
#summary(random1)
# we see that differences in age and gender do not seem to matter that much, but diff in country, income and esp. education do.H3: For a given treatment, DMs that express discriminatory preferences and beliefs, and think it is legitimate to act on them, make decisions that are more discriminatory.
Table 23
## x y
## x 1.00 -0.19
## y -0.19 1.00
##
## n= 1411
##
##
## P
## x y
## x 0
## y 0# highly significant negative correlation, as would be expected
with(subset.data.frame(data,Group==1),rcorr(Prejudice_vs_Italy,Preference_Italy))## x y
## x 1.00 -0.37
## y -0.37 1.00
##
## n= 1411
##
##
## P
## x y
## x 0
## y 0# highly significant negative correlation, as would be expected
with(subset.data.frame(data,Group==1),table(gender_dec,Preference_Women))gender_dec | Preference_Women | ||||||||
|---|---|---|---|---|---|---|---|---|---|
-3 | -2 | -1 | 0 | 1 | 2 | 3 | Total | ||
1 | Count | 101 (7.2%) | 196 (13.9%) | 117 (8.3%) | 120 (8.5%) | 48 (3.4%) | 69 (4.9%) | 47 (3.3%) | 698 (49.5%) |
Mar. pct (1) | 66.0% ; 14.5% | 70.0% ; 28.1% | 69.6% ; 16.8% | 50.2% ; 17.2% | 30.0% ; 6.9% | 30.1% ; 9.9% | 25.8% ; 6.7% | ||
2 | Count | 52 (3.7%) | 84 (6.0%) | 51 (3.6%) | 119 (8.4%) | 112 (7.9%) | 160 (11.3%) | 135 (9.6%) | 713 (50.5%) |
Mar. pct | 34.0% ; 7.3% | 30.0% ; 11.8% | 30.4% ; 7.2% | 49.8% ; 16.7% | 70.0% ; 15.7% | 69.9% ; 22.4% | 74.2% ; 18.9% | ||
Total | Count | 153 (10.8%) | 280 (19.8%) | 168 (11.9%) | 239 (16.9%) | 160 (11.3%) | 229 (16.2%) | 182 (12.9%) | 1,411 (100.0%) |
(1) Columns and rows percentages | |||||||||
# Men and women both disliking each other to the same extent
with(subset.data.frame(data,Group==1),table(country_dec,Preference_Italy))country_dec | Preference_Italy | ||||||||
|---|---|---|---|---|---|---|---|---|---|
-3 | -2 | -1 | 0 | 1 | 2 | 3 | Total | ||
1 | Count | 306 (21.7%) | 220 (15.6%) | 131 (9.3%) | 41 (2.9%) | 5 (0.4%) | 2 (0.1%) | 3 (0.2%) | 708 (50.2%) |
Mar. pct (1) | 93.3% ; 43.2% | 84.3% ; 31.1% | 74.9% ; 18.5% | 29.5% ; 5.8% | 3.6% ; 0.7% | 1.1% ; 0.3% | 1.5% ; 0.4% | ||
2 | Count | 22 (1.6%) | 41 (2.9%) | 44 (3.1%) | 98 (6.9%) | 134 (9.5%) | 172 (12.2%) | 192 (13.6%) | 703 (49.8%) |
Mar. pct | 6.7% ; 3.1% | 15.7% ; 5.8% | 25.1% ; 6.3% | 70.5% ; 13.9% | 96.4% ; 19.1% | 98.9% ; 24.5% | 98.5% ; 27.3% | ||
Total | Count | 328 (23.2%) | 261 (18.5%) | 175 (12.4%) | 139 (9.9%) | 139 (9.9%) | 174 (12.3%) | 195 (13.8%) | 1,411 (100.0%) |
(1) Columns and rows percentages | |||||||||
# Germans more extreme in their avoidance of Italians than Italians in their rejection of Germans
with(subset.data.frame(data,Group==1),rcorr(gender_dec,Preference_Women))## x y
## x 1.00 0.34
## y 0.34 1.00
##
## n= 1411
##
##
## P
## x y
## x 0
## y 0# highly significant positive correlation
with(subset.data.frame(data,Group==1),rcorr(country_dec,Preference_Italy))## x y
## x 1.00 0.77
## y 0.77 1.00
##
## n= 1411
##
##
## P
## x y
## x 0
## y 0# highly significant positive correlation
# TEST
# We test this hypothesis by exploiting data on DMs in terms of
# 1) elicited importance given to protected characteristics in their selection of candidates and direction of preferences (QRANK1, QRANK2)
# 2) answers to a survey on prejudice re. gender and nationality of applicants (Q7, Q8), and
# 3) perceived legitimacy of discriminating on that basis (Q9, Q10).
## H3alt Testing impact of own preferences
# We test the impact of own preferences on choices by taking into account the fit between the applicants and the deciders' ideal applicant
random2 <-plm(choice_1 ~ W_vs_M+Ita_vs_Ger+education_diff+age_diff+income_diff+interview_diff+diff_diff_ideal_applicant_gender + diff_diff_ideal_applicant_country + diff_diff_ideal_applicant_age + diff_diff_ideal_applicant_education+ diff_diff_ideal_applicant_income+ diff_diff_ideal_applicant_interview, data=subset.data.frame(data, TreatmentF=="Own"), index=c("ID", "Group"), model="random")
# We consider what is more important, fit with oneself or with ideal applicant, knowing that people prefer people like themselves usually
random3 <-plm(choice_1 ~ W_vs_M+Ita_vs_Ger+education_diff+age_diff+income_diff+interview_diff+diff_diff_ideal_applicant_gender + diff_diff_ideal_applicant_country + diff_diff_ideal_applicant_age + diff_diff_ideal_applicant_education+ diff_diff_ideal_applicant_income+ diff_diff_ideal_applicant_interview+diff_diff_applicant_gender + diff_diff_applicant_country + diff_diff_applicant_age + diff_diff_applicant_education+ diff_diff_applicant_income, data=subset.data.frame(data, TreatmentF=="Own"), index=c("ID", "Group"), model="random")
#summary(random3)
# We consider the impact of prejudice by gender and country on selection of woman and italians
random4 <-plm(choice_1 ~ W_vs_M + Ita_vs_Ger+W_vs_M:Prejudice_vs_Women+Ita_vs_Ger:Prejudice_vs_Italy+education_diff+age_diff+income_diff+interview_diff+diff_diff_ideal_applicant_gender + diff_diff_ideal_applicant_country + diff_diff_ideal_applicant_age + diff_diff_ideal_applicant_education+ diff_diff_ideal_applicant_income+ diff_diff_ideal_applicant_interview+diff_diff_applicant_gender + diff_diff_applicant_country + diff_diff_applicant_age + diff_diff_applicant_education+ diff_diff_applicant_income, data=subset.data.frame(data, TreatmentF=="Own"), index=c("ID", "Group"), model="random")
#summary(random4)
stargazer(random0,random1,random2,random3,random4, type = "text", out = "regression_choice_diff_ideal_applicant.html", no.space=TRUE, single.row=TRUE, align=TRUE, star.cutoffs = c(0.05, 0.01, 0.001),report = "vc*", header = FALSE, df=FALSE, digits=3, se = NULL)##
## ==========================================================================================
## Dependent variable:
## ------------------------------------------------------
## choice_1
## (1) (2) (3) (4) (5)
## ------------------------------------------------------------------------------------------
## W_vs_M 0.041* 0.042* 0.042* 0.042* 0.045**
## Ita_vs_Ger -0.027 -0.028 -0.024 -0.031* -0.032*
## education_diff 0.026*** 0.026** 0.026** 0.020* 0.021*
## age_diff -0.011 -0.013* -0.002 -0.003 -0.003
## income_diff 0.034*** 0.033*** 0.019** 0.014* 0.014*
## interview_diff 0.032*** 0.032*** 0.022*** 0.023*** 0.023***
## diff_diff_applicant -0.107***
## diff_diff_applicant_gender -0.003 -0.002 -0.002
## diff_diff_applicant_country -0.035*** -0.038** -0.037**
## diff_diff_applicant_age 0.009 0.052 0.052
## diff_diff_applicant_education -0.020 -0.022 -0.021
## diff_diff_applicant_income -0.028* -0.037** -0.037**
## W_vs_M:Prejudice_vs_Women -0.042
## Ita_vs_Ger:Prejudice_vs_Italy 0.006
## diff_diff_ideal_applicant_gender 0.00002 0.0001 0.001
## diff_diff_ideal_applicant_country -0.007** 0.0003 0.0002
## diff_diff_ideal_applicant_age -0.015*** -0.018*** -0.018***
## diff_diff_ideal_applicant_education -0.003 -0.003 -0.003
## diff_diff_ideal_applicant_income -0.013*** -0.014*** -0.014***
## diff_diff_ideal_applicant_interview -0.014*** -0.014*** -0.014***
## Constant 0.501*** 0.500*** 0.504*** 0.503*** 0.503***
## ------------------------------------------------------------------------------------------
## Observations 5,520 5,520 5,520 5,520 5,520
## R2 0.030 0.031 0.039 0.043 0.043
## Adjusted R2 0.029 0.030 0.037 0.040 0.040
## F Statistic 171.966*** 179.004*** 225.004*** 247.088*** 249.250***
## ==========================================================================================
## Note: *p<0.05; **p<0.01; ***p<0.001#Influence of the AI
H4: DMs are more likely to prefer an applicant if it is recommended by the AI system they are exposed to. H5: DMs are influenced in their decision in the direction of the AI system’s recommendations.
Figure 13
# 1) We test this hypothesis with a panel fixed effects regression of choice_1 and overall_grade_diff.
crosstable(data, c("choice_1"), by=c("overall_grade_diffF"), funs=c(mean,sd,N), margin="col", num_digits=4) %>%
as_flextable()label | variable | Recommendation against or for candidate 1 | |||||
|---|---|---|---|---|---|---|---|
-2 | -1 | 0 | 1 | 2 | NA | ||
Choice of candidate 1 | 0 | 546 (55.71%) | 1528 (51.76%) | 2018 (50.95%) | 1272 (47.46%) | 392 (46.72%) | 2560 |
1 | 434 (44.29%) | 1424 (48.24%) | 1943 (49.05%) | 1408 (52.54%) | 447 (53.28%) | 2960 | |
crosstable(data, c("choice_1"), by=c("overall_grade_diffF","TreatmentF"), funs=c(mean,sd,N), margin="col", num_digits=4) %>%
as_flextable()label | variable | TreatmentF=Discrim AI | TreatmentF=Fair AI | TreatmentF=Own | |||||||||||||||
|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|
overall_grade_diffF=-2 | overall_grade_diffF=-1 | overall_grade_diffF=0 | overall_grade_diffF=1 | overall_grade_diffF=2 | overall_grade_diffF=NA | overall_grade_diffF=-2 | overall_grade_diffF=-1 | overall_grade_diffF=0 | overall_grade_diffF=1 | overall_grade_diffF=2 | overall_grade_diffF=NA | overall_grade_diffF=-2 | overall_grade_diffF=-1 | overall_grade_diffF=0 | overall_grade_diffF=1 | overall_grade_diffF=2 | overall_grade_diffF=NA | ||
Choice of candidate 1 | 0 | 332 (55.99%) | 801 (52.63%) | 1008 (50.86%) | 628 (48.38%) | 159 (48.33%) | 0 (NA%) | 214 (55.30%) | 727 (50.84%) | 1010 (51.04%) | 644 (46.60%) | 233 (45.69%) | 0 (NA%) | 0 (NA%) | 0 (NA%) | 0 (NA%) | 0 (NA%) | 0 (NA%) | 2560 (46.38%) |
1 | 261 (44.01%) | 721 (47.37%) | 974 (49.14%) | 670 (51.62%) | 170 (51.67%) | 0 (NA%) | 173 (44.70%) | 703 (49.16%) | 969 (48.96%) | 738 (53.40%) | 277 (54.31%) | 0 (NA%) | 0 (NA%) | 0 (NA%) | 0 (NA%) | 0 (NA%) | 0 (NA%) | 2960 (53.62%) | |
# regressions
# set of regressors
#regressor1 <- "choice_1~overall_grade_diff"
regressor1 <- "choice_1~overall_grade_diff+W_vs_M+Ita_vs_Ger+education_diff+age_diff+income_diff+interview_diff"
random1 <-plm(as.formula(regressor1), data=subset.data.frame(data, TreatmentF!="Own"), index=c("ID", "Group"), model="random")
#summary(random1)
# fixed <-plm(choice_1 ~ overall_grade_diffF*TreatmentF, data=subset.data.frame(data, TreatmentF!="Own"), index=c("ID", "Group"), model="random")
# summary(fixed)
# phtest(fixed,random1)
random1Fair <-plm(as.formula(regressor1), data=subset.data.frame(data, TreatmentF=="Fair AI"), index=c("ID", "Group"), model="random")
random1Unfair <-plm(as.formula(regressor1), data=subset.data.frame(data, TreatmentF=="Discrim AI"), index=c("ID", "Group"), model="random")
#regressor2 <- "choice_1~overall_grade_diff+ gender_grade_diff+country_grade_diff+education_grade_diff+age_grade_diff+income_grade_diff+interview_grade_diff"
regressor2 <- "choice_1~overall_grade_diff+ gender_grade_diff+country_grade_diff+education_grade_diff+age_grade_diff+income_grade_diff+interview_grade_diff+W_vs_M+Ita_vs_Ger+education_diff+age_diff+income_diff+interview_diff"
random2 <-plm(as.formula(regressor2), data=subset.data.frame(data, TreatmentF!="Own"), index=c("ID", "Group"), model="random")
random2Fair <-plm(as.formula(regressor2), data=subset.data.frame(data, TreatmentF=="Fair AI"), index=c("ID", "Group"), model="random")
random2Unfair <-plm(as.formula(regressor2), data=subset.data.frame(data, TreatmentF=="Discrim AI"), index=c("ID", "Group"), model="random")
stargazer(random1,random1Fair,random1Unfair, type = "text", out = "regression_influence_AI_H5.html", no.space=TRUE, single.row=TRUE, align=TRUE, star.cutoffs = c(0.05, 0.01, 0.001),report = "vc*", header = FALSE, df=FALSE, digits=3, se = NULL)##
## ===================================================
## Dependent variable:
## --------------------------------
## regressor1
## (1) (2) (3)
## ---------------------------------------------------
## overall_grade_diff 0.021*** 0.022*** 0.019**
## W_vs_M 0.006 0.006 0.011
## Ita_vs_Ger -0.024* -0.006 -0.046**
## education_diff 0.025*** 0.038*** 0.012
## age_diff -0.027*** -0.034*** -0.019**
## income_diff 0.040*** 0.036*** 0.044***
## interview_diff 0.021*** 0.022*** 0.019***
## Constant 0.481*** 0.492*** 0.465***
## ---------------------------------------------------
## Observations 11,412 5,688 5,724
## R2 0.027 0.031 0.026
## Adjusted R2 0.027 0.030 0.024
## F Statistic 320.251*** 183.730*** 150.666***
## ===================================================
## Note: *p<0.05; **p<0.01; ***p<0.001stargazer(random2,random2Fair,random2Unfair, type = "text", out = "regression_influence_AI_H5.html", no.space=TRUE, single.row=TRUE, align=TRUE, star.cutoffs = c(0.05, 0.01, 0.001),report = "vc*", header = FALSE, df=FALSE, digits=3, se = NULL)##
## =====================================================
## Dependent variable:
## --------------------------------
## regressor2
## (1) (2) (3)
## -----------------------------------------------------
## overall_grade_diff 0.014** 0.011 0.017**
## gender_grade_diff 0.005 -0.002
## country_grade_diff 0.017 0.015
## education_grade_diff 0.010*** 0.014*** 0.004
## age_grade_diff 0.005 0.005 0.003
## income_grade_diff 0.018*** 0.016*** 0.022***
## interview_grade_diff 0.012*** 0.016*** 0.009*
## W_vs_M 0.012 0.001
## Ita_vs_Ger -0.010 0.010 -0.036*
## education_diff 0.017** 0.026** 0.008
## age_diff -0.026*** -0.032*** -0.021**
## income_diff 0.006 0.005 0.003
## interview_diff 0.016*** 0.011* 0.019***
## Constant 0.487*** 0.501*** 0.469***
## -----------------------------------------------------
## Observations 11,412 5,688 5,724
## R2 0.034 0.041 0.030
## Adjusted R2 0.032 0.039 0.027
## F Statistic 395.362*** 240.760*** 173.827***
## =====================================================
## Note: *p<0.05; **p<0.01; ***p<0.001plot1<-plot_summs(random1,random1Fair, random1Unfair, random2,random2Fair, random2Unfair, model.names = c("Overall", "Fair", "Unfair", "Overall 2", "Fair 2", "Unfair 2"), coefs = c("Overall grade"="overall_grade_diff", "Gender grade" = "gender_grade_diff", "Country grade" = "country_grade_diff", "Education grade" = "education_grade_diff", "Age grade" = "age_grade_diff", "Income grade" = "income_grade_diff", "Interview grade" = "interview_grade_diff"))
plot2<-plot_summs(random1,random1Fair, random1Unfair, random2,random2Fair, random2Unfair, model.names = c("Overall", "Fair", "Unfair", "Overall 2", "Fair 2", "Unfair 2"), coefs = c("Female" = "W_vs_M", "Italian" = "Ita_vs_Ger", "More Education" = "education_diff", "Older" = "age_diff", "Richer" = "income_diff", "Interview" = "interview_diff"))
library(ggpubr)##
## Attaching package: 'ggpubr'## The following object is masked from 'package:expss':
##
## compare_means## The following objects are masked from 'package:flextable':
##
## border, font, rotate
ggsave("Influence_AI_grade_control_bis.png", figure, width = 10, height = 6, dpi = 300)
plot1<-plot_summs(random1, random2, model.names = c("Overall", "Overall 2"), coefs = c("Overall grade"="overall_grade_diff", "Gender grade" = "gender_grade_diff", "Country grade" = "country_grade_diff", "Education grade" = "education_grade_diff", "Age grade" = "age_grade_diff", "Income grade" = "income_grade_diff", "Interview grade" = "interview_grade_diff"))
plot2<-plot_summs(random1, random2, model.names = c("Overall", "Overall 2"), coefs = c("Female" = "W_vs_M", "Italian" = "Ita_vs_Ger", "More Education" = "education_diff", "Older" = "age_diff", "Richer" = "income_diff", "Interview" = "interview_diff"))
figure <- ggarrange(plot1,plot2,
labels = "",
ncol = 1, nrow = 2)
figure
H6: 1) DMs who receive advice from a discriminatory AI make decisions that move in the direction of discrimination suggested by the discriminatory AI, as compared to DMs who receive no advice 2) DM who receive advice from a fair AI discriminate less than DMs who receive no advice.
Figure 14
#1) A first test of this hypothesis is by comparing the rates at which applicants with different protected characteristics (gender, nationality) are selected under our three treatments.
random1 <-plm(choice_1 ~ (W_vs_M+Ita_vs_Ger)*TreatmentF, data=data, index=c("ID", "Group"), model="random")
#summary(random1)
#The baseline treatment is the treatment without AI.
# Fair AI reduces discrimination in favor of women, reduces also discrimination against Italians, but not significantly so
# Unfair AI reduces discrimination against men, but not significantlw so, even though does recommend men. No effect re. country, even though recommends Germans.
# looking now at diff between AIs
#data$TreatmentF
#!!!(change baseline rather)
data <- within(data, Treatment2 <- relevel(TreatmentF, ref = "Fair AI"))
random2 <-plm(choice_1 ~ (W_vs_M+Ita_vs_Ger)*Treatment2, data=data, index=c("ID", "Group"), model="random")
#summary(random2)
# here we see that discrim AI does have a significant effect in increasing discrimination against Italians vs. the fair AI.
#plot_summs(random1, random2)
#H6.1) We expect to find a difference in the direction of what the unfair AI recommends in the parameters on W_vs_M and country diff between the unfair AI and the treatment with decider on his/her own. E.g. if the AI favors women, and deciders on their own favor men, then the decider with AI will favor men less.
#H6.2) We expect to find that the parameter on W_vs_M and country diff is closer to 0 under the fair AI than when the decider is on his/her own.
#FINDING
# what we find is the fair AI treatment reduces discrimination in favor of women. The unfair AI treatment also does so, but NS, and for a different reason (ie the AI favors men). The fair AI does not significantly reduce discrimination against Italians.
random3 <-plm(choice_1 ~ (W_vs_M+Ita_vs_Ger+education_diff+age_diff+income_diff+interview_diff)*TreatmentF, data=data, index=c("ID", "Group"), model="random")
#summary(random3)
random4 <-plm(choice_1 ~ (W_vs_M+Ita_vs_Ger+education_diff+age_diff+income_diff+interview_diff)*Treatment2, data=data, index=c("ID", "Group"), model="random")
#summary(random4)
stargazer(random1,random3, type = "text", out = "regression_influence_AI_H6.html", no.space=TRUE, single.row=TRUE, align=TRUE, star.cutoffs = c(0.05, 0.01, 0.001),report = "vc*", header = FALSE, df=FALSE, digits=3, se = NULL)##
## ==================================================================
## Dependent variable:
## ------------------------------
## choice_1
## (1) (2)
## ------------------------------------------------------------------
## W_vs_M 0.054** 0.042*
## Ita_vs_Ger -0.057*** -0.028
## education_diff 0.032***
## age_diff -0.012*
## income_diff 0.036***
## interview_diff 0.032***
## TreatmentFDiscrim AI -0.039 -0.036
## TreatmentFFair AI 0.0003 -0.006
## W_vs_M:TreatmentFDiscrim AI -0.033 -0.032
## W_vs_M:TreatmentFFair AI -0.049* -0.038
## Ita_vs_Ger:TreatmentFDiscrim AI -0.012 -0.016
## Ita_vs_Ger:TreatmentFFair AI 0.022 0.024
## education_diff:TreatmentFDiscrim AI -0.019
## education_diff:TreatmentFFair AI 0.006
## age_diff:TreatmentFDiscrim AI -0.010
## age_diff:TreatmentFFair AI -0.022*
## income_diff:TreatmentFDiscrim AI 0.009
## income_diff:TreatmentFFair AI 0.001
## interview_diff:TreatmentFDiscrim AI -0.013*
## interview_diff:TreatmentFFair AI -0.011
## Constant 0.489*** 0.501***
## ------------------------------------------------------------------
## Observations 16,932 16,932
## R2 0.004 0.028
## Adjusted R2 0.004 0.026
## F Statistic 74.799*** 480.570***
## ==================================================================
## Note: *p<0.05; **p<0.01; ***p<0.001random5 <-plm(choice_1 ~ (W_vs_M+Ita_vs_Ger)*TreatmentF*CountryF, data=data, index=c("ID", "Group"), model="random")
#summary(random5)
random6 <-plm(choice_1 ~ (W_vs_M+Ita_vs_Ger)*TreatmentF*SectorF, data=data, index=c("ID", "Group"), model="random")
#summary(random6)
random7 <-plm(choice_1 ~ (W_vs_M+Ita_vs_Ger)*TreatmentF*gender_decF, data=data, index=c("ID", "Group"), model="random")
#summary(random7)
# significant effect in HR for both gender and country, not so in banking
# by gender, discrimAI induces men to favor men more, but opposite for women
# significant effect in HR for both gender and country, not so in banking
# graph
random5 <-plm(choice_1 ~ (W_vs_M+Ita_vs_Ger+education_diff+age_diff+income_diff+interview_diff)*TreatmentF, data=data, index=c("ID", "Group"), model="random")
#summary(random5)
p <- avg_predictions(random5, by = c("W_vs_M","TreatmentF"))
p## Warning in mode(current): NAs introduced by coercion to integer rangeW_vs_M | TreatmentF | estimate | std.error | statistic | p.value | s.value | conf.low | conf.high |
|---|---|---|---|---|---|---|---|---|
numeric | factor | numeric | numeric | numeric | numeric | numeric | numeric | numeric |
-1 | Own | 0.5 | 0.0 | 15.1 | 0 | 168.8 | 0.4 | 0.5 |
-1 | Discrim AI | 0.5 | 0.0 | 14.2 | 0 | 150.1 | 0.4 | 0.5 |
-1 | Fair AI | 0.5 | 0.0 | 18.0 | 0 | 237.7 | 0.4 | 0.5 |
0 | Own | 0.5 | 0.0 | 49.9 | 0 | Inf | 0.5 | 0.6 |
0 | Discrim AI | 0.5 | 0.0 | 48.6 | 0 | Inf | 0.5 | 0.5 |
0 | Fair AI | 0.5 | 0.0 | 47.6 | 0 | Inf | 0.5 | 0.5 |
1 | Own | 0.5 | 0.0 | 48.1 | 0 | Inf | 0.5 | 0.6 |
1 | Discrim AI | 0.5 | 0.0 | 41.9 | 0 | Inf | 0.4 | 0.5 |
1 | Fair AI | 0.5 | 0.0 | 46.4 | 0 | Inf | 0.5 | 0.5 |
n: 9 | ||||||||
plot1<-ggplot(subset(p, W_vs_M==1), aes(x = "", y = estimate, ymin = conf.low, ymax = conf.high, colour=TreatmentF)) + geom_pointrange(position = position_dodge(width=0.2)) + theme_classic() + xlab("") + ylab("% women chosen") + ggtitle("% women chosen in mixed gender pairs") + scale_y_continuous(breaks=seq(0.3,0.6,0.01), labels = scales::percent) + coord_cartesian(ylim = c(0.35, 0.58))
plot1
## Warning in mode(current): NAs introduced by coercion to integer rangeIta_vs_Ger | TreatmentF | estimate | std.error | statistic | p.value | s.value | conf.low | conf.high |
|---|---|---|---|---|---|---|---|---|
numeric | factor | numeric | numeric | numeric | numeric | numeric | numeric | numeric |
-1 | Own | 0.5 | 0.0 | 50.1 | 0 | Inf | 0.5 | 0.6 |
-1 | Discrim AI | 0.5 | 0.0 | 49.0 | 0 | Inf | 0.5 | 0.5 |
-1 | Fair AI | 0.5 | 0.0 | 45.7 | 0 | Inf | 0.5 | 0.5 |
0 | Own | 0.5 | 0.0 | 52.6 | 0 | Inf | 0.5 | 0.6 |
0 | Discrim AI | 0.5 | 0.0 | 46.5 | 0 | Inf | 0.4 | 0.5 |
0 | Fair AI | 0.5 | 0.0 | 50.7 | 0 | Inf | 0.5 | 0.5 |
1 | Own | 0.5 | 0.0 | 26.7 | 0 | 518.8 | 0.4 | 0.5 |
1 | Discrim AI | 0.4 | 0.0 | 22.0 | 0 | 355.3 | 0.4 | 0.4 |
1 | Fair AI | 0.5 | 0.0 | 24.4 | 0 | 435.8 | 0.4 | 0.5 |
n: 9 | ||||||||
plot2<-ggplot(subset(p, Ita_vs_Ger==1), aes(x = "", y = estimate, ymin = conf.low, ymax = conf.high, colour=TreatmentF)) + geom_pointrange(position = position_dodge(width=0.2)) + theme_classic() + xlab("") + ylab("% Italian chosen") + ggtitle("% Italian chosen in mixed country pairs") + scale_y_continuous(breaks=seq(0.3,0.6,0.01), labels = scales::percent) + coord_cartesian(ylim = c(0.35, 0.58))
plot2
H6 by gender of decider
Figure 15
random6 <-plm(choice_1 ~ (W_vs_M+Ita_vs_Ger+education_diff+age_diff+income_diff+interview_diff)*TreatmentF*gender_decF, data=data, index=c("ID", "Group"), model="random")
#summary(random6)
p <- avg_predictions(random6, by = c("W_vs_M","gender_decF","TreatmentF"))
pW_vs_M | gender_decF | TreatmentF | estimate | std.error | statistic | p.value | s.value | conf.low | conf.high |
|---|---|---|---|---|---|---|---|---|---|
numeric | factor | factor | numeric | numeric | numeric | numeric | numeric | numeric | numeric |
-1 | Male | Own | 0.5 | 0.0 | 11.2 | 0 | 93.7 | 0.4 | 0.6 |
-1 | Male | Discrim AI | 0.5 | 0.0 | 10.5 | 0 | 82.9 | 0.4 | 0.6 |
-1 | Male | Fair AI | 0.5 | 0.0 | 12.4 | 0 | 115.0 | 0.4 | 0.6 |
-1 | Female | Own | 0.5 | 0.0 | 10.3 | 0 | 80.1 | 0.4 | 0.5 |
-1 | Female | Discrim AI | 0.5 | 0.0 | 9.6 | 0 | 70.1 | 0.4 | 0.5 |
-1 | Female | Fair AI | 0.5 | 0.0 | 13.1 | 0 | 127.1 | 0.4 | 0.6 |
0 | Male | Own | 0.5 | 0.0 | 35.5 | 0 | 912.9 | 0.5 | 0.6 |
0 | Male | Discrim AI | 0.5 | 0.0 | 34.7 | 0 | 876.1 | 0.5 | 0.5 |
0 | Male | Fair AI | 0.5 | 0.0 | 34.2 | 0 | 847.9 | 0.5 | 0.6 |
0 | Female | Own | 0.5 | 0.0 | 35.0 | 0 | 887.3 | 0.5 | 0.6 |
0 | Female | Discrim AI | 0.5 | 0.0 | 33.9 | 0 | 832.2 | 0.5 | 0.5 |
0 | Female | Fair AI | 0.5 | 0.0 | 33.0 | 0 | 791.6 | 0.5 | 0.5 |
n: 18 | |||||||||
figure<-ggplot(subset(p, W_vs_M==1), aes(x = "", y = estimate, ymin = conf.low, ymax = conf.high, colour=TreatmentF)) + geom_pointrange(position = position_dodge(width=0.2)) + theme_classic() + xlab("") + ylab("% women chosen") + ggtitle("% women chosen in mixed gender pairs \n (Depending on gender of the decider)") + facet_grid(.~gender_decF) + scale_y_continuous(breaks=seq(0.3,0.6,0.01), labels = scales::percent) + coord_cartesian(ylim = c(0.35, 0.6))
figure
H6 by country of decider
Figure 16
random6 <-plm(choice_1 ~ (W_vs_M+Ita_vs_Ger+education_diff+age_diff+income_diff+interview_diff)*TreatmentF*CountryF, data=data, index=c("ID", "Group"), model="random")
#summary(random6)
p <- avg_predictions(random6, by = c("Ita_vs_Ger","CountryF","TreatmentF"))
p## Warning in mode(current): NAs introduced by coercion to integer rangeIta_vs_Ger | CountryF | TreatmentF | estimate | std.error | statistic | p.value | s.value | conf.low | conf.high |
|---|---|---|---|---|---|---|---|---|---|
numeric | factor | factor | numeric | numeric | numeric | numeric | numeric | numeric | numeric |
-1 | Germany | Own | 0.6 | 0.0 | 38.3 | 0 | Inf | 0.6 | 0.6 |
-1 | Germany | Discrim AI | 0.5 | 0.0 | 36.6 | 0 | 972.3 | 0.5 | 0.6 |
-1 | Germany | Fair AI | 0.6 | 0.0 | 35.4 | 0 | 907.2 | 0.5 | 0.6 |
-1 | Italy | Own | 0.5 | 0.0 | 32.9 | 0 | 784.1 | 0.5 | 0.5 |
-1 | Italy | Discrim AI | 0.5 | 0.0 | 33.0 | 0 | 790.4 | 0.5 | 0.5 |
-1 | Italy | Fair AI | 0.5 | 0.0 | 29.6 | 0 | 636.0 | 0.4 | 0.5 |
0 | Germany | Own | 0.5 | 0.0 | 37.9 | 0 | Inf | 0.5 | 0.6 |
0 | Germany | Discrim AI | 0.5 | 0.0 | 34.4 | 0 | 860.7 | 0.5 | 0.5 |
0 | Germany | Fair AI | 0.5 | 0.0 | 36.4 | 0 | 960.4 | 0.5 | 0.5 |
0 | Italy | Own | 0.5 | 0.0 | 36.8 | 0 | 981.5 | 0.5 | 0.6 |
0 | Italy | Discrim AI | 0.5 | 0.0 | 31.7 | 0 | 728.1 | 0.4 | 0.5 |
0 | Italy | Fair AI | 0.5 | 0.0 | 35.6 | 0 | 920.1 | 0.5 | 0.5 |
n: 18 | |||||||||
figure<-ggplot(subset(p, Ita_vs_Ger==1), aes(x = "", y = estimate, ymin = conf.low, ymax = conf.high, colour=TreatmentF)) + geom_pointrange(position = position_dodge(width=0.2)) + theme_classic() + xlab("") + ylab("% Italian chosen") + ggtitle("% Italian chosen in mixed country pairs \n (Depending on country of the decider)")+ facet_grid(.~CountryF) + scale_y_continuous(breaks=seq(0.3,0.6,0.01), labels = scales::percent) + coord_cartesian(ylim = c(0.35, 0.6))
figure
ggsave("Country_discrim_by_AI.png", figure, width = 10, height = 6, dpi = 300)
random7 <-plm(choice_1 ~ (W_vs_M+Ita_vs_Ger)*TreatmentF*SectorF, data=data, index=c("ID", "Group"), model="random")
#summary(random7)
p <- avg_predictions(random7, by = c("Ita_vs_Ger","SectorF","TreatmentF"))
pIta_vs_Ger | SectorF | TreatmentF | estimate | std.error | statistic | p.value | s.value | conf.low | conf.high |
|---|---|---|---|---|---|---|---|---|---|
numeric | factor | factor | numeric | numeric | numeric | numeric | numeric | numeric | numeric |
-1 | HR | Own | 0.5 | 0.0 | 34.1 | 0 | 843.5 | 0.5 | 0.6 |
-1 | HR | Discrim AI | 0.5 | 0.0 | 32.1 | 0 | 749.9 | 0.5 | 0.5 |
-1 | HR | Fair AI | 0.5 | 0.0 | 32.9 | 0 | 786.4 | 0.5 | 0.6 |
-1 | Banking | Own | 0.6 | 0.0 | 35.6 | 0 | 918.2 | 0.5 | 0.6 |
-1 | Banking | Discrim AI | 0.5 | 0.0 | 36.1 | 0 | 946.3 | 0.5 | 0.6 |
-1 | Banking | Fair AI | 0.5 | 0.0 | 30.7 | 0 | 684.9 | 0.5 | 0.5 |
0 | HR | Own | 0.5 | 0.0 | 37.1 | 0 | 999.1 | 0.5 | 0.6 |
0 | HR | Discrim AI | 0.5 | 0.0 | 32.0 | 0 | 743.6 | 0.4 | 0.5 |
0 | HR | Fair AI | 0.5 | 0.0 | 35.4 | 0 | 908.7 | 0.5 | 0.5 |
0 | Banking | Own | 0.5 | 0.0 | 36.1 | 0 | 947.5 | 0.5 | 0.6 |
0 | Banking | Discrim AI | 0.5 | 0.0 | 32.5 | 0 | 765.6 | 0.4 | 0.5 |
0 | Banking | Fair AI | 0.5 | 0.0 | 34.9 | 0 | 884.3 | 0.5 | 0.5 |
n: 18 | |||||||||
ggplot(subset(p, Ita_vs_Ger==1), aes(x = "", y = estimate, ymin = conf.low, ymax = conf.high, colour=TreatmentF)) + geom_pointrange(position = position_dodge(width=0.2)) + theme_classic() + xlab("") + ylab("% Italian chosen") + ggtitle("% Italian chosen in mixed country pairs \n (Depending on country of the decider)")+ facet_grid(.~SectorF)
W_vs_M | SectorF | TreatmentF | estimate | std.error | statistic | p.value | s.value | conf.low | conf.high |
|---|---|---|---|---|---|---|---|---|---|
numeric | factor | factor | numeric | numeric | numeric | numeric | numeric | numeric | numeric |
-1 | HR | Own | 0.4 | 0.0 | 9.9 | 0 | 73.9 | 0.3 | 0.5 |
-1 | HR | Discrim AI | 0.4 | 0.0 | 8.4 | 0 | 54.5 | 0.3 | 0.5 |
-1 | HR | Fair AI | 0.5 | 0.0 | 13.7 | 0 | 138.5 | 0.5 | 0.6 |
-1 | Banking | Own | 0.4 | 0.0 | 9.0 | 0 | 61.8 | 0.3 | 0.5 |
-1 | Banking | Discrim AI | 0.5 | 0.1 | 8.5 | 0 | 56.1 | 0.4 | 0.6 |
-1 | Banking | Fair AI | 0.4 | 0.0 | 11.0 | 0 | 91.0 | 0.4 | 0.5 |
0 | HR | Own | 0.5 | 0.0 | 34.6 | 0 | 870.4 | 0.5 | 0.6 |
0 | HR | Discrim AI | 0.5 | 0.0 | 32.1 | 0 | 750.1 | 0.5 | 0.5 |
0 | HR | Fair AI | 0.5 | 0.0 | 34.9 | 0 | 885.3 | 0.5 | 0.6 |
0 | Banking | Own | 0.5 | 0.0 | 35.1 | 0 | 894.1 | 0.5 | 0.6 |
0 | Banking | Discrim AI | 0.5 | 0.0 | 35.7 | 0 | 924.5 | 0.5 | 0.6 |
0 | Banking | Fair AI | 0.5 | 0.0 | 31.8 | 0 | 732.5 | 0.5 | 0.5 |
n: 18 | |||||||||
ggplot(subset(p, W_vs_M==1), aes(x = "", y = estimate, ymin = conf.low, ymax = conf.high, colour=TreatmentF)) + geom_pointrange(position = position_dodge(width=0.2)) + theme_classic() + xlab("") + ylab("% Italian chosen") + ggtitle("% Women chosen in mixed gender pairs \n (Depending on sector of the decider)")+ facet_grid(.~SectorF)
H7A: DMs are more likely to follow recommendations from a fair AI than from a discriminatory AI
Figure 12
#
data %>%
group_by(ID, overall_grade_diffF, TreatmentF) %>%
summarise(mean_choice_1 = mean(choice_1, na.rm = TRUE)) -> dataID## `summarise()` has grouped output by 'ID', 'overall_grade_diffF'. You can
## override using the `.groups` argument.ID | overall_grade_diffF | TreatmentF | mean_choice_1 |
|---|---|---|---|
integer | labelled | factor | numeric |
1 | -2 | Fair AI | 0.0 |
1 | -1 | Fair AI | 0.5 |
1 | 0 | Fair AI | 0.8 |
1 | 1 | Fair AI | 0.3 |
1 | 2 | Fair AI | 0.0 |
2 | Own | 0.8 | |
3 | -2 | Discrim AI | 0.0 |
3 | -1 | Discrim AI | 0.6 |
3 | 0 | Discrim AI | 0.0 |
3 | 1 | Discrim AI | 0.0 |
3 | 2 | Discrim AI | 1.0 |
4 | -2 | Fair AI | 0.0 |
n: 4497 | |||
crosstable(dataID, c("mean_choice_1"), by=c("overall_grade_diffF",TreatmentF), funs=c(meansd,N), margin="col", num_digits=4) %>%
as_flextable()label | variable | TreatmentF=Discrim AI | TreatmentF=Fair AI | TreatmentF=Own | |||||||||||||||
|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|
overall_grade_diffF=-2 | overall_grade_diffF=-1 | overall_grade_diffF=0 | overall_grade_diffF=1 | overall_grade_diffF=2 | overall_grade_diffF=NA | overall_grade_diffF=-2 | overall_grade_diffF=-1 | overall_grade_diffF=0 | overall_grade_diffF=1 | overall_grade_diffF=2 | overall_grade_diffF=NA | overall_grade_diffF=-2 | overall_grade_diffF=-1 | overall_grade_diffF=0 | overall_grade_diffF=1 | overall_grade_diffF=2 | overall_grade_diffF=NA | ||
mean_choice_1 | meansd | 0.4335 (0.4416) | 0.4724 (0.3342) | 0.4885 (0.2961) | 0.4979 (0.3587) | 0.5201 (0.4779) | NA (NA) | 0.4607 (0.4683) | 0.4951 (0.3296) | 0.4824 (0.2798) | 0.5318 (0.3460) | 0.5480 (0.4425) | NA (NA) | NA (NA) | NA (NA) | NA (NA) | NA (NA) | NA (NA) | 0.5362 (0.1998) |
N | 347 | 459 | 477 | 463 | 274 | 0 | 280 | 474 | 463 | 467 | 333 | 0 | 0 | 0 | 0 | 0 | 0 | 460 | |
lm <-lm(mean_choice_1 ~ overall_grade_diffF*TreatmentF, data=dataID)
#summary(lm)
plot<-plot_predictions(lm, condition = c("overall_grade_diffF","TreatmentF"), draw=TRUE) + theme_bw() + xlab("AI strength of recommendation for candidate 1") + ylab("% candidate 1 chosen") + ggtitle("Influence of the AI") + scale_y_continuous(breaks=seq(0.4,0.6,0.01), labels = scales::percent)
plot
ggsave("AI_influence.png", plot, width = 10, height = 6, dpi = 300)
data %>%
group_by(ID, overall_grade_diffF, TreatmentF, SectorF) %>%
summarise(mean_choice_1 = mean(choice_1, na.rm = TRUE)) -> dataID## `summarise()` has grouped output by 'ID', 'overall_grade_diffF', 'TreatmentF'.
## You can override using the `.groups` argument.ID | overall_grade_diffF | TreatmentF | SectorF | mean_choice_1 |
|---|---|---|---|---|
integer | labelled | factor | factor | numeric |
1 | -2 | Fair AI | Banking | 0.0 |
1 | -1 | Fair AI | Banking | 0.5 |
1 | 0 | Fair AI | Banking | 0.8 |
1 | 1 | Fair AI | Banking | 0.3 |
1 | 2 | Fair AI | Banking | 0.0 |
2 | Own | Banking | 0.8 | |
3 | -2 | Discrim AI | Banking | 0.0 |
3 | -1 | Discrim AI | Banking | 0.6 |
3 | 0 | Discrim AI | Banking | 0.0 |
3 | 1 | Discrim AI | Banking | 0.0 |
3 | 2 | Discrim AI | Banking | 1.0 |
4 | -2 | Fair AI | Banking | 0.0 |
n: 4497 | ||||
crosstable(dataID, c("mean_choice_1"), by=c("overall_grade_diffF",TreatmentF,SectorF), funs=c(meansd,N), margin="col", num_digits=4) %>%
as_flextable()label | variable | SectorF=Banking | SectorF=HR | ||||||||||||||||||||||||||||||||||
|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|
TreatmentF=Discrim AI | TreatmentF=Fair AI | TreatmentF=Own | TreatmentF=Discrim AI | TreatmentF=Fair AI | TreatmentF=Own | ||||||||||||||||||||||||||||||||
overall_grade_diffF=-2 | overall_grade_diffF=-1 | overall_grade_diffF=0 | overall_grade_diffF=1 | overall_grade_diffF=2 | overall_grade_diffF=NA | overall_grade_diffF=-2 | overall_grade_diffF=-1 | overall_grade_diffF=0 | overall_grade_diffF=1 | overall_grade_diffF=2 | overall_grade_diffF=NA | overall_grade_diffF=-2 | overall_grade_diffF=-1 | overall_grade_diffF=0 | overall_grade_diffF=1 | overall_grade_diffF=2 | overall_grade_diffF=NA | overall_grade_diffF=-2 | overall_grade_diffF=-1 | overall_grade_diffF=0 | overall_grade_diffF=1 | overall_grade_diffF=2 | overall_grade_diffF=NA | overall_grade_diffF=-2 | overall_grade_diffF=-1 | overall_grade_diffF=0 | overall_grade_diffF=1 | overall_grade_diffF=2 | overall_grade_diffF=NA | overall_grade_diffF=-2 | overall_grade_diffF=-1 | overall_grade_diffF=0 | overall_grade_diffF=1 | overall_grade_diffF=2 | overall_grade_diffF=NA | ||
mean_choice_1 | meansd | 0.4196 (0.4446) | 0.4872 (0.3518) | 0.5053 (0.2958) | 0.4925 (0.3594) | 0.5294 (0.4683) | NA (NA) | 0.4458 (0.4447) | 0.4920 (0.3171) | 0.4769 (0.2892) | 0.4787 (0.3449) | 0.5126 (0.4632) | NA (NA) | NA (NA) | NA (NA) | NA (NA) | NA (NA) | NA (NA) | 0.5393 (0.1903) | 0.4468 (0.4397) | 0.4573 (0.3153) | 0.4714 (0.2961) | 0.5038 (0.3585) | 0.5083 (0.4915) | NA (NA) | 0.4825 (0.5019) | 0.4982 (0.3424) | 0.4876 (0.2710) | 0.5875 (0.3391) | 0.5754 (0.4251) | NA (NA) | NA (NA) | NA (NA) | NA (NA) | NA (NA) | NA (NA) | 0.5333 (0.2089) |
N | 170 | 232 | 241 | 241 | 153 | 0 | 166 | 239 | 228 | 239 | 145 | 0 | 0 | 0 | 0 | 0 | 0 | 225 | 177 | 227 | 236 | 222 | 121 | 0 | 114 | 235 | 235 | 228 | 188 | 0 | 0 | 0 | 0 | 0 | 0 | 235 | |
lm <-lm(mean_choice_1 ~ overall_grade_diffF*TreatmentF*SectorF, data=dataID)
#summary(lm)
plot<-plot_predictions(lm, condition = c("overall_grade_diffF","TreatmentF","SectorF"), draw=TRUE) + theme_bw() + xlab("AI strength of recommendation for candidate 1") + ylab("% candidate 1 chosen") + ggtitle("Influence of the AI") + scale_y_continuous(breaks=seq(0.3,0.65,0.01), labels = scales::percent) + coord_cartesian(ylim = c(0.35, 0.65))
plot
Interaction between AI and DMs preferences
H7B: DMs are less positive in their attitude to unfair AI than to fair AI.
Table 16
# We test B by relying on answers to AIRelied (relying on AI), AIUnderstood (Understood AI), AIFair (AI was fair) and AIAccurate (AI was accurate), with a specific focus on AIRelied and AIFair (we expect less of an effect for the other two questions).
datax<-subset.data.frame(data,Group==1)
lm1 <- with(datax,lm(AIRelied~as.factor(TreatmentF):SectorF+gender_decF+country_decF+SectorF))
lm2 <- with(datax,lm(AIUnderstood~as.factor(TreatmentF):SectorF+gender_decF+country_decF+SectorF))
lm3 <- with(datax,lm(AIFair~as.factor(TreatmentF):SectorF+gender_decF+country_decF+SectorF))
lm4 <- with(datax,lm(AIAccurate~as.factor(TreatmentF):SectorF+gender_decF+country_decF+SectorF))
stargazer(lm1,lm2,lm3,lm4, type = "text", out = "reliance_AI.html", no.space=TRUE, single.row=TRUE, align=TRUE, star.cutoffs = c(0.05, 0.01, 0.001),report = "vc*", header = FALSE, df=FALSE, digits=3, se = NULL)##
## =======================================================================================
## Dependent variable:
## -------------------------------------------
## AIRelied AIUnderstood AIFair AIAccurate
## (1) (2) (3) (4)
## ---------------------------------------------------------------------------------------
## gender_decFFemale -0.188** -0.142* -0.196*** -0.184**
## country_decFItaly -0.052 0.076 -0.012 0.051
## SectorFBanking -0.297*** -0.315*** -0.259** -0.258**
## as.factor(TreatmentF)Fair AI:SectorFHR 0.080 0.016 0.141 0.115
## as.factor(TreatmentF)Fair AI:SectorFBanking 0.109 -0.017 0.030 0.028
## Constant 2.915*** 3.146*** 3.068*** 3.052***
## ---------------------------------------------------------------------------------------
## Observations 951 951 951 951
## R2 0.037 0.043 0.043 0.040
## Adjusted R2 0.032 0.038 0.038 0.035
## Residual Std. Error 0.910 0.870 0.904 0.897
## F Statistic 7.277*** 8.518*** 8.514*** 7.871***
## =======================================================================================
## Note: *p<0.05; **p<0.01; ***p<0.001# we find more reliance, not more understanding, higher rating of fairness, and higher perception of accuracy. But none of those effects are significant.
#We also run SUR (Seemingly unrelated regressions) to exploit cross-correlation in those answers. We expect higher values for all dependent variables in the fair AI treatment.
#data$TreatmentF
data$FairAI<-(data$TreatmentF=="Fair AI")
eq11<-AIRelied~FairAI
eq12<-AIUnderstood~FairAI
eq13<-AIFair~FairAI
eq14<-AIAccurate~FairAI
system<-list(f11 = eq11, f12 = eq12, f13 = eq13, f14 = eq14)
fitsur1 <- systemfit(system, data=subset.data.frame(data,Group==1&TreatmentF!="Own"))
#summary(fitsur1)
## perform SUR on each of the equations in the system
eq11<-AIRelied~FairAI+gender_dec+country_dec+SectorF
eq12<-AIUnderstood~FairAI+gender_dec+country_dec+SectorF
eq13<-AIFair~FairAI+gender_dec+country_dec+SectorF
eq14<-AIAccurate~FairAI+gender_dec+country_dec+SectorF
system<-list(f11 = eq11, f12 = eq12, f13 = eq13, f14 = eq14)
fitsur2 <- systemfit(system, data=subset.data.frame(data, Group==1))
#summary(fitsur2)
# we find however systematically lower ratings in banking sector, and by female decision makers. To be maybe correlated with experience with AI?H8: A) DMs that express low levels of discriminatory preferences and prejudice, and more concern for fairness are more likely to follow recommendations from a fair AI than from a discriminatory AI, and B) are less positive in their attitude to unfair AI than to fair AI.
Table 17
# This hypothesis specializes H7 by saying that it holds in particular for DMs who are less discriminatory, prejudiced, and more concerned about fairness. In other words, it says that H7 can be explained to some extent by DMs preferences and attitudes.
# We test A by comparing the rate at which DMs follow recommendations of the AI depending on the treatment and depending on their discriminatory preferences, using the index of Discriminatory_Preference and the average of measures of prejudice by gender and country. We measure concern for fairness with question Q3.
# In treatment Fair, we expect the rate at which the DMs follows the recommendation of the AI to decrease with higher levels of Discriminatory_Preference and prejudice, and increase with higher concern for fairness. The opposite would hold in the treatment Unfair.
#We thus run regressions of the type (should be put in absolute terms?)
random <-plm(choice_1 ~ overall_grade_diff+overall_grade_diff:TreatmentF+overall_grade_diff:TreatmentF:Q3, data=data, index=c("ID", "Group"), model="random")
#summary(random)
# we do find that if said they were concerned by fairness, then more likely to follow recommendation in Fair than in unfair.
# We test B by relying on answers to AIRelied (relying on AI), AIUnderstood (Understood AI), AIFair (AI was fair) and AIAccurate (AI was accurate), with a specific focus on AIRelied and AIFair (we expect less of an effect for the other two questions).
# We test B by relying on answers to Q11 (relying on AI), Q12 (Understood AI), Q13 (AI was fair) and Q14 (AI was accurate), with a specific focus on Q11 and Q13 (we expect less of an effect for the other two questions).
regressor1 <- "choice_1~overall_grade_diff+overall_grade_diff:(AIRelied+AIFair+AIUnderstood+AIAccurate)"
regressor1 <- "choice_1~overall_grade_diff+overall_grade_diff:(Q3+Q4+Q5)"
random1 <-plm(as.formula(regressor1), data=subset.data.frame(data, TreatmentF!="Own"), index=c("ID", "Group"), model="random")
#summary(random1)
random1Fair <-plm(as.formula(regressor1), data=subset.data.frame(data, TreatmentF=="Fair AI"), index=c("ID", "Group"), model="random")
random1Unfair <-plm(as.formula(regressor1), data=subset.data.frame(data, TreatmentF=="Discrim AI"), index=c("ID", "Group"), model="random")
stargazer(random1,random1Fair,random1Unfair, type = "text", out = "perception_following.html", no.space=TRUE, single.row=TRUE, align=TRUE, star.cutoffs = c(0.05, 0.01, 0.001),report = "vc*", header = FALSE, df=FALSE, digits=3, se = NULL)##
## =====================================================
## Dependent variable:
## -------------------------------
## regressor1
## (1) (2) (3)
## -----------------------------------------------------
## overall_grade_diff 0.010 -0.008 0.027
## overall_grade_diff:Q3 0.003 0.009 -0.004
## overall_grade_diff:Q4 0.001 0.005 -0.002
## overall_grade_diff:Q5 0.001 -0.001 0.003
## Constant 0.497*** 0.502*** 0.492***
## -----------------------------------------------------
## Observations 11,412 5,688 5,724
## R2 0.002 0.003 0.003
## Adjusted R2 0.002 0.002 0.002
## F Statistic 28.586*** 17.076** 14.408**
## =====================================================
## Note: *p<0.05; **p<0.01; ***p<0.001H9: The rate at which DMs follow recommendations from an AI depends on their level of agreement with the AIs preferences.
#We test this hypothesis by relating differences in discriminatory attitudes between the AI and the DM (Diff_AI) and the participant’s likelihood to follow advice from an AI. This likelihood will increase with the level at which a DM agrees with the AI.
# plot difference in preference with AI and likelihood to go along with it
#For this purpose, we use the composite variables Diff_AI_x, with x the variable of interest, and Diff_AI, which summarizes differences between the decider and the AI, and we relate this with the likelihood to follow recommendations of the AI:
# note the diff_dec should matter only if there is different gender in the choice, or different country
random <-plm(choice_1 ~ overall_grade_diffF*W_vs_M*(diff_dec_AI_Women), data=data, index=c("ID", "Group"), model="random")
#summary(random)
random <-plm(choice_1 ~ overall_grade_diffF*Ita_vs_Ger*(diff_dec_AI_Italy), data=data, index=c("ID", "Group"), model="random")
#summary(random)
random <-plm(choice_1 ~ overall_grade_diffF*(W_vs_M*(diff_dec_AI_Women)+Ita_vs_Ger*(diff_dec_AI_Italy)), data=data, index=c("ID", "Group"), model="random")
#summary(random)
random <-plm(choice_1 ~
overall_grade_diffF*(W_vs_M*diff_dec_AI_Women+Ita_vs_Ger*diff_dec_AI_Italy+age_diff*diff_dec_AI_Old+education_diff*diff_dec_AI_Educated+income_diff*diff_dec_AI_Rich+interview_diff*diff_dec_AI_Interview), data=data, index=c("ID", "Group"), model="random")
#summary(random)
random <-plm(choice_1 ~ overall_grade_diffF*diff_dec_AI, data=data, index=c("ID", "Group"), model="random")
#summary(random)
random <-plm(choice_1 ~ overall_grade_diff*diff_dec_AI, data=data, index=c("ID", "Group"), model="random")
#summary(random)
plot_summs(random)
# when there is a relevant difference in the pair, then the AI is all the more influential as it differs from the dec in terms of preferences
# but not more or less likely to follow recommendation if difference with AI
#A corollary of this hypothesis is that the less weight a decision maker puts on country and gender, the more likely he/she is to follow the fair AI and the less likely to follow the discriminatory AI.H10: DM decisions depend both on their discriminatory preferences and on the preferences of the AI.
Figure 17
# We run logit regressions whereby the weight and direction of the parameter on an applicant’s characteristic depends not only on the weight and direction for that characteristic given by the AI but also on the weight and direction as elicited in QRANK1 and QRANK2.
# We test this hypothesis by running similar regressions as in H3 but including the preferences of the AI:
random <-plm(choice_1 ~ W_vs_M*Preference_Women*TreatmentF, data=data, index=c("ID", "Group"), model="random")
#summary(random)
random <-plm(choice_1 ~ Ita_vs_Ger*Preference_Italy*TreatmentF, data=data, index=c("ID", "Group"), model="random")
#summary(random)
random<-plm(choice_1 ~ (W_vs_M*Preference_Women+Ita_vs_Ger*Preference_Italy)*TreatmentF, data=data, index=c("ID", "Group"), model="random")
#summary(random)
random <-plm(choice_1 ~ (W_vs_M*Preference_Women+Ita_vs_Ger*Preference_Italy)*TreatmentF+age_diff+education_diff+income_diff+interview_diff, data=data, index=c("ID", "Group"), model="random")
#summary(random)
# can also be done with grade given by AI
random <-plm(choice_1 ~ (W_vs_M*Preference_Women+Ita_vs_Ger*Preference_Italy)*TreatmentF+age_diff*Preference_Old+education_diff*Preference_Educated+income_diff*Preference_Rich+interview_diff*Preference_Interview+education_grade_diff+age_grade_diff+income_grade_diff+interview_grade_diff, data=data, index=c("ID", "Group"), model="random")
#summary(random)
# here, we see influence of the AI, but fair AI does not reduce influence of own preference on choice of women or men.
mod <- plm(choice_1 ~ (W_vs_M*Preference_Women+Ita_vs_Ger*Preference_Italy)*TreatmentF+age_diff+education_diff+income_diff+interview_diff,
index=c("ID", "Group"), model="random",
data = data)
#summary(mod)
# here we see it does not diminish sensitivity to own preference, only has an effect on the level, not the slope
p <- avg_predictions(mod, by = c("Preference_Women","TreatmentF","W_vs_M"))
pPreference_Women | TreatmentF | W_vs_M | estimate | std.error | statistic | p.value | s.value | conf.low | conf.high |
|---|---|---|---|---|---|---|---|---|---|
numeric | factor | numeric | numeric | numeric | numeric | numeric | numeric | numeric | numeric |
-3 | Own | -1 | 0.5 | 0.0 | 10.4 | 0 | 82.0 | 0.4 | 0.6 |
-3 | Own | 0 | 0.6 | 0.0 | 28.4 | 0 | 586.1 | 0.5 | 0.6 |
-3 | Own | 1 | 0.5 | 0.0 | 26.4 | 0 | 509.3 | 0.5 | 0.6 |
-3 | Discrim AI | -1 | 0.5 | 0.0 | 11.5 | 0 | 98.9 | 0.4 | 0.6 |
-3 | Discrim AI | 0 | 0.5 | 0.0 | 28.1 | 0 | 574.3 | 0.5 | 0.6 |
-3 | Discrim AI | 1 | 0.4 | 0.0 | 22.1 | 0 | 358.0 | 0.4 | 0.5 |
-3 | Fair AI | -1 | 0.5 | 0.0 | 13.2 | 0 | 130.4 | 0.5 | 0.6 |
-3 | Fair AI | 0 | 0.6 | 0.0 | 28.6 | 0 | 595.6 | 0.5 | 0.6 |
-3 | Fair AI | 1 | 0.5 | 0.0 | 25.0 | 0 | 454.1 | 0.4 | 0.5 |
-2 | Own | -1 | 0.5 | 0.0 | 13.3 | 0 | 131.7 | 0.4 | 0.6 |
-2 | Own | 0 | 0.6 | 0.0 | 36.1 | 0 | 943.5 | 0.5 | 0.6 |
-2 | Own | 1 | 0.5 | 0.0 | 34.0 | 0 | 839.0 | 0.5 | 0.6 |
n: 63 | |||||||||
plot1<-ggplot(subset(p, W_vs_M==1), aes(x = Preference_Women, y = estimate, ymin = conf.low, ymax = conf.high, colour=TreatmentF)) + ggnewscale::new_scale_fill() + geom_smooth(aes(x = Preference_Women, y = estimate, ymin = conf.low, ymax = conf.high, colour=TreatmentF, fill=TreatmentF),method = "lm", alpha=0.1) + xlab("Preference for women") + ylab("% Woman chosen") + theme_classic() + ylim(0.3, 0.6) + scale_y_continuous(breaks=seq(0.3,0.6,0.01), labels = scales::percent) + coord_cartesian(ylim = c(0.35, 0.6))## Scale for y is already present.
## Adding another scale for y, which will replace the existing scale.
## Scale for y is already present.
## Adding another scale for y, which will replace the existing scale.## `geom_smooth()` using formula = 'y ~ x'
## Warning in mode(current): NAs introduced by coercion to integer rangePreference_Italy | TreatmentF | Ita_vs_Ger | estimate | std.error | statistic | p.value | s.value | conf.low | conf.high |
|---|---|---|---|---|---|---|---|---|---|
numeric | factor | numeric | numeric | numeric | numeric | numeric | numeric | numeric | numeric |
-3 | Own | -1 | 0.6 | 0.0 | 34.9 | 0 | 884.1 | 0.6 | 0.6 |
-3 | Own | 0 | 0.5 | 0.0 | 35.1 | 0 | 892.7 | 0.5 | 0.6 |
-3 | Own | 1 | 0.5 | 0.0 | 17.3 | 0 | 220.7 | 0.4 | 0.5 |
-3 | Discrim AI | -1 | 0.6 | 0.0 | 34.8 | 0 | 876.7 | 0.5 | 0.6 |
-3 | Discrim AI | 0 | 0.5 | 0.0 | 31.3 | 0 | 712.7 | 0.4 | 0.5 |
-3 | Discrim AI | 1 | 0.4 | 0.0 | 14.3 | 0 | 150.8 | 0.3 | 0.4 |
-3 | Fair AI | -1 | 0.6 | 0.0 | 32.9 | 0 | 786.8 | 0.6 | 0.6 |
-3 | Fair AI | 0 | 0.5 | 0.0 | 34.4 | 0 | 856.8 | 0.5 | 0.5 |
-3 | Fair AI | 1 | 0.4 | 0.0 | 16.2 | 0 | 193.6 | 0.4 | 0.5 |
-2 | Own | -1 | 0.6 | 0.0 | 42.5 | 0 | Inf | 0.5 | 0.6 |
-2 | Own | 0 | 0.5 | 0.0 | 43.0 | 0 | Inf | 0.5 | 0.6 |
-2 | Own | 1 | 0.5 | 0.0 | 21.8 | 0 | 348.8 | 0.4 | 0.5 |
n: 63 | |||||||||
plot2<-ggplot(subset(p, Ita_vs_Ger==1), aes(x = Preference_Italy, y = estimate, ymin = conf.low, ymax = conf.high, colour=TreatmentF)) + ggnewscale::new_scale_fill() + geom_smooth(aes(x = Preference_Italy, y = estimate, ymin = conf.low, ymax = conf.high, colour=TreatmentF, fill=TreatmentF),method = "lm", alpha=0.1) + xlab("Preference for Italians") + ylab("% Italian chosen") + theme_classic() + ylim(0.3, 0.6) + scale_y_continuous(breaks=seq(0.3,0.6,0.01), labels = scales::percent) + coord_cartesian(ylim = c(0.35, 0.6))## Scale for y is already present.
## Adding another scale for y, which will replace the existing scale.
## Scale for y is already present.
## Adding another scale for y, which will replace the existing scale.## `geom_smooth()` using formula = 'y ~ x'
## `geom_smooth()` using formula = 'y ~ x'
## `geom_smooth()` using formula = 'y ~ x'
H10, showing influence of own preferences over all characteristics
Figure 18
mod3 <- plm(choice_1 ~ (W_vs_M*Preference_Women+Ita_vs_Ger*Preference_Italy+age_diff*Preference_Old+education_diff*Preference_Educated+income_diff*Preference_Rich+interview_diff*Preference_Interview)*TreatmentF,
index=c("ID", "Group"), model="random",
data = data)
p <- avg_predictions(mod3, by = c("Preference_Women","TreatmentF","W_vs_M"))
pPreference_Women | TreatmentF | W_vs_M | estimate | std.error | statistic | p.value | s.value | conf.low | conf.high |
|---|---|---|---|---|---|---|---|---|---|
numeric | factor | numeric | numeric | numeric | numeric | numeric | numeric | numeric | numeric |
-3 | Own | -1 | 0.5 | 0.0 | 10.5 | 0 | 82.9 | 0.4 | 0.6 |
-3 | Own | 0 | 0.6 | 0.0 | 28.6 | 0 | 595.4 | 0.5 | 0.6 |
-3 | Own | 1 | 0.5 | 0.0 | 26.6 | 0 | 516.7 | 0.5 | 0.6 |
-3 | Discrim AI | -1 | 0.5 | 0.0 | 10.6 | 0 | 84.2 | 0.4 | 0.6 |
-3 | Discrim AI | 0 | 0.5 | 0.0 | 26.9 | 0 | 528.4 | 0.5 | 0.6 |
-3 | Discrim AI | 1 | 0.4 | 0.0 | 21.3 | 0 | 331.2 | 0.4 | 0.5 |
-3 | Fair AI | -1 | 0.6 | 0.0 | 13.4 | 0 | 134.0 | 0.5 | 0.6 |
-3 | Fair AI | 0 | 0.5 | 0.0 | 28.1 | 0 | 576.3 | 0.5 | 0.6 |
-3 | Fair AI | 1 | 0.5 | 0.0 | 24.5 | 0 | 437.7 | 0.4 | 0.5 |
-2 | Own | -1 | 0.5 | 0.0 | 13.2 | 0 | 129.5 | 0.4 | 0.6 |
-2 | Own | 0 | 0.6 | 0.0 | 35.9 | 0 | 936.8 | 0.5 | 0.6 |
-2 | Own | 1 | 0.5 | 0.0 | 33.9 | 0 | 834.7 | 0.5 | 0.6 |
n: 63 | |||||||||
plot1<-ggplot(subset(p, W_vs_M==1), aes(x = Preference_Women, y = estimate, ymin = conf.low, ymax = conf.high, colour=TreatmentF)) + ggnewscale::new_scale_fill() + geom_smooth(aes(x = Preference_Women, y = estimate, ymin = conf.low, ymax = conf.high, colour=TreatmentF, fill=TreatmentF),method = "lm", alpha=0.1, show.legend = FALSE) + xlab("Preference for women") + ylab("% Woman chosen") + theme_classic() + scale_y_continuous(breaks=seq(0.2,0.7,0.05), labels = scales::percent) + coord_cartesian(ylim = c(0.2, 0.7))## Scale for y is already present.
## Adding another scale for y, which will replace the existing scale.## `geom_smooth()` using formula = 'y ~ x'
## Warning in mode(current): NAs introduced by coercion to integer rangePreference_Italy | TreatmentF | Ita_vs_Ger | estimate | std.error | statistic | p.value | s.value | conf.low | conf.high |
|---|---|---|---|---|---|---|---|---|---|
numeric | factor | numeric | numeric | numeric | numeric | numeric | numeric | numeric | numeric |
-3 | Own | -1 | 0.6 | 0.0 | 35.1 | 0 | 895.8 | 0.6 | 0.6 |
-3 | Own | 0 | 0.5 | 0.0 | 35.1 | 0 | 895.4 | 0.5 | 0.6 |
-3 | Own | 1 | 0.5 | 0.0 | 17.3 | 0 | 220.3 | 0.4 | 0.5 |
-3 | Discrim AI | -1 | 0.6 | 0.0 | 34.9 | 0 | 885.1 | 0.5 | 0.6 |
-3 | Discrim AI | 0 | 0.5 | 0.0 | 31.6 | 0 | 727.4 | 0.5 | 0.5 |
-3 | Discrim AI | 1 | 0.4 | 0.0 | 14.0 | 0 | 146.0 | 0.3 | 0.4 |
-3 | Fair AI | -1 | 0.6 | 0.0 | 32.9 | 0 | 786.2 | 0.6 | 0.6 |
-3 | Fair AI | 0 | 0.5 | 0.0 | 34.2 | 0 | 851.4 | 0.5 | 0.5 |
-3 | Fair AI | 1 | 0.4 | 0.0 | 16.0 | 0 | 189.0 | 0.4 | 0.5 |
-2 | Own | -1 | 0.6 | 0.0 | 42.4 | 0 | Inf | 0.5 | 0.6 |
-2 | Own | 0 | 0.5 | 0.0 | 43.3 | 0 | Inf | 0.5 | 0.6 |
-2 | Own | 1 | 0.5 | 0.0 | 21.4 | 0 | 336.2 | 0.4 | 0.5 |
n: 63 | |||||||||
plot2<-ggplot(subset(p, Ita_vs_Ger==1), aes(x = Preference_Italy, y = estimate, ymin = conf.low, ymax = conf.high, colour=TreatmentF)) + ggnewscale::new_scale_fill() + geom_smooth(aes(x = Preference_Italy, y = estimate, ymin = conf.low, ymax = conf.high, colour=TreatmentF, fill=TreatmentF),method = "lm", alpha=0.1, show.legend = FALSE) + xlab("Preference for Italians") + ylab("% Italian chosen") + theme_classic() + scale_y_continuous(breaks=seq(0.2,0.7,0.05), labels = scales::percent) + coord_cartesian(ylim = c(0.2, 0.7))## Scale for y is already present.
## Adding another scale for y, which will replace the existing scale.Preference_Old | TreatmentF | age_diff | estimate | std.error | statistic | p.value | s.value | conf.low | conf.high |
|---|---|---|---|---|---|---|---|---|---|
numeric | factor | numeric | numeric | numeric | numeric | numeric | numeric | numeric | numeric |
-3 | Own | -2 | 0.6 | 0.0 | 19.2 | 0 | 271.4 | 0.6 | 0.7 |
-3 | Own | -1 | 0.6 | 0.0 | 25.5 | 0 | 473.1 | 0.6 | 0.7 |
-3 | Own | 0 | 0.6 | 0.0 | 26.8 | 0 | 522.0 | 0.5 | 0.6 |
-3 | Own | 1 | 0.5 | 0.0 | 20.3 | 0 | 302.8 | 0.5 | 0.6 |
-3 | Own | 2 | 0.5 | 0.0 | 13.5 | 0 | 135.8 | 0.4 | 0.5 |
-3 | Discrim AI | -2 | 0.5 | 0.0 | 15.2 | 0 | 169.9 | 0.4 | 0.6 |
-3 | Discrim AI | -1 | 0.5 | 0.0 | 21.0 | 0 | 322.8 | 0.4 | 0.5 |
-3 | Discrim AI | 0 | 0.5 | 0.0 | 23.3 | 0 | 397.8 | 0.4 | 0.5 |
-3 | Discrim AI | 1 | 0.4 | 0.0 | 18.1 | 0 | 239.8 | 0.4 | 0.5 |
-3 | Discrim AI | 2 | 0.4 | 0.0 | 12.4 | 0 | 114.7 | 0.3 | 0.5 |
-3 | Fair AI | -2 | 0.7 | 0.0 | 22.2 | 0 | 359.3 | 0.6 | 0.8 |
-3 | Fair AI | -1 | 0.6 | 0.0 | 26.4 | 0 | 509.6 | 0.6 | 0.6 |
n: 85 | |||||||||
plot3<-ggplot(subset(p, age_diff==2), aes(x = Preference_Old, y = estimate, ymin = conf.low, ymax = conf.high, colour=TreatmentF)) + ggnewscale::new_scale_fill() + geom_smooth(aes(x = Preference_Old, y = estimate, ymin = conf.low, ymax = conf.high, colour=TreatmentF, fill=TreatmentF),method = "lm", alpha=0.1, show.legend = FALSE) + xlab("Preference for older") + ylab("% Older chosen") + theme_classic() + scale_y_continuous(breaks=seq(0.2,0.7,0.05), labels = scales::percent) + coord_cartesian(ylim = c(0.2, 0.7))## Scale for y is already present.
## Adding another scale for y, which will replace the existing scale.Preference_Educated | TreatmentF | education_diff | estimate | std.error | statistic | p.value | s.value | conf.low | conf.high |
|---|---|---|---|---|---|---|---|---|---|
numeric | factor | numeric | numeric | numeric | numeric | numeric | numeric | numeric | numeric |
-3 | Own | -2 | 0.4 | 0.1 | 5.8 | 0 | 27.1 | 0.3 | 0.5 |
-3 | Own | -1 | 0.5 | 0.0 | 11.1 | 0 | 92.2 | 0.4 | 0.5 |
-3 | Own | 0 | 0.5 | 0.0 | 15.7 | 0 | 181.3 | 0.5 | 0.6 |
-3 | Own | 1 | 0.5 | 0.0 | 15.1 | 0 | 167.9 | 0.5 | 0.6 |
-3 | Own | 2 | 0.6 | 0.1 | 12.0 | 0 | 107.4 | 0.5 | 0.7 |
-3 | Discrim AI | -2 | 0.3 | 0.1 | 6.0 | 0 | 28.7 | 0.2 | 0.4 |
-3 | Discrim AI | -1 | 0.5 | 0.0 | 12.3 | 0 | 112.5 | 0.4 | 0.5 |
-3 | Discrim AI | 0 | 0.5 | 0.0 | 16.3 | 0 | 194.9 | 0.4 | 0.6 |
-3 | Discrim AI | 1 | 0.5 | 0.0 | 15.2 | 0 | 171.7 | 0.5 | 0.6 |
-3 | Discrim AI | 2 | 0.5 | 0.0 | 11.0 | 0 | 90.5 | 0.4 | 0.6 |
-3 | Fair AI | -2 | 0.5 | 0.1 | 8.4 | 0 | 54.4 | 0.4 | 0.6 |
-3 | Fair AI | -1 | 0.5 | 0.0 | 9.9 | 0 | 74.2 | 0.4 | 0.6 |
n: 89 | |||||||||
plot4<-ggplot(subset(p, education_diff==2), aes(x = Preference_Educated, y = estimate, ymin = conf.low, ymax = conf.high, colour=TreatmentF)) + ggnewscale::new_scale_fill() + geom_smooth(aes(x = Preference_Educated, y = estimate, ymin = conf.low, ymax = conf.high, colour=TreatmentF, fill=TreatmentF),method = "lm", alpha=0.1, show.legend = FALSE) + xlab("Preference for educated") + ylab("% More educated chosen") + theme_classic() + scale_y_continuous(breaks=seq(0.2,0.7,0.05), labels = scales::percent) + coord_cartesian(ylim = c(0.2, 0.7))## Scale for y is already present.
## Adding another scale for y, which will replace the existing scale.Preference_Rich | TreatmentF | income_diff | estimate | std.error | statistic | p.value | s.value | conf.low | conf.high |
|---|---|---|---|---|---|---|---|---|---|
numeric | factor | numeric | numeric | numeric | numeric | numeric | numeric | numeric | numeric |
-3 | Own | -2 | 0.6 | 0.1 | 11.6 | 0 | 100.6 | 0.5 | 0.7 |
-3 | Own | -1 | 0.5 | 0.0 | 12.9 | 0 | 123.9 | 0.4 | 0.6 |
-3 | Own | 0 | 0.5 | 0.0 | 16.5 | 0 | 199.6 | 0.5 | 0.6 |
-3 | Own | 1 | 0.5 | 0.0 | 12.4 | 0 | 114.0 | 0.4 | 0.5 |
-3 | Own | 2 | 0.4 | 0.1 | 8.5 | 0 | 56.1 | 0.3 | 0.5 |
-3 | Discrim AI | -2 | 0.5 | 0.0 | 10.7 | 0 | 85.9 | 0.4 | 0.6 |
-3 | Discrim AI | -1 | 0.5 | 0.0 | 13.5 | 0 | 135.5 | 0.4 | 0.6 |
-3 | Discrim AI | 0 | 0.5 | 0.0 | 16.3 | 0 | 195.1 | 0.5 | 0.6 |
-3 | Discrim AI | 1 | 0.5 | 0.0 | 13.6 | 0 | 137.0 | 0.4 | 0.6 |
-3 | Discrim AI | 2 | 0.5 | 0.1 | 10.2 | 0 | 78.2 | 0.4 | 0.6 |
-3 | Fair AI | -2 | 0.5 | 0.1 | 9.5 | 0 | 68.8 | 0.4 | 0.6 |
-3 | Fair AI | -1 | 0.5 | 0.0 | 15.1 | 0 | 168.7 | 0.5 | 0.6 |
n: 100 | |||||||||
plot5<-ggplot(subset(p, income_diff==2), aes(x = Preference_Rich, y = estimate, ymin = conf.low, ymax = conf.high, colour=TreatmentF)) + ggnewscale::new_scale_fill() + geom_smooth(aes(x = Preference_Rich, y = estimate, ymin = conf.low, ymax = conf.high, colour=TreatmentF, fill=TreatmentF),method = "lm", alpha=0.1, show.legend = FALSE) + xlab("Preference for rich") + ylab("% Richer chosen") + theme_classic() + scale_y_continuous(breaks=seq(0.2,0.7,0.05), labels = scales::percent) + coord_cartesian(ylim = c(0.2, 0.7))## Scale for y is already present.
## Adding another scale for y, which will replace the existing scale.## `geom_smooth()` using formula = 'y ~ x'
Preference_Interview | TreatmentF | interview_diff | estimate | std.error | statistic | p.value | s.value | conf.low | conf.high |
|---|---|---|---|---|---|---|---|---|---|
numeric | factor | numeric | numeric | numeric | numeric | numeric | numeric | numeric | numeric |
-3 | Own | -3 | 0.6 | 0.0 | 13.5 | 0 | 134.9 | 0.5 | 0.7 |
-3 | Own | -2 | 0.5 | 0.0 | 13.7 | 0 | 139.1 | 0.4 | 0.6 |
-3 | Own | -1 | 0.6 | 0.0 | 18.5 | 0 | 251.3 | 0.5 | 0.6 |
-3 | Own | 0 | 0.5 | 0.0 | 18.0 | 0 | 237.9 | 0.4 | 0.6 |
-3 | Own | 1 | 0.5 | 0.0 | 16.4 | 0 | 199.1 | 0.4 | 0.5 |
-3 | Own | 2 | 0.5 | 0.0 | 13.4 | 0 | 134.4 | 0.4 | 0.6 |
-3 | Own | 3 | 0.4 | 0.1 | 8.1 | 0 | 51.3 | 0.3 | 0.6 |
-3 | Discrim AI | -3 | 0.5 | 0.1 | 9.9 | 0 | 74.5 | 0.4 | 0.6 |
-3 | Discrim AI | -2 | 0.6 | 0.0 | 15.3 | 0 | 173.7 | 0.5 | 0.7 |
-3 | Discrim AI | -1 | 0.5 | 0.0 | 12.4 | 0 | 114.0 | 0.5 | 0.6 |
-3 | Discrim AI | 0 | 0.5 | 0.0 | 16.5 | 0 | 200.0 | 0.5 | 0.6 |
-3 | Discrim AI | 1 | 0.5 | 0.0 | 13.1 | 0 | 127.7 | 0.4 | 0.5 |
n: 219 | |||||||||
plot6<-ggplot(subset(p, interview_diff==2), aes(x = Preference_Interview, y = estimate, ymin = conf.low, ymax = conf.high, colour=TreatmentF)) + ggnewscale::new_scale_fill() + geom_smooth(aes(x = Preference_Interview, y = estimate, ymin = conf.low, ymax = conf.high, colour=TreatmentF, fill=TreatmentF),method = "lm", alpha=0.1, show.legend = FALSE) + xlab("Preference for good interview") + ylab("% Better interview chosen") + theme_classic() + scale_y_continuous(breaks=seq(0.2,0.7,0.05), labels = scales::percent) + coord_cartesian(ylim = c(0.2, 0.7))## Scale for y is already present.
## Adding another scale for y, which will replace the existing scale.## `geom_smooth()` using formula = 'y ~ x'
## `geom_smooth()` using formula = 'y ~ x'
## `geom_smooth()` using formula = 'y ~ x'
## `geom_smooth()` using formula = 'y ~ x'
## `geom_smooth()` using formula = 'y ~ x'
## `geom_smooth()` using formula = 'y ~ x'
## `geom_smooth()` using formula = 'y ~ x'
Interaction between AI and DMs goals and work environment
H11: Whether a DM follows an AI’s recommendation depends on their aims and attitudes when making decisions. More precisely, DMs who try to make rational decisions (Q4) and care about making correct decisions (Q5), will be more likely to follow the AI’s recommendation. Those who care most about being fair (Q3) are more likely to follow fair AI decisions and less likely to follow unfair AI.
# We test this hypothesis by considering how the rate at which a DM followed the AI’s recommendation relates to questions Q3 to Q5.
random <-plm(choice_1 ~ overall_grade_diffF*(Q3+Q4+Q5), data=data, index=c("ID", "Group"), model="random")
#summary(random)
# We test this for robustness with variables from H4 and consider the effect of treatments by introducing a TreatmentF cross-term in the expression.
random <-plm(choice_1 ~ overall_grade_diffF*TreatmentF*(Q3+Q4+Q5), data=data, index=c("ID", "Group"), model="random")
#summary(random)H12: DM who use DSS in their work and deal with data and statistics (Q18 and Q19), will be more likely to follow AI recommendations, especially those of a fair AI. DMs who work in more diverse companies and those companies with diversity policies that are actively applied (Q21, Q22, Q23), will display less bias in their decisions and will be particularly like to follow fair AI recommendations /unlikely to follow unfair AI recommendations.
# The tests for those hypotheses proceed along the same lines as in H11.
random <-plm(choice_1 ~ overall_grade_diff*(Q18+Q19+Q21+Q22+Q23), data=data, index=c("ID", "Group"), model="random")
#summary(random)
# We test this for robustness with variables from H4 and consider the effect of treatments by introducing a TreatmentF cross-term in the expression.
random <-plm(choice_1 ~ overall_grade_diff*TreatmentF*(Q18+Q19+Q21+Q22+Q23), data=data, index=c("ID", "Group"), model="random")
#summary(random)