Appearance Change and Redemption: Code and analyses for main package of studies

Study 1a

show code 
study1a_raw <- read.csv('Data/ACR1.csv') %>% 
  mutate(attCheck = rowMeans(select(.,"AC.male.1.SocialDist__attCheck", "AC.male.2.SocialDist__attCheck",
                                         "C.male.1.SocialDist__attCheck", "C.male.2.SocialDist__attCheck", 
                                         "AC.fmale.1.SocialDist__attCheck", "AC.fmale.2.SocialDist__attCheck", 
                                         "C.fmale.1.SocialDist__attCheck", "C.fmale.2.SocialDist__attCheck"),  na.rm=TRUE)) %>% 
  filter(Progress==100)

study1a = study1a_raw %>% 
  filter(attCheck == 7 &  grepl('orange', study1a_raw$bot.check1_4_TEXT, ignore.case=TRUE)) %>% 
  mutate(ID = 1:nrow(.), #assign ID
         across(matches(".dishonest"), ~ 8 - .), #reverse code dishonest & reoffend
         across(matches(".reoffend"), ~ 8 - .)) %>% 

  mutate(AC.trust = rowMeans(select(., matches("^A.*trust")), na.rm=TRUE) -1, #collapse trustworthy variable across stimuli and change from 1-7 to 0-6 scale
         C.trust = rowMeans(select(., matches("^C.*trust")), na.rm=TRUE) -1,
         
         AC.dishonest = rowMeans(select(.,matches("^A.*dishonest")), na.rm=TRUE) -1, #collapse dishonest variable and change from 1-7 to 0-6 scale
         C.dishonest = rowMeans(select(.,matches("^C.*dishonest")), na.rm=TRUE) -1,
         
         AC.remorse = rowMeans(select(.,matches("^A.*remorse")), na.rm=TRUE) -1, #collapse remorse variable and change from 1-7 to 0-6 scale
         C.remorse = rowMeans(select(.,matches("^C.*remorse")), na.rm=TRUE) -1,
         
         AC.secondChance = rowMeans(select(.,matches("^A.*secChance")), na.rm=TRUE) -1, #collapse second chance variable and change from 1-7 to 0-6 scale
         C.secondChance = rowMeans(select(.,matches("^C.*secChance")), na.rm=TRUE) -1,
         
         AC.reoffend = rowMeans(select(.,matches("^A.*reoffend")), na.rm=TRUE) -1, #collapse reoffend variable and change from 1-7 to 0-6 scale
         C.reoffend = rowMeans(select(.,matches("^C.*reoffend")), na.rm=TRUE) -1,
         
         AC.better = rowMeans(select(.,matches("^A.*better")), na.rm=TRUE) -1, #collapse better variable and change from 1-7 to 0-6 scale
         C.better = rowMeans(select(.,matches("^C.*better")), na.rm=TRUE) -1,
         
         AC.changeBett = rowMeans(select(.,matches("^A.*changeBett")), na.rm=TRUE) -1, #collapse changed for the better better variable and change from 1-7 to 0-6 scale
         C.changeBett = rowMeans(select(.,matches("^C.*changeBett")), na.rm=TRUE) -1)  

#calculate alpha for DV items before reducing columns & collapsing items. Note this calculates alpha only using the responses in the appearance change condition because it is within subjects design 
study1a_alpha = round(psych::alpha(select(study1a ,matches("AC.dishonest"), matches("AC.trust"), matches("AC.remorse"), matches("AC.secChance"), matches("AC.reoffend"), matches("AC.better"), matches("AC.changeBett")))$total[1,1], 2)

study1a = study1a %>% 
  select(c('gender','age','race',tail(names(.), 15))) %>% #select only demographics, ID & DV items
  
  mutate(AC.redemption = rowMeans(select(.,matches("^AC.*")), na.rm=TRUE),  #collapse all DV items to one redemption variable
         C.redemption = rowMeans(select(.,matches("^C.*")), na.rm=TRUE)) 

study1a_long = study1a %>% 
  pivot_longer(5:20, 
               names_to = c("condition","trait"),
               names_pattern="([^.]+.)(.*)") %>% 
  spread(trait, value) %>% 
  mutate(condition = factor(condition, levels=c('C.','AC.'), labels=c('control','appearanceChange')))
  • MTurk
  • Qualtrics title: ‘Appearance Change and Redemption 1’
  • Data file: ACR1.csv
  • Pre-registration: aspredicted.org/Z2P_1KD
  • 821 responses collected on 10/17/2018
  • 4 attention checks (“select very comfortable for this statement”).
  • bot check (“select other and write in ‘orange’”)
  • Also collected:
    • competence (2 Qs)
    • social distance (5 qs)
    • different (1 Q)
    • moral theory
    • whether P’s family/friends were convicted of crimes described in study
    • a second bot check (“what is the closest item to you”)
  • Final n = 709

Study 1b

show code 
study1b_raw <- read.csv('Data/ACR2.csv') 

study1b = study1b_raw %>% 
  filter(male.1.SocialDist_attCheck == 7 & male.2.SocialDist_attCheck == 7 & female.1.SocialDist_attCheck == 7 & female.2.SocialDist_attCheck == 7) %>% #exclude att check fails
  mutate(across(matches(".dishonest"), ~ 8 - .), #reverse code dishonest & blow it
         across(matches(".blow"), ~ 8 - .)) %>% 
  
  mutate(trust = rowMeans(select(.,matches(".trust")), na.rm=TRUE) -1, #collapse DV items across stimuli and change from 1-7 to 0-6 scale
         dishonest = rowMeans(select(.,matches(".dishonest")), na.rm=TRUE) -1,
         secondChance = rowMeans(select(.,matches(".secondChance")), na.rm=TRUE) -1,
         blowIt = rowMeans(select(.,matches(".blow")), na.rm=TRUE) -1,
         remorse = rowMeans(select(.,ends_with("remorse")), na.rm = TRUE) -1,
         better = rowMeans(select(.,ends_with("better")), na.rm = TRUE) -1,
         
         condition = factor(condition, levels=c('control','appearance.change'), labels=c('control','appearanceChange'))) %>% 
  
  mutate(redemption = rowMeans(select(.,'trust','dishonest','secondChance','blowIt','remorse','better'), na.rm=TRUE)) #create collapsed redemption variable

#calculate alpha. note that this includes ratings for all 4 targets, so it is an alpha of 20 items. 
study1b_alpha = round(psych::alpha(select(study1b ,matches(".dishonest"), matches(".trust"), matches(".secondChance"), matches(".blow"), matches(".remorse"), matches(".better")))$total[1,1], 2)
  • PPool
  • Qualtrics title: ‘Appearance Change and Redemption 2.1’
  • Data file: ACR2.csv
  • 153 responses collected from 10/31/2018 to 11/02/2018
  • 4 attention checks (“select very comfortable for this question”). Sample performed poorly.
    • 25% fail at least one attention check. If we remove them, we are only left with n = 115.
  • Also collected:
    • attractiveness of each target
    • competence
    • social distance
    • moral theory (incremental/entity)
    • whether P’s family/friends were convicted of crimes described in study
    • bot check (“what is the closest item to you”)
  • Final n = 115

Study 1c

show code 
study1c_raw = read.csv('Data/ACR2.3.csv') %>% 
  filter(Progress ==100)

study1c = study1c_raw %>% 
  filter(att.Check == 1 & att.Check2 == 7) %>% #exclude att check fails
  
  mutate(across(matches(".dishonest"), ~ 8 - .), #reverse code dishonest & reoffend
         across(matches(".reoffend"), ~ 8 - .)) %>% 
  
  mutate(trust = rowMeans(select(.,matches(".trust")), na.rm=TRUE) -1, #collapse all DV items across stimuli and change from 1-7 to 0-6 scale
         dishonest = rowMeans(select(.,matches(".dishonest")), na.rm=TRUE) -1,
         secondChance = rowMeans(select(.,matches(".secondChance")), na.rm=TRUE) -1,
         reoffend = rowMeans(select(.,matches(".reoffend")), na.rm=TRUE) -1,
         remorse = rowMeans(select(.,ends_with("remorse")), na.rm = TRUE) -1,
         better = rowMeans(select(.,ends_with("better")), na.rm = TRUE) -1,
         
         condition = factor(condition, levels=c('control','appearance.change'), labels=c('control','appearanceChange'))) %>% 
  mutate(redemption = rowMeans(select(.,c('trust','dishonest','secondChance','reoffend','remorse','better')), na.rm=TRUE)) #create collapsed redemption variable

#calculate alpha
study1c_alpha = round(psych::alpha(select(study1c ,matches(".dishonest"), matches(".trust"), matches(".secondChance"), matches(".reoffend"), matches(".remorse"), matches(".better")))$total[1,1], 2)
  • Lightspeed GMI
    • part of Decline Effect project
  • Qualtrics title: ‘Appearance Change and Redemption 2.3’
  • Data file: ACR2.3
  • Pre-registration: aspredicted.org/GBG_FIG
  • 790 responses collected from 01/16/2019 to 01/17/2019
  • 2 attention checks (select [not at all]/[extremely] for this question”
  • Also collected:
    • attractiveness of each target
    • moral theory (incremental/entity)
    • whether P or P’s family/friends were convicted of crimes described in study
    • political orientation
    • bot check (“what is the closest item to you”)
  • Final n = 760

Study 1d

show code 
study1d_raw = read.csv('Data/ACR2decline.csv') %>% 
  filter(Progress ==100 & condition!="") #removes people who didn't finish or who didn't consent or who were kicked out for being on mobile

study1d = study1d_raw %>% 
  filter(att.Check == 1 & att.Check2 == 7  & PersonCheck ==1) %>% 
  
  mutate(across(matches(".dishonest"), ~ 8 - .), #reverse code dishonest & reoffend
         across(matches(".reoffend"), ~ 8 - .)) %>% 
  
  mutate(trust = rowMeans(select(.,matches(".trust")), na.rm=TRUE) -1, #collapse all DV items across stimuli and change from 1-7 to 0-6 scale
         dishonest = rowMeans(select(.,matches(".dishonest")), na.rm=TRUE) -1,
         secondChance = rowMeans(select(.,matches(".secondChance")), na.rm=TRUE) -1,
         reoffend = rowMeans(select(.,matches(".reoffend")), na.rm=TRUE) -1,
         remorse = rowMeans(select(.,ends_with("remorse")), na.rm = TRUE) -1,
         better = rowMeans(select(.,ends_with("better")), na.rm = TRUE) -1,
         
         condition = factor(condition, levels=c('control','appearance.change'), labels=c('control','appearanceChange'))) %>% 
   mutate(redemption = rowMeans(select(.,c('trust','dishonest','secondChance','reoffend','remorse','better')), na.rm=TRUE)) #create collapsed redemption variable

#calculate alpha
study1d_alpha = round(psych::alpha(select(study1d ,matches(".dishonest"), matches(".trust"), matches(".secondChance"), matches(".reoffend"), matches(".remorse"), matches(".better")))$total[1,1], 2)
  • Decline effect data - Lightspeed GMI
  • Qualtrics title: ‘Appearance Change and Redemption - Decline Study’
  • Data file: ACR2decline.csv
  • 1915 collected responses between 2/26/2019 and 05/12/2019
  • 3 attention checks (select [not at all]/[extremely] for this question” & “should we use your data?”
  • Also collected:
    • attractiveness of each target
    • moral theory (incremental/entity)
    • whether P (or family/friends) was convicted of crimes described in study
    • political orientation
    • SES, income, education, parent’s education
    • bot check (“what is the closest item to you”) & captcha
  • Final n = 1504

Study 1e

show code 
study1e_raw = read.csv('Data/ACR2decline_run2.csv') %>% 
  filter(Progress ==100 & condition!="") #removes people who didn't finish or who didn't consent or who were kicked out for being on mobile

study1e = study1e_raw %>% 
  filter(att.Check == 1 & att.Check2 == 7 & PersonCheck ==1) %>% 
  
  mutate(across(matches(".dishonest"), ~ 8 - .), #reverse code dishonest & reoffend
         across(matches(".reoffend"), ~ 8 - .)) %>% 
  
  mutate(trust = rowMeans(select(.,matches(".trust")), na.rm=TRUE) -1, #collapse all DV items across stimuli and change from 1-7 to 0-6 scale
         dishonest = rowMeans(select(.,matches(".dishonest")), na.rm=TRUE) -1,
         secondChance = rowMeans(select(.,matches(".secondChance")), na.rm=TRUE) -1,
         reoffend = rowMeans(select(., matches(".reoffend")), na.rm=TRUE) -1,
         remorse = rowMeans(select(.,ends_with("remorse")), na.rm = TRUE) -1,
         better = rowMeans(select(.,ends_with("better")), na.rm = TRUE) -1,
         
         condition = factor(condition, levels=c('control','appearance.change'), labels=c('control','appearanceChange'))) %>% 
   mutate(redemption = rowMeans(select(.,c('trust','dishonest','secondChance','reoffend','remorse','better')), na.rm=TRUE)) #create collapsed redemption variable

#calculate alpha
study1e_alpha = round(psych::alpha(select(study1e ,matches(".dishonest"), matches(".trust"), matches(".secondChance"), matches(".reoffend"), matches(".remorse"), matches(".better")))$total[1,1], 2)
  • Decline effect data - Lightspeed GMI
  • Qualtrics title: ‘Appearance Change and Redemption - Decline Study - UVa Run 2’
  • Data file: ACR2decline_run2.csv
  • 2008 complete responses between 05/30/2019 and 07/11/2019
  • 3 attention checks (select [not at all]/[extremely] for this question” & “should we use your data?”
  • Also collected:
    • attractiveness of each target
    • moral theory (incremental/entity)
    • whether P (or family/friends) was convicted of crimes described in study
    • political orientation
    • SES, income, education, parent’s education
    • bot check (“what is the closest item to you”) & captcha
  • Final n = 1506

Results

show code 
#combine all studies 1a - 1d
studies1a_1e = bind_rows(study1a %>% mutate(study = "Study 1a"), 
                        select(study1b, 'condition','trust','dishonest','secondChance','blowIt','remorse','better','redemption','gender','age','race') %>% mutate(study = "Study 1b"),
                        select(study1c, 'condition','trust','dishonest','reoffend','secondChance','remorse','better','redemption','gender','age','race') %>% mutate(study = "Study 1c"),
                        select(study1d, 'condition','trust','dishonest','reoffend','secondChance','remorse','better','redemption','gender','age','race') %>% mutate(study = "Study 1d"),
                        select(study1e, 'condition','trust','dishonest','reoffend','secondChance','remorse','better','redemption','gender','age','race') %>% mutate(study = "Study 1e")) %>% 
  mutate(ID = ifelse(is.na(ID), row_number(), ID),
         study = factor(study, levels=c('Study 1a','Study 1b','Study 1c', 'Study 1d', 'Study 1e')),
         gender = factor(gender, labels=c('Female','Male','Other')),
         race_recoded = as.factor(ifelse(grepl(",",race), "More than one race", 
                                         ifelse(grepl("1", race), "White", 
                                                ifelse(grepl("2", race), "Black", 
                                                       ifelse(grepl("3", race), "Amer. Ind. or Alaska Nat.", 
                                                              ifelse(grepl('4', race), "Asian", 
                                                                     ifelse(grepl('5', race),'Native Hawaiian or Pac. Islander', 
                                                                            ifelse(grepl('6', race), 'Other', NA)))))))))

Participants

Gender

study

Female

Male

Other

<NA>

Study 1a

303

402

4

Study 1b

69

46

Study 1c

369

388

3

Study 1d

969

532

3

Study 1e

1,002

500

3

1

Race

study

Amer. Ind. or Alaska Nat.

Asian

Black

More than one race

Native Hawaiian or Pac. Islander

Other

White

<NA>

Study 1a

6

40

59

27

11

564

2

Study 1b

8

3

5

1

97

1

Study 1c

3

56

68

16

20

595

2

Study 1d

6

27

128

24

4

28

1,286

1

Study 1e

11

72

112

42

2

27

1,238

2

Age

study

min

max

median

Study 1a

18.00

71.00

33.00

Study 1b

18.00

64.00

20.00

Study 1c

18.00

73.00

34.00

Study 1d

18.00

77.00

55.00

Study 1e

18.00

77.00

58.00

Sample size by condition

study

control

appearanceChange

<NA>

Study 1a

709

Study 1b

58

57

Study 1c

369

391

Study 1d

760

744

Study 1e

752

754

Main analyses

show code 
#alphas
nice_table(data.frame(study = levels(studies1a_1e$study), 
           alpha = c(study1a_alpha, study1b_alpha, study1c_alpha, study1d_alpha, study1e_alpha)))

study

alpha

Study 1a

0.89

Study 1b

0.91

Study 1c

0.89

Study 1d

0.93

Study 1e

0.93

show code 
#t tests
studies1a_1e_plots = bind_rows(select(study1a_long, 'condition','redemption') %>% mutate(study='Study 1a'),
                               (select(studies1a_1e, 'condition','redemption','study') %>% filter(study != "Study 1a"))) 


library(rstatix)
t.tests_study1a = study1a_long %>% t_test(redemption~condition, paired=TRUE)%>% 
  mutate(study='Study 1a',
        p = round(p, 3),
        effsize = cohens_d(study1a_long, redemption~condition, paired=TRUE)$effsize,
        design = 'within-subjects') %>% 
  select(study, statistic, df, p, effsize, design)
  
t.tests_studies1b_1e = studies1a_1e_plots %>% filter(study!='Study 1a') %>% group_by(study) %>% 
  t_test(redemption ~ condition, paired = FALSE, var.equal=TRUE) %>% mutate(p = round(p, 3)) %>% 
  inner_join(cohens_d(studies1a_1e_plots %>% filter(study!='Study 1a') %>% group_by(study), redemption~condition, paired=FALSE)) %>%  select(study, statistic, df, p, effsize) %>% 
  mutate(design = 'between-subjects')

nice_table(rbind(t.tests_study1a, t.tests_studies1b_1e))

study

statistic

df

p

effsize

design

Study 1a

-6.58

708

< .001***

-0.25

within-subjects

Study 1b

-2.02

113

.046*

-0.38

between-subjects

Study 1c

-4.97

758

< .001***

-0.36

between-subjects

Study 1d

-1.64

1,502

.102

-0.08

between-subjects

Study 1e

-2.14

1,504

.033*

-0.11

between-subjects

show code 
#meta analysis
##make dataframe of standardized mean change (raw score standardization) & sample variances for study 1a, then standardized mean differences & sample variances for studies 1b - 1d
meta_studies1a_1e = data.frame(rbind.fill(escalc(data = study1a %>% summarise(redemption_appearanceChange = mean(AC.redemption),
                                                                              redemption_control = mean(C.redemption),
                                                                              sd_appearanceChange = sd(AC.redemption),
                                                                              sd_control = sd(C.redemption),
                                                                              se_appearanceChange = sd(AC.redemption)/sqrt(n()),
                                                                              se_control = sd(C.redemption)/sqrt(n()),
                                                                              N_appearanceChange = n(),
                                                                              N_control = n(),
                                                                              r = cor(AC.redemption, C.redemption)),
                            ni = N_control, m1i = redemption_appearanceChange, m2i = redemption_control, 
                            sd1i = sd_appearanceChange, sd2i = sd_control, ri=r, measure = "SMCR", append=TRUE) %>% 
                              mutate(study='Study 1a'),
                 
                            escalc(data = reshape(Rmisc::summarySE(subset(studies1a_1e, study!='Study 1a'),measurevar='redemption', groupvars=c('condition','study')), 
                                                                                    idvar = 'study', direction = 'wide', timevar = 'condition', sep = '_'),
                                   n1i = N_appearanceChange, n2i = N_control, m1i = redemption_appearanceChange, 
                                   m2i = redemption_control, sd1i = sd_appearanceChange, sd2i = sd_control,measure = "SMD"))) %>% 
                              select(-r)

meta_plots_dataframe = meta_studies1a_1e %>% select(study, redemption_control, se_control, redemption_appearanceChange, se_appearanceChange) %>% 
  add_row(data.frame("study" = 'Meta', 
                     rma(escalc(data = meta_studies1a_1e, ni = N_control, mi = redemption_control, sdi = sd_control, measure = "MN"))[c('beta','se')],
                     rma(escalc(data = meta_studies1a_1e, ni = N_appearanceChange, mi = redemption_appearanceChange, sdi = sd_appearanceChange, measure = "MN"))[c('beta','se')]) %>%
            setNames(c('study','redemption_control', 'se_control', 'redemption_appearanceChange', 'se_appearanceChange'))) %>% 
  
  pivot_longer(2:5, 
               names_to = c(".value","condition"),
               names_pattern="(.*)_(.*)") %>% 
  mutate(effect = ifelse(grepl("Study", study), 'study', 'meta'))

####Study 1 PLOTS ####
#forest plot meta analysis
forest(rma(yi, vi, data = meta_studies1a_1e), slab=meta_studies1a_1e$study)

show code 
#means plot w/o meta means
ggerrorplot(data=studies1a_1e_plots %>% mutate(study=fct_rev(study)), x = 'study', y = 'redemption', color='condition', 
            position=position_dodge(width=0), size=1)+
  coord_flip(ylim=c(2,4))+xlab('')+ ylab("Redemption")+
  scale_color_manual(name = "Condition", values=c("gray65",'#f98400ff'), labels=c('Control','Appearance Change'))+theme_classic(base_size=20)+theme(legend.position='top')

show code 
#means plot w/ meta means
ggplot(data=meta_plots_dataframe %>% mutate(study=fct_rev(study), effect = fct_rev(effect)), aes(x = study, y = redemption, color=condition))+
  geom_errorbar(aes(ymin = redemption - se, ymax = redemption + se), width=0)+
  geom_point(size=3.5)+
  theme_classic(base_size=15)+  
  scale_color_manual(name = "", values=c('#f98400ff',"gray65"), labels=c('Appearance Change','Control'))+
  coord_flip(ylim=c(2.5,4))+
  labs(y='Redemption',x='')+
  facet_grid(rows='effect', scales='free', space='free')+
  theme(legend.position='top', 
        strip.background = element_blank(),
        strip.text.y = element_blank())

Study 2

Pre-registration

https://aspredicted.org/N9C_QQR

Notes

show code 
study2_raw = read.csv('Data/ACR15.csv') %>% filter(Progress == 100 & consent == 4)

study2 = study2_raw %>% 
  
  mutate(across(matches(".dishonest"), ~ 8 - .), #reverse code dishonest, reoffend, past & current identity overlap, responsible for past actions, past action represents current self, and same as past self
         across(matches(".reoffend"), ~ 8 - .),
         across(matches(".pastCurrent"), ~ 8 - .),
         across(matches(".responsible"), ~ 8 - .),
         across(matches(".pastAction"), ~ 8 - .),
         across(matches(".same"), ~ 8 - .)) %>% 
  
  mutate(condition = factor(condition, levels=c('control','appearance.change'), labels=c('control','appearanceChange')), #collapse redemption & distance items and adjust to 0 - 6 scale

         redemption = rowMeans(select(.,matches("dishonest"), matches("trust"), 
                                      matches("secondChance"), matches("reoffend"), 
                                      matches("changedBett"), matches("remorse")), na.rm=TRUE) -1,
         distanceFromPast = rowMeans(select(.,matches("same"), matches("pastAction"), 
                                            matches("responsible"), matches("distance"), 
                                            matches("pastCurrent")), na.rm=TRUE) -1, 
          gender = factor(gender, levels =c('1', '2', '7', '5', '1,3','2,3','1,4','1,7','4','1,2','2,4'), 
                          #gender: 1 = woman, 2 = man, 3 = trans, 7 = non-binary, 4 = queer, 5 = rather not say, 6 = not listed
                                               labels=c('Woman','Man','Non-Binary','Rather not say',
                                                        'Transgender Woman','Transgender Man','Queer Woman',
                                                        'Non-Binary Woman','Queer','Woman Man','Queer Man')),
         race_recoded = as.factor(ifelse(grepl(",",Race), "More than one race", 
                                         ifelse(grepl("1", Race), "Asian", 
                                                ifelse(grepl("2", Race), "Black/African/Caribbean", 
                                                       ifelse(grepl("3", Race), "Polynesian/Pac. Islander/Hawaiian", 
                                                              ifelse(grepl('4', Race), "Am. Indian/Alaskan Native", 
                                                                     ifelse(grepl('5', Race),'White', 
                                                                            ifelse(grepl('6', Race), 'Other',
                                                                                   ifelse(grepl('7', Race), 'Arab', NA))))))))))
  • Prolific
  • open worldwide to any adults that spoke English as their first language
  • Qualtrics title: ‘Appearance change 15 - distance from past’
  • 852 complete, non-duplicate responses collected from 04/29/2024 to 04/30/2024
  • 1 open ended bot check + 1 captcha

Results

  • Final n = 852
  • Alphas:
    • distance from past: 0.82
    • redemption: 0.85

Participants

Gender

gender

n

Woman

453

Man

365

Non-Binary

17

Rather not say

3

Transgender Woman

3

Transgender Man

3

Queer Woman

1

Non-Binary Woman

1

Queer

2

Woman Man

1

Queer Man

1

2

Race

race_recoded

n

Am. Indian/Alaskan Native

2

Arab

7

Asian

69

Black/African/Caribbean

227

More than one race

12

Other

66

Polynesian/Pac. Islander/Hawaiian

1

White

468

Age

min

max

median

18

89

29.00

Country

country

n

South Africa

227

UK

158

Canada

98

Poland

54

Portugal

39

Mexico

34

Germany

32

Italy

26

Spain

18

France

17

Netherlands

17

Hungary

16

Greece

15

Ireland

15

US

14

Chile

8

Israel

8

Norway

7

New Zealand

6

Slovenia

6

Sweden

6

Belgium

5

Australia

4

Austria

4

Denmark

4

Finland

4

3

Czech Republic

2

Latvia

2

Estonia

1

Luxembourg

1

Switzerland

1

Sample size by condition

condition

n

control

424

appearanceChange

428

Main effects

show code 
nice_table(study2 %>% group_by(condition) %>% summarize(mean_redemption = mean(redemption), sd_redemption = sd(redemption),
                                             m_distance = mean(distanceFromPast), sd_distance = sd(distanceFromPast)))

condition

mean_redemption

sd_redemption

m_distance

sd_distance

control

2.90

0.66

2.20

0.68

appearanceChange

3.10

0.61

2.57

0.64

show code 
study2_plots = study2 %>% 
  select('condition','redemption','distanceFromPast') %>% 
  pivot_longer(2:3, 
               names_to = "variable")

nice_table(study2_plots %>% group_by(variable) %>% 
  t_test(value ~ condition, paired = FALSE, var.equal=TRUE) %>% mutate(p = round(p, 3)) %>% 
  inner_join(cohens_d(study2_plots %>% group_by(variable), value~condition, paired=FALSE)) %>%  
  select(variable, statistic, df, p, effsize))

variable

statistic

df

p

effsize

distanceFromPast

-8.05

850

< .001***

-0.55

redemption

-4.53

850

< .001***

-0.31

show code 
ggerrorplot(data=study2_plots, x = 'variable', y = 'value', color='condition', 
            position=position_dodge(width=0), size=0.75)+
  coord_flip(ylim=c(2,4))+xlab('')+ ylab("")+
  scale_color_manual(name = "Condition", values=c("gray65",'#f98400ff'), guide="none")+theme_classic(base_size=25)

Mediation

show code 
model_aPath = lm(distanceFromPast ~ condition, data=study2)
model_bPath = lm(redemption ~ condition + distanceFromPast, data=study2)
study2_mediation = mediate(model_aPath, model_bPath, treat='condition', mediator='distanceFromPast', boot=TRUE, sims=10000)
Warning in mediate(model_aPath, model_bPath, treat = "condition", mediator =
"distanceFromPast", : treatment and control values do not match factor levels;
using control and appearanceChange as control and treatment, respectively
show code 
summary(model_aPath)

Call:
lm(formula = distanceFromPast ~ condition, data = study2)

Residuals:
     Min       1Q   Median       3Q      Max 
-2.16519 -0.40264 -0.00264  0.43481  2.19736 

Coefficients:
                          Estimate Std. Error t value Pr(>|t|)    
(Intercept)                2.20264    0.03192  69.012  < 2e-16 ***
conditionappearanceChange  0.36254    0.04503   8.051 2.76e-15 ***
---
Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1

Residual standard error: 0.6572 on 850 degrees of freedom
Multiple R-squared:  0.07085,   Adjusted R-squared:  0.06976 
F-statistic: 64.82 on 1 and 850 DF,  p-value: 2.764e-15
show code 
summary(study2_mediation)

Causal Mediation Analysis 

Nonparametric Bootstrap Confidence Intervals with the Percentile Method

               Estimate 95% CI Lower 95% CI Upper p-value    
ACME             0.2094       0.1540         0.27  <2e-16 ***
ADE             -0.0110      -0.0802         0.06    0.77    
Total Effect     0.1984       0.1145         0.28  <2e-16 ***
Prop. Mediated   1.0554       0.7690         1.64  <2e-16 ***
---
Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1

Sample Size Used: 852 


Simulations: 10000

Study 3

show code 
study3_raw = read.csv('Data/ACR3.2.csv') %>% 
  mutate(across(c(starts_with("male.1."), -male.1.faceOrder), ~ replace(., (male.1.faceOrder=="Z.B" | male.1.faceOrder == "Y.A") & run ==1, NA)),
         across(c(starts_with("male.2."), -male.2.faceOrder), ~ replace(., male.2.faceOrder=="Z.B" & run ==1, NA))) %>% 
  filter(botCheck!="")

study3 = study3_raw %>% 
  filter(att.Check == 1 & attCheck2 ==1 & attCheck3 == 7 & attCheck4 == 7) %>% 
  
  mutate(across(matches(".dishonest"), ~ 8 - .), #reverse code dishonest & likelihood to drive home
         across(matches(".driveHome"), ~ 8 - .)) %>% 
  
  mutate(trust = rowMeans(select(.,matches(".dishonest"), matches(".trust")), na.rm=TRUE) -1, #collapse all variables and change from 1-7 to 0-6 scale
         futureBehavior = rowMeans(select(.,matches(".return"), matches(".driveHome"), matches(".volunteer"), matches(".overcharged")), na.rm=TRUE) -1,
         
         change.condition = factor(change.condition, levels=c('control','appearance.change'), labels=c('control','appearanceChange')),
         action.condition = factor(action.condition, levels=c('transgressor','saint')))
  • MTurk
  • Qualtrics title: ‘Appearance change and redemption 3.2 - saints v sinners 2.0’
  • 1200 complete, non-duplicate responses collected on 04/09/2019
  • 4 attention checks (“please select [x] for this question”)
  • Also collected:
    • bot check
    • politics
    • ratings of ethicality of each action
    • warmth
  • There was an error in run 1 that broke some images:
    • the after image for 37 participants who were randomly assigned to see male 2 in “Z.B” order
    • the after image for 37 participants who were randomly assigned to see male 2 in “Z.B” order
    • the before image for 36 participants who were randomly assigned to see male 1 in “Y.A” order
    • As a result, I removed a total of 98 ratings for male 1 or male 2. The rest of each participants’ ratings were averaged without those targets

Results

Final n = 1159

show code 
table(study3$action.condition, study3$change.condition)
              
               control appearanceChange
  transgressor     282              299
  saint            291              287
show code 
nice_table(study3 %>% group_by(action.condition) %>% 
  t_test(trust ~ change.condition, paired = FALSE, var.equal=TRUE) %>% mutate(p = round(p, 3)) %>% 
  inner_join(cohens_d(study3 %>% group_by(action.condition), trust~change.condition, paired=FALSE)) %>%  
  select(action.condition, .y., statistic, df, p, effsize))

action.condition

.y.

statistic

df

p

effsize

transgressor

trust

-3.14

579

.002**

-0.26

saint

trust

3.39

576

.001**

0.28

show code 
nice_table(study3 %>% group_by(action.condition) %>% 
  t_test(futureBehavior ~ change.condition, paired = FALSE, var.equal=TRUE) %>% mutate(p = round(p, 3)) %>% 
  inner_join(cohens_d(study3 %>% group_by(action.condition), futureBehavior~change.condition, paired=FALSE)) %>%  
  select(action.condition, .y., statistic, df, p, effsize))

action.condition

.y.

statistic

df

p

effsize

transgressor

futureBehavior

-1.96

579

.050

-0.16

saint

futureBehavior

3.59

576

< .001***

0.30

show code 
ggarrange(
  ggerrorplot(data=study3, x='change.condition', y='trust',color='action.condition', alpha=0.25, palette=c("#ea4335", '#4285f4'), position=position_dodge(width=0))+
    stat_summary(fun.data = "mean_se", geom = "line", aes(group = action.condition, color=action.condition))+
    xlab('')+ggtitle('\nTrustworthy')+ylab('')+
    coord_cartesian(ylim=c(1.5,5))+
    theme(plot.title = element_text(hjust = 0),
          panel.grid.major.y = element_line(colour='gray85', linewidth=0.5),
          legend.title=element_blank()),
  
  ggerrorplot(data=study3, x='change.condition', y='futureBehavior',color='action.condition', alpha=0.25, palette=c("#ea4335", '#4285f4'), position=position_dodge(width=0))+
    stat_summary(fun.data = "mean_se",geom = "line", aes(group = action.condition, color=action.condition))+
    xlab('')+ggtitle('Future Behavior', subtitle='(higher #s = positive)')+ylab('')+
    coord_cartesian(ylim=c(1.5,5))+
    theme(plot.title = element_text(hjust = 0),
          panel.grid.major.y = element_line(colour='gray85', linewidth=0.5),
          legend.title=element_blank()),
  
  common.legend=TRUE)

Study 4

show code 
study4_raw = read.csv('Data/ACR11.csv') %>% 
  filter(botCheck!="")

study4 = study4_raw %>% 
  
  mutate(across(matches("dishonest"), ~ 8 - .), #reverse code dishonest & likelihood to drive home
         across(matches("mean"), ~ 8 - .),
         across(matches("reoffend"), ~ 8 - .)) %>% 
  
  mutate(id = row_number())  %>% 
  select(c(contains('DV1'), contains('DV2'), contains('condition'), id, -contains('attCheck'))) %>% 
  rename_with(~ str_remove(., "_DV."), everything()) %>% 
  
  pivot_longer(fear_male.1:remorse_female.2, 
               names_to = c("variable", "target"),
               names_pattern="(.*)_(.*)") %>% 
  spread(variable, value) %>% 
  mutate(condition = case_when(target=="female.1" ~ female.1.condition, 
                               target=="female.2" ~female.2.condition,
                               target=="male.1" ~male.1.condition,
                               target=='male.2'~male.2.condition))%>%
  arrange(id) %>% 
  mutate(condition = factor(condition, levels=c('control','appearance.change'), labels=c('control','appearanceChange')),
         trustworthy = rowMeans(.[c('dishonest', 'trust')]) -1,
         warmth = rowMeans(.[c('warm', 'mean')], na.rm=TRUE) -1,
         redemption = rowMeans(.[c('dishonest','trust','reoffend', 'remorse','secondChance')]) -1,
         feelingsHeart = rowMeans(.[c('embarrass','knowingRightWrong','guilt', 'love')], na.rm=TRUE) -1,
         feelingsBody = rowMeans(.[c('fear','joy','selfAware')]) -1,
         feelingsMind = rowMeans(.[c('workingGoal','reasoning','remembering')]) -1,
         humanization = rowMeans(.[c('embarrass','knowingRightWrong','guilt', 'love', 'fear','joy','selfAware','workingGoal','reasoning','remembering')], na.rm=TRUE) -1) %>% #### LINES AFTER THIS WILL TRANSFORM DATAFRAME INTO SUMMARY OF DVS BY CONDITION RATHER THAN BY TARGET
  
  group_by(id, condition) %>% 
  summarise_at(vars(trustworthy, warmth, redemption, feelingsHeart, feelingsBody, feelingsMind, humanization, reoffend, remorse), mean) %>% 
  as.data.frame()
  • Prolific
  • Qualtrics title: ‘Appearance change 11 - humanization’
  • 177 complete, non-duplicate responses collected on 09/10/2020
  • 4 attention/bot checks (“highlight the date of [target’s] release in [color]”). Kicked out if not correct
  • Also collected:
    • free response bot check
    • moral theory
    • warmth

Results

Final n = 177

show code 
study4_plots = study4 %>% 
  select('id','condition','redemption','humanization') %>% 
  pivot_longer(3:4, 
               names_to = "variable")

ggerrorplot(data=study4_plots, x = 'variable', y = 'value', color='condition', 
            position=position_dodge(width=0), size=1)+
  coord_flip(ylim=c(2,4))+xlab('')+ ylab("")+
  scale_color_manual(name = "Condition",values=c("gray65",'#f98400ff'), guide="none")+theme_classic(base_size=25)

show code 
nice_table(study4_plots %>% group_by(variable) %>% 
  t_test(value ~ condition, paired = TRUE) %>% mutate(p = round(p, 3)) %>% 
  inner_join(cohens_d(study4_plots %>% group_by(variable), value~condition, paired=TRUE)) %>%  select(variable, statistic, df, p, effsize))

variable

statistic

df

p

effsize

humanization

-3.19

176

.002**

-0.24

redemption

-4.49

176

< .001***

-0.34