Based on the peer reviews I received, I realized that there is nothing to indicate what the values on the x-axis and the colors mean.
This plot visualizes the average scores for individualizing and binding foundations across countries.
The values on the x-axis range from 0 (i.e., Strongly Disagree) to 5 (i.e., Strongly Agree).
The final version was improved by (1) modifying the x-axis and (2) explaining the meaning of the colors (i.e., each color represents a country).
Descriptive Statistics
The table below represents the average scores (i.e., mean) for each country as well as standard deviations, minimum and maximum values.
This is the first version of the plot. There is a lot to work on here. Both axes and legend labels seem confusing. X-axis scale is also not complete. Also, it is hard to see any patterns without using facet_wrap and sorting the values.
The revised version looks much better. You can see interesting patterns such as Spain’s scores. The colors are terrible, though. Also, it’d be nice to see the grand mean to have a general reference category.
Based on the peer review I received, I realized that the order of the variables in the legend is reversed. However, because I could not find a way to reorder the names in the legend, I recreated the whole plot from scratch using ggplot2 code.
The plot describes the fixed effects for the models described below. The coefficients are unstandardized and represented by the dots. The lines represent the 95% confidence intervals.
Findings
Predicting Individualizing and Binding Moral Values | ||||||
---|---|---|---|---|---|---|
Across 19 Countries | ||||||
Binding | Individualizing | |||||
B | SE | p | B | SE | p | |
Level 1 | ||||||
Sex [Female] | 0.01 | 0.03 | 0.8088 | 0.23 | 0.03 | 0.0000 |
Level 2 | ||||||
Population Sex Ratio | −1.18 | 2.31 | 0.6286 | −2.61 | 1.77 | 0.2562 |
Individualism | −0.00 | 0.01 | 0.7373 | −0.02 | 0.01 | 0.0498 |
Masculinity | 0.00 | 0.00 | 0.2604 | 0.01 | 0.00 | 0.2149 |
Gender Equality | 2.76 | 1.40 | 0.0982 | 3.22 | 1.00 | 0.0965 |
Human Development Index | −3.30 | 2.87 | 0.2957 | 1.82 | 2.10 | 0.4782 |
Overall Life Satisfaction Index | 0.44 | 0.40 | 0.3125 | 0.61 | 0.28 | 0.1908 |
The initial dot-whisker plot for the fixed effects. Added a vertical line, which made the plot a bit easier to interpret. However, legend looks awful. Modifying the x axis should also help.
Easier to see the points. The legend makes sense now, but still could be better. Colors can be improved. Also, there are too many grid lines.
Based on the peer review, I changed the limits of y-axis, making them the same. Also, I added the raw data for the plots. I highlighted four countries from different cultures.
The plot describes the random effects for the countries where gender equality predicts moral values. The plots describe the different outcome values at different levels of gender equality for each country. The table below shows the raw data for the plot.
Findings
The initial attempt to visualize the predicted values of moral foundations where the predictor is gender equality. I chose this predictor because it was the only that was significant for both outcomes. I am glad that it worked, but it needs improvement.
This version is better, but it would be nicer to see which countries are at the top, middle, and bottom of the plot.
The plot describes the predicted values of moral values by sex. The table below represents models where moral value is predicted by sex separate for each country.
Findings
Predicting Moral Values by Sex for Each Country | ||||||
---|---|---|---|---|---|---|
Binding | Individualizing | |||||
B | SE | p | B | SE | p | |
Australia | ||||||
Intercept | 2.68 | 0.03 | 0.000 | 3.90 | 0.02 | 0.000 |
Sex [Male] | 0.05 | 0.05 | 0.328 | −0.26 | 0.04 | 0.000 |
Japan | ||||||
Intercept | 2.58 | 0.03 | 0.000 | 3.45 | 0.03 | 0.000 |
Sex [Male] | 0.08 | 0.05 | 0.106 | −0.02 | 0.05 | 0.770 |
Belgium | ||||||
Intercept | 2.31 | 0.04 | 0.000 | 3.37 | 0.03 | 0.000 |
Sex [Male] | 0.08 | 0.07 | 0.227 | −0.21 | 0.05 | 0.000 |
Netherlands | ||||||
Intercept | 2.35 | 0.05 | 0.000 | 3.25 | 0.04 | 0.000 |
Sex [Male] | −0.05 | 0.09 | 0.617 | −0.19 | 0.07 | 0.010 |
China | ||||||
Intercept | 2.81 | 0.04 | 0.000 | 3.34 | 0.04 | 0.000 |
Sex [Male] | 0.01 | 0.06 | 0.873 | −0.15 | 0.07 | 0.026 |
France | ||||||
Intercept | 2.40 | 0.04 | 0.000 | 3.47 | 0.04 | 0.000 |
Sex [Male] | −0.27 | 0.10 | 0.007 | −0.17 | 0.09 | 0.064 |
Hungary | ||||||
Intercept | 2.64 | 0.05 | 0.000 | 3.71 | 0.04 | 0.000 |
Sex [Male] | 0.08 | 0.09 | 0.341 | −0.31 | 0.06 | 0.000 |
Iran | ||||||
Intercept | 3.27 | 0.05 | 0.000 | 3.65 | 0.05 | 0.000 |
Sex [Male] | −0.12 | 0.08 | 0.121 | −0.17 | 0.07 | 0.010 |
Korea | ||||||
Intercept | 2.57 | 0.03 | 0.000 | 3.36 | 0.03 | 0.000 |
Sex [Male] | 0.09 | 0.05 | 0.072 | −0.11 | 0.05 | 0.024 |
Latvia | ||||||
Intercept | 2.75 | 0.04 | 0.000 | 3.65 | 0.04 | 0.000 |
Sex [Male] | −0.18 | 0.09 | 0.036 | −0.38 | 0.08 | 0.000 |
Mongolia | ||||||
Intercept | 3.12 | 0.05 | 0.000 | 3.13 | 0.06 | 0.000 |
Sex [Male] | −0.07 | 0.08 | 0.382 | −0.13 | 0.09 | 0.144 |
Poland | ||||||
Intercept | 2.81 | 0.03 | 0.000 | 4.01 | 0.02 | 0.000 |
Sex [Male] | −0.12 | 0.04 | 0.006 | −0.35 | 0.03 | 0.000 |
Russia | ||||||
Intercept | 2.89 | 0.03 | 0.000 | 3.54 | 0.04 | 0.000 |
Sex [Male] | −0.01 | 0.07 | 0.851 | −0.47 | 0.07 | 0.000 |
Serbia | ||||||
Intercept | 3.27 | 0.09 | 0.000 | 3.60 | 0.09 | 0.000 |
Sex [Male] | −0.14 | 0.13 | 0.274 | −0.16 | 0.13 | 0.205 |
Spain | ||||||
Intercept | 2.08 | 0.04 | 0.000 | 3.91 | 0.04 | 0.000 |
Sex [Male] | −0.18 | 0.10 | 0.073 | −0.07 | 0.08 | 0.366 |
Sweden | ||||||
Intercept | 2.52 | 0.02 | 0.000 | 3.65 | 0.02 | 0.000 |
Sex [Male] | 0.03 | 0.03 | 0.392 | −0.27 | 0.03 | 0.000 |
Turkey | ||||||
Intercept | 2.82 | 0.03 | 0.000 | 3.94 | 0.02 | 0.000 |
Sex [Male] | 0.11 | 0.05 | 0.017 | −0.20 | 0.03 | 0.000 |
UK | ||||||
Intercept | 2.55 | 0.05 | 0.000 | 3.71 | 0.04 | 0.000 |
Sex [Male] | −0.11 | 0.08 | 0.199 | −0.19 | 0.07 | 0.004 |
US | ||||||
Intercept | 2.69 | 0.06 | 0.000 | 3.74 | 0.04 | 0.000 |
Sex [Male] | −0.02 | 0.09 | 0.791 | −0.18 | 0.06 | 0.003 |
---
title: "Moral Values Across Countries"
output:
flexdashboard::flex_dashboard:
orientation: columns
vertical_layout: fill
source_code: embed
theme: united
---
```{r setup, include=FALSE}
# global options
knitr::opts_chunk$set(echo = FALSE,
tidy = TRUE,
cache = FALSE,
message = FALSE,
error = FALSE,
warning = FALSE)
# packages
library(flexdashboard)
library(here)
library(rio)
library(tidyverse)
library(magrittr)
library(lme4)
library(lmerTest)
library(dotwhisker)
library(tidytext)
library(ggeffects)
library(htmlwidgets)
library(gt)
library(gghighlight)
library(broom)
theme_set(theme_minimal()) # set theme
options(scipen = 999) # remove scientific notation
```
```{r wrangling, include = FALSE}
# import data
df <- import(here("data", "ALL_MFQ30.csv"), # moral values, countries, & sex
setclass = "tbl_df") %>%
janitor::clean_names()
df_c <- import(here("data", "Data_S1_sec.csv"), # country-level variables
setclass = "tbl_df") %>%
janitor::clean_names()
# data wrangling
df %<>%
drop_na() %>%
mutate(
across(where(is.double), as.numeric),
across(where(is.character), as.factor),
sex = recode(sex,
`1` = "Male",
`0` = "Female",
.default = NA_character_),
indiv = rowMeans(
select(., harm_avg, fairness_avg) # individualizing moral foundations
),
bind = rowMeans(
select(., ingroup_avg:purity_avg) # binding moral foundations
)
)
# descriptive statistics by country
c_desc <-
df %>%
pivot_longer(cols = c(indiv, bind),
names_to = "vars",
values_to = "val"
) %>%
select(country, vars, val) %>%
group_by(country, vars) %>%
summarise(mean = mean(val, na.rm = TRUE),
sd = sd(val, na.rm = TRUE),
min = min(val, na.rm = TRUE),
max = max(val, na.rm = TRUE),
.groups = "drop"
) %>%
mutate(vars = fct_recode(vars,
Individualizing = "indiv",
Binding = "bind"
)
)
# descriptive statistics by country and sex
c_s_desc <-
df %>%
filter(country != "Poland") %>% # Poland has missing data in sex.
pivot_longer(cols = c(indiv, bind),
names_to = "vars",
values_to = "val"
) %>%
group_by(country, sex, vars) %>%
summarise(mean = mean(val, na.rm = TRUE),
sd = sd(val, na.rm = TRUE),
min = min(val, na.rm = TRUE),
max = max(val, na.rm = TRUE),
.groups = "drop"
) %>%
mutate(vars = fct_recode(vars,
Individualizing = "indiv",
Binding = "bind"
)
)
```
# Values X Country
Background {.sidebar}
-----------------------------------------------------------------------
**Data**
Data used in this dashboard come from the second study of [Atari et al. (2020)](http://dx.doi.org/10.1098/rspb.2020.1201), which can be downloaded from [Kaggle](https://www.kaggle.com/tunguz/sex-differences-in-moral-judgements-67-countries).
This study has data on moral values in 19 countries. There is also a second dataset with country-level variables.
**Country-level variables**
Population Sex Ratio
Individualism
Masculinity
Gender Equality
Human Development Index
Overall Life Satisfaction Index
**Definitions**
Moral foundations theory [(Graham et al., 2013)](https://doi.org/10.1016/B978-0-12-407236-7.00002-4) argues that there are five universal moral values. These five values have been grouped into two overarching moral values [(Graham et al., 2009)](http://dx.doi.org/10.1037/a0015141) as individualizing and binding moral values.
*Individualizing* values encompass moral foundations of care (i.e., cherishing and protecting others) and fairness (i.e., rendering justice according to shared rules).
*Binding* values encompass moral foundations of loyalty (i.e., standing with your group, family, nation), authority (i.e., submitting to tradition and legitimate authority), and purity (i.e., abhorrence for disgusting things, foods, actions).
**Example Items**
Please read the following sentences and indicate your agreement or disagreement:
Individualizing: Compassion for those who are suffering is the most crucial virtue.
Binding: People should be loyal to their family members, even when they have done something wrong.
Column {.tabset .tabset-fade data-width=600}
-----------------------------------------------------------------------
### **Final Version**
```{r}
gmeans <-
c_desc %>%
group_by(vars) %>%
summarise(m = mean(mean))
c_desc %>%
ggplot() +
geom_vline(
data = gmeans,
aes(xintercept = m),
linetype = 2,
alpha = .6
) +
geom_vline(
data = data.frame(x = seq(0,5,1)),
aes(xintercept = x),
color = "gray80",
alpha = .6
) +
geom_hline(aes(yintercept = 0.5),
alpha = .6,
color = "gray80") +
geom_col(
aes(mean, reorder_within(country, mean, vars),
fill = country
),
alpha = .7,
position = position_nudge(y = -0.05)
) +
scale_y_reordered() +
scale_x_continuous(expand = c(0, 0.32),
limits = c(0, 5),
breaks = c(0, 5),
labels = c("Strongly\nDisagree",
"Strongly\nAgree")
) +
facet_wrap(~factor(vars,
levels = c("Binding",
"Individualizing"
)
),
scales = "free_y",
ncol = 2) +
theme(
plot.title.position = "plot",
panel.grid.major = element_blank(),
panel.grid.minor = element_blank(),
legend.position = "none",
axis.text.y = element_text(color = "black",
size = 11),
axis.text.x = element_text(color = "black",
size = 8,
hjust = .5),
axis.title = element_blank(),
strip.background.x = element_rect(color = "gray80",
size = 1),
strip.text.x = element_text(face = "bold")
) +
labs(
title = "Endorsement of Individualizing and Binding Moral Values Across Countries",
caption = "\n\nDashed lines represent the average of all countries.\nColors represent the countries."
)
```
### Before Peer Review
```{r}
c_desc %>%
ggplot() +
geom_vline(data = gmeans,
aes(xintercept = m),
linetype = 2,
alpha = .6) +
geom_col(
aes(mean, reorder_within(country, mean, vars),
fill = country,
alpha = .9
)
) +
scale_y_reordered() +
scale_x_continuous(expand = c(0, 0)
) +
facet_wrap(~vars,
scales = "free_y",
ncol = 2) +
theme(
plot.title.position = "plot",
panel.grid.major.y = element_blank(),
panel.grid.minor.y = element_blank(),
legend.position = "none",
axis.text.y = element_text(color = "black",
size = 11),
axis.text.x = element_text(color = "black",
size = 9),
axis.title = element_blank()
) +
labs(
title = "Endorsement of Individualizing and Binding Moral Values Across Countries",
caption = "Vertical lines represent the average of all countries."
)
```
> Based on the peer reviews I received, I realized that there is nothing to indicate what the values on the x-axis and the colors mean.
Column {.tabset .tabset-fade data-width=400}
-----------------------------------------------------------------------
### About
This plot visualizes the average scores for individualizing and binding foundations across countries.
The values on the x-axis range from 0 (i.e., Strongly Disagree) to 5 (i.e., Strongly Agree).
The final version was improved by (1) modifying the x-axis and (2) explaining the meaning of the colors (i.e., each color represents a country).
**Descriptive Statistics**
The table below represents the average scores (i.e., mean) for each country as well as standard deviations, minimum and maximum values.
```{r}
DT::datatable(c_desc,
colnames = c("Country", "Moral Value",
"Mean", "SD", "Min", "Max"),
rownames = FALSE,
filter = "none",
options = list(scrollX = TRUE,
pageLength = 6,
searching = FALSE,
columnDefs = list(list(className = "dt-center",
targets = "_all")
),
lengthChange = FALSE,
initComplete = JS(
"function(settings, json) {",
"$(this.api().table().header()).css({'background-color': '#9f939c', 'color': '#fff'});",
"}")
)
) %>%
DT::formatRound(columns = c("mean", "sd", "min", "max"),
digits = 2)
```
### Version 1
```{r}
c_desc %>%
ggplot() +
geom_col(
aes(mean, country, fill = vars),
position = "dodge"
) +
theme(
panel.grid.major.y = element_blank(),
panel.grid.minor.y = element_blank()
) +
scale_x_continuous(expand = c(0, 0))
```
> This is the first version of the plot. There is a lot to work on here. Both axes and legend labels seem confusing. X-axis scale is also not complete. Also, it is hard to see any patterns without using facet_wrap and sorting the values.
### Version 2
```{r}
c_desc %>%
ggplot() +
geom_col(
aes(mean, reorder_within(country, mean, vars)
)
) +
scale_y_reordered() +
scale_x_continuous(expand = c(0, 0)
) +
facet_wrap(~vars,
scales = "free_y",
ncol = 2) +
theme(
panel.grid.major.y = element_blank(),
panel.grid.minor.y = element_blank(),
axis.text.y = element_text(color = "black",
size = 11),
axis.text.x = element_text(color = "black",
size = 9),
axis.title = element_blank()
) +
labs(
title = "Endorsement of Individualizing and Binding Moral Values Across Countries"
)
```
> The revised version looks much better. You can see interesting patterns such as Spain's scores. The colors are terrible, though. Also, it'd be nice to see the grand mean to have a general reference category.
# Predictors of moral values
Background {.sidebar}
-----------------------------------------------------------------------
**Data**
Data used in this dashboard come from the second study of [Atari et al. (2020)](http://dx.doi.org/10.1098/rspb.2020.1201), which can be downloaded from [Kaggle](https://www.kaggle.com/tunguz/sex-differences-in-moral-judgements-67-countries).
This study has data on moral values in 19 countries. There is also a second dataset with country-level variables.
**Country-level variables**
Population Sex Ratio
Individualism
Masculinity
Gender Equality
Human Development Index
Overall Life Satisfaction Index
**Definitions**
Moral foundations theory [(Graham et al., 2013)](https://doi.org/10.1016/B978-0-12-407236-7.00002-4) argues that there are five universal moral values. These five values have been grouped into two overarching moral values [(Graham et al., 2009)](http://dx.doi.org/10.1037/a0015141) as individualizing and binding moral values.
*Individualizing* values encompass moral foundations of care (i.e., cherishing and protecting others) and fairness (i.e., rendering justice according to shared rules).
*Binding* values encompass moral foundations of loyalty (i.e., standing with your group, family, nation), authority (i.e., submitting to tradition and legitimate authority), and purity (i.e., abhorrence for disgusting things, foods, actions).
**Example Items**
Please read the following sentences and indicate your agreement or disagreement:
Individualizing: Compassion for those who are suffering is the most crucial virtue.
Binding: People should be loyal to their family members, even when they have done something wrong.
Column {.tabset .tabset-fade data-width=600}
-----------------------------------------------------------------------
```{r MLM, include=FALSE}
# merge country-level data with the main dataset
df <- left_join(df,
select(df_c, country:overall_life_satisfaction_index),
by = "country")
# MLM
model_i <- lmer(indiv ~ relevel(sex, ref = 2) + # level 1 predictor
# level 2 predictors:
pop_sex_ratio + individualism + masculinity +
gender_eqality + human_development_index +
overall_life_satisfaction_index +
(sex | country), # random slope for sex
# random intercept for country
data = df
)
model_b <- lmer(bind ~ relevel(sex, ref = 2) + # level 1 predictor
# level 2 predictors:
pop_sex_ratio + individualism + masculinity +
gender_eqality + human_development_index +
overall_life_satisfaction_index +
(sex | country), # random slope for sex
# random intercept for country
data = df
)
# extract coefficients
m_i_fixed <-
broom.mixed::tidy(model_i) %>%
filter(effect == "fixed",
term != "(Intercept)") %>%
select(-c(effect, group)) %>%
mutate(
term = recode(term,
`relevel(sex, ref = 2)Female` = "Sex [Female]",
`pop_sex_ratio` = "Population Sex Ratio",
`individualism` = "Individualism",
`masculinity` = "Masculinity",
`gender_eqality` = "Gender Equality",
`human_development_index` = "Human Development Index",
`overall_life_satisfaction_index` = "Overall Life Satisfaction Index"),
model = "Individualizing",
) %>%
relocate(model, term)
m_b_fixed <-
broom.mixed::tidy(model_b) %>%
filter(effect == "fixed",
term != "(Intercept)") %>%
select(-c(effect, group)) %>%
mutate(
term = recode(term,
`relevel(sex, ref = 2)Female` = "Sex [Female]",
`pop_sex_ratio` = "Population Sex Ratio",
`individualism` = "Individualism",
`masculinity` = "Masculinity",
`gender_eqality` = "Gender Equality",
`human_development_index` = "Human Development Index",
`overall_life_satisfaction_index` = "Overall Life Satisfaction Index"),
model = "Binding",
) %>%
relocate(model, term)
both_ms <- bind_rows(m_i_fixed, m_b_fixed)
```
### **Final Version**
```{r}
# Tried to reorder the y axis, but this didn't work for some reason.
# both_ms %<>%
# mutate(
# term = factor(term,
# levels = c("Sex [Female]",
# "Population Sex Ratio",
# "Individualism",
# "Masculinity",
# "Gender Equality",
# "Human Development Index",
# "Overall Life Satisfaction Index"
# )
# )
# )
ggplot() +
geom_vline(xintercept = 0,
colour = "grey60",
linetype = 2) +
geom_errorbarh(data = filter(both_ms, model == "Individualizing"),
aes(xmin = estimate + qnorm(0.025)*std.error,
xmax = estimate + qnorm(0.975)*std.error,
y = term,
color = "Individualizing"),
position = position_nudge(y = -.1),
height = 0
) +
geom_point(data = filter(both_ms, model == "Individualizing"),
aes(estimate, term, color = "Individualizing"),
position = position_nudge(y = -.1),
size = 1.75
) +
geom_errorbarh(data = filter(both_ms, model == "Binding"),
aes(xmin = estimate - 1.96*std.error,
xmax = estimate + 1.96*std.error,
y = term,
color = "Binding"),
position = position_nudge(y = .1),
height = 0
) +
geom_point(data = filter(both_ms, model == "Binding"),
aes(estimate, term, color = "Binding"),
position = position_nudge(y = .1),
size = 1.75
) +
scale_color_manual(name = "",
values = c("Individualizing" = "cornflowerblue",
"Binding" = "#F8766D")
) +
scale_x_continuous(n.breaks = 10) +
theme(plot.title = element_text(vjust = 3),
plot.title.position = "plot",
axis.text.y = element_text(color = "black",
size = 11),
axis.title.y = element_blank(),
legend.justification = c(0, 0),
legend.position = c(.65, .85),
legend.background = element_rect(colour = "grey80"),
legend.title = element_blank(),
panel.grid.major.y = element_blank()
) +
labs(title = "Predicting moral values by sex and country-level predictors",
x = "Unstandardized Coefficient")
```
### Before Peer Review
```{r}
dwplot(both_ms,
dot_args = list(size = 2)
) +
ggtitle("Predicting moral values by sex and country-level predictors") +
xlab("Unstandardized Coefficient") +
geom_vline(xintercept = 0,
colour = "grey60",
linetype = 2) +
theme(plot.title = element_text(face = "bold", vjust = 3),
plot.title.position = "plot",
axis.text.y = element_text(color = "black",
size = 11),
legend.justification = c(0, 0),
legend.position = c(.65, .85),
legend.background = element_rect(colour = "grey80"),
legend.title = element_blank(),
panel.grid.major.y = element_blank()
) +
scale_x_continuous(n.breaks = 10) +
scale_color_manual(values = c("cornflowerblue", "#F8766D"))
```
> Based on the peer review I received, I realized that the order of the variables in the legend is reversed. However, because I could not find a way to reorder the names in the legend, I recreated the whole plot from scratch using ggplot2 code.
Column {.tabset .tabset-fade data-width=400}
-----------------------------------------------------------------------
### About
The plot describes the fixed effects for the models described below. The coefficients are unstandardized and represented by the dots. The lines represent the 95% confidence intervals.
**Findings**
```{r}
table <-
bind_cols(
subset(both_ms, model == "Binding",
select = c(term:std.error, p.value)
),
subset(both_ms, model == "Individualizing",
select = c(term:std.error, p.value)
)
) %>%
rename(
term1 = 1, term2 = 5,
est1 = 2, est2 = 6,
se1 = 3, se2 = 7,
p1 = 4, p2 = 8
)
table %>%
select(-term2) %>%
mutate(gr = c("Level 1", rep("Level 2", 6))) %>%
group_by(gr) %>%
gt() %>%
tab_header(
title = "Predicting Individualizing and Binding Moral Values",
subtitle = "Across 19 Countries"
) %>%
cols_label(term1 = "",
est1 = md("*B*"),
se1 = "SE",
p1 = "p",
est2 = md("*B*"),
se2 = "SE",
p2 = "p") %>%
tab_spanner(
label = "Binding",
columns = vars(est1, se1, p1)
) %>%
tab_spanner(
label = "Individualizing",
columns = vars(est2, se2, p2)
) %>%
fmt_number(columns = vars(est1, se1,
est2, se2),
decimals = 2) %>%
fmt_number(columns = vars(p1, p2),
decimals = 4
) %>%
cols_align(
columns = "term1",
align = "right"
) %>%
opt_row_striping() %>%
tab_options(
heading.background.color = "#9f939c",
table.font.size = "100%"
) %>%
tab_style(
style = list(
cell_text(weight = "bold")
),
locations = cells_body(
columns = vars(p1),
rows = p1 < .05
)
)
```
### Version 1
```{r}
dwplot(both_ms) +
ggtitle("Predicting moral values") +
xlab("Unstandardized Coefficient") +
geom_vline(xintercept = 0,
colour = "grey60",
linetype = 2)
```
> The initial dot-whisker plot for the fixed effects. Added a vertical line, which made the plot a bit easier to interpret. However, legend looks awful. Modifying the x axis should also help.
### Version 2
```{r}
dwplot(both_ms,
dot_args = list(size = 2)
) +
ggtitle("Predicting moral values by sex and country-level predictors") +
xlab("Unstandardized Coefficient") +
geom_vline(xintercept = 0,
colour = "grey60",
linetype = 2) +
theme(plot.title = element_text(face = "bold"),
plot.title.position = "plot",
axis.text.y = element_text(color = "black",
size = 11),
legend.justification = c(0, 0),
legend.position = c(.74, .85),
legend.background = element_rect(colour = "grey80"),
legend.title.align = .5
) +
scale_x_continuous(n.breaks = 10) +
scale_color_manual(values = c("blue", "red"))
```
> Easier to see the points. The legend makes sense now, but still could be better. Colors can be improved. Also, there are too many grid lines.
# Predicted Values of Moral Values by Gender Equality
Background {.sidebar}
-----------------------------------------------------------------------
**Data**
Data used in this dashboard come from the second study of [Atari et al. (2020)](http://dx.doi.org/10.1098/rspb.2020.1201), which can be downloaded from [Kaggle](https://www.kaggle.com/tunguz/sex-differences-in-moral-judgements-67-countries).
This study has data on moral values in 19 countries. There is also a second dataset with country-level variables.
**Country-level variables**
Population Sex Ratio
Individualism
Masculinity
Gender Equality
Human Development Index
Overall Life Satisfaction Index
**Definitions**
Moral foundations theory [(Graham et al., 2013)](https://doi.org/10.1016/B978-0-12-407236-7.00002-4) argues that there are five universal moral values. These five values have been grouped into two overarching moral values [(Graham et al., 2009)](http://dx.doi.org/10.1037/a0015141) as individualizing and binding moral values.
*Individualizing* values encompass moral foundations of care (i.e., cherishing and protecting others) and fairness (i.e., rendering justice according to shared rules).
*Binding* values encompass moral foundations of loyalty (i.e., standing with your group, family, nation), authority (i.e., submitting to tradition and legitimate authority), and purity (i.e., abhorrence for disgusting things, foods, actions).
**Example Items**
Please read the following sentences and indicate your agreement or disagreement:
Individualizing: Compassion for those who are suffering is the most crucial virtue.
Binding: People should be loyal to their family members, even when they have done something wrong.
Column {.tabset .tabset-fade data-width=600}
-----------------------------------------------------------------------
### **Final Version**
```{r}
# run the models
model1 <- lmer(indiv ~ gender_eqality + (sex|country), data = df)
model2 <- lmer(bind ~ gender_eqality + (sex|country), data = df)
# extract the predicted values
predicted1 <-
ggpredict(model1,
terms = c("gender_eqality", "country"),
type = "re")
predicted2 <-
ggpredict(model2,
terms = c("gender_eqality", "country"),
type = "re")
predicted1 %<>%
as.data.frame() %>%
mutate(
outcome = "Individualizing"
)
predicted2 %<>%
as.data.frame() %>%
mutate(
outcome = "Binding"
)
pred_combined <- bind_rows(predicted1, predicted2)
pred_combined %>%
ggplot(aes(x, predicted, color = group)) +
geom_line(size = .75) +
facet_wrap(~ outcome) +
labs(title = "Relationship between gender equality and moral values",
x = "Gender Equality",
y = "Predicted Values",
color = "Country") +
theme(
plot.title.position = "plot",
axis.text = element_text(size = 10,
colour = "black"),
strip.background.x = element_rect(color = "gray80",
size = 1),
strip.text.x = element_text(face = "bold",
size = 11)
) +
gghighlight(group %in% c("Japan", "Netherlands", "Spain", "Iran"),
calculate_per_facet = TRUE)
```
### Before Peer Review
```{r}
p11 <-
predicted1 %>%
ggplot(aes(x, predicted, color = group)) +
geom_line(size = 1) +
labs(x = "Gender Equality",
y = "Individualizing",
color = "Country") +
theme(axis.text = element_text(size = 10,
colour = "black")
) +
gghighlight::gghighlight(group %in% c("Poland", "Netherlands", "Hungary"))
p21 <-
predicted2 %>%
ggplot(aes(x, predicted, color = group)) +
geom_line(size = 1) +
labs(x = "Gender Equality",
y = "Binding",
color = "Country") +
theme(axis.text = element_text(size = 10,
colour = "black")
) +
gghighlight::gghighlight(group %in% c("Poland", "Netherlands", "Spain"))
ggpubr::ggarrange(p11, p21,
common.legend = TRUE,
legend = "bottom") %>%
ggpubr::annotate_figure(
top = ggpubr::text_grob("Countries at the top, middle, and bottom")
)
```
> Based on the peer review, I changed the limits of y-axis, making them the same. Also, I added the raw data for the plots. I highlighted four countries from different cultures.
Column {.tabset .tabset-fade data-width=400}
-----------------------------------------------------------------------
### About
The plot describes the random effects for the countries where gender equality predicts moral values. The plots describe the different outcome values at different levels of gender equality for each country. The table below shows the raw data for the plot.
**Findings**
```{r}
pred_combined %>%
select(Country = group,
`Gender Equality` = x,
Outcome = outcome,
`Predicted Value` = predicted
) %>%
DT::datatable(rownames = FALSE,
filter = "top",
options = list(pageLength = 6,
searching = FALSE,
columnDefs = list(list(className = "df-center",
targets = "_all")
),
lengthChange = FALSE,
initComplete = JS(
"function(settings, json) {",
"$(this.api().table().header()).css({'background-color': '#9f939c', 'color': '#fff'});",
"}")
)
) %>%
DT::formatRound(columns = "Predicted Value",
digits = 2)
```
### Version 1
```{r}
# plot
p1 <-
predicted1 %>%
ggplot(aes(x, predicted, color = group)) +
geom_line(size = 1)
p2 <-
predicted2 %>%
ggplot(aes(x, predicted, color = group)) +
geom_line(size = 1)
ggpubr::ggarrange(p1, p2,
common.legend = TRUE,
legend = "bottom"
)
```
> The initial attempt to visualize the predicted values of moral foundations where the predictor is gender equality. I chose this predictor because it was the only that was significant for both outcomes. I am glad that it worked, but it needs improvement.
### Version 2
```{r}
p1 <-
p1 +
labs(x = "Gender Equality",
y = "Individualizing",
color = "Country") +
theme(axis.text = element_text(size = 10,
colour = "black"))
p2 <-
p2 +
labs(x = "Gender Equality",
y = "Binding",
color = "Country") +
theme(axis.text = element_text(size = 10,
colour = "black"))
ggpubr::ggarrange(p1, p2,
common.legend = TRUE,
legend = "bottom"
)
```
> This version is better, but it would be nicer to see which countries are at the top, middle, and bottom of the plot.
# Predicted Values of Moral Values by Sex for each country
Background {.sidebar}
-----------------------------------------------------------------------
**Data**
Data used in this dashboard come from the second study of [Atari et al. (2020)](http://dx.doi.org/10.1098/rspb.2020.1201), which can be downloaded from [Kaggle](https://www.kaggle.com/tunguz/sex-differences-in-moral-judgements-67-countries).
This study has data on moral values in 19 countries. There is also a second dataset with country-level variables.
**Country-level variables**
Population Sex Ratio
Individualism
Masculinity
Gender Equality
Human Development Index
Overall Life Satisfaction Index
**Definitions**
Moral foundations theory [(Graham et al., 2013)](https://doi.org/10.1016/B978-0-12-407236-7.00002-4) argues that there are five universal moral values. These five values have been grouped into two overarching moral values [(Graham et al., 2009)](http://dx.doi.org/10.1037/a0015141) as individualizing and binding moral values.
*Individualizing* values encompass moral foundations of care (i.e., cherishing and protecting others) and fairness (i.e., rendering justice according to shared rules).
*Binding* values encompass moral foundations of loyalty (i.e., standing with your group, family, nation), authority (i.e., submitting to tradition and legitimate authority), and purity (i.e., abhorrence for disgusting things, foods, actions).
**Example Items**
Please read the following sentences and indicate your agreement or disagreement:
Individualizing: Compassion for those who are suffering is the most crucial virtue.
Binding: People should be loyal to their family members, even when they have done something wrong.
Column {.tabset .tabset-fade data-width=600}
-----------------------------------------------------------------------
### **Final Version**
```{r table, include = FALSE}
df2 <- as_tibble(df)
nested <- df2 %>%
nest(-country)
table2 <-
nested %>%
mutate(
model_sex_b = map(data, ~ lm(bind ~ sex, data = .)),
tidied = map(model_sex_b, tidy)
) %>%
unnest(tidied) %>%
select(country, term, estimate, std.error, p.value) %>%
mutate(
p.value = round(p.value, digits = 3),
across(c(estimate, std.error), ~round(., digits = 2)),
term = recode(term,
`(Intercept)` = "Intercept",
`sexMale` = "Sex [Male]")
)
table3 <-
nested %>%
mutate(
model_sex_i = map(data, ~ lm(indiv ~ sex, data = .)),
tidied = map(model_sex_i, tidy)
) %>%
unnest(tidied) %>%
select(country, term, estimate, std.error, p.value) %>%
mutate(
p.value = round(p.value, digits = 3),
across(c(estimate, std.error), ~round(., digits = 2)),
term = recode(term,
`(Intercept)` = "Intercept",
`sexMale` = "Sex [Male]")
)
table4 <-
bind_cols(
table2,
select(table3,
estimate2 = estimate,
se2 = std.error,
p2 = p.value)
)
table5 <-
table4 %>%
filter(term == "Sex [Male]") %>%
select(group = country, Binding = p.value, Individualizing = p2) %>%
pivot_longer(cols = c(Binding, Individualizing),
names_to = "outcome",
values_to = "ps") %>%
mutate(
dif = if_else(ps < .05, "p < .05", "p > .05")
)
```
```{r}
ms1 <- lmer(indiv ~ sex + (sex|country), data = df)
ms2 <- lmer(bind ~ sex + (sex|country), data = df)
p1 <- ggpredict(ms1,
terms = c("sex", "country"),
type = "re"
)
p2 <- ggpredict(ms2,
terms = c("sex", "country"),
type = "re"
)
p1 %<>%
as.data.frame() %>%
mutate(
outcome = "Individualizing"
)
p2 %<>%
as.data.frame() %>%
mutate(
outcome = "Binding"
)
p_combined <-
bind_rows(p1, p2) %>%
rename(Sex = x)
p_combined2 <- left_join(p_combined, table5)
ggplot(p_combined2) +
geom_line(aes(predicted, group, color = dif),
size = 1.25) +
geom_point(aes(predicted, group, fill = Sex),
size = 2,
shape = 21,
stroke = 0
) +
geom_hline(yintercept = 0.5,
color = "gray90") +
facet_wrap(~outcome, scales = "free_x") +
theme(
plot.title.position = "plot",
panel.grid.major.y = element_blank(),
panel.grid.minor.y = element_blank(),
legend.position = "bottom",
legend.direction = "horizontal",
axis.text.y = element_text(color = "black",
size = 11),
axis.text.x = element_text(color = "black",
size = 8,
hjust = .5),
axis.title.y = element_blank(),
axis.title.x = element_text(vjust = -2),
strip.background.x = element_rect(color = "gray80",
size = 1),
strip.text.x = element_text(face = "bold"),
legend.background = element_rect(color = "gray80",
size = .5)
) +
labs(
title = "Predicted values of Individualizing and Binding Moral Values by Sex",
x = "Predicted Values",
caption = "\n"
) +
scale_color_brewer("Significance", palette = "PRGn") +
scale_fill_brewer(palette = "Set1")
```
### Version 1
```{r}
ggplot(p_combined) +
geom_line(aes(predicted, group),
size = 1.5,
color = "#535353") +
geom_point(aes(predicted, group, color = Sex),
size = 2.5) +
geom_hline(yintercept = 0.5,
color = "gray90") +
facet_wrap(~outcome) +
theme(
plot.title.position = "plot",
panel.grid.major.y = element_blank(),
panel.grid.minor.y = element_blank(),
legend.position = c(0.01, -.15),
legend.direction = "horizontal",
axis.text.y = element_text(color = "black",
size = 11),
axis.text.x = element_text(color = "black",
size = 8,
hjust = .5),
axis.title.y = element_blank(),
axis.title.x = element_text(vjust = -2),
strip.background.x = element_rect(color = "gray80",
size = 1),
strip.text.x = element_text(face = "bold"),
legend.background = element_rect(color = "gray80",
size = .5)
) +
labs(
title = "Predicted values of Individualizing and Binding Moral Values by Sex",
x = "Predicted Values",
caption = "\n"
) +
scale_color_manual(values = c("#FFDB6D", "#D16103"))
```
Column {data-width=400}
-----------------------------------------------------------------------
### About
The plot describes the predicted values of moral values by sex. The table below represents models where moral value is predicted by sex separate for each country.
**Findings**
```{r}
table4 %>%
group_by(country) %>%
gt() %>%
tab_header(
title = "Predicting Moral Values by Sex for Each Country"
) %>%
cols_label(term = "",
estimate = md("*B*"),
std.error = "SE",
p.value = "p",
estimate2 = md("*B*"),
se2 = "SE",
p2 = "p"
) %>%
tab_spanner(
label = "Binding",
columns = vars(estimate, std.error, p.value)
) %>%
tab_spanner(
label = "Individualizing",
columns = vars(estimate2, se2, p2)
) %>%
fmt_number(
columns = vars(estimate, estimate2, std.error, se2),
decimals = 2
) %>%
fmt_number(
columns = vars(p.value, p2),
decimals = 3
) %>%
cols_align(
columns = "term",
align = "right"
) %>%
opt_row_striping() %>%
tab_options(
heading.background.color = "#9f939c",
table.font.size = "100%"
) %>%
tab_style(
style = list(
cell_text(weight = "bold")
),
locations = cells_body(
columns = vars(p.value),
rows = p.value < .05
)
) %>%
tab_style(
style = list(
cell_text(weight = "bold")
),
locations = cells_body(
columns = vars(p2),
rows = p2 < .05
)
) %>%
tab_options(
container.height = px(1000),
container.overflow.y = TRUE
)
```