Data Visualizations
Reto Horat
2024-05-16
Introduction
In this document, I present visualizations related to various hypotheses. Each section includes the hypothesis, the corresponding visualization, and a brief interpretation of the results.
Analysis of Study Participants
import matplotlib.pyplot as plt
import numpy as np
import pandas as pd
# Laden der Daten
data = pd.read_csv('data/processed/cleandata_long.csv')
# Filtern der Daten für eindeutige Teilnehmer in den Experimental- und Kontrollgruppen
unique_participants = data.drop_duplicates(subset=['ID'])
experimental_count = unique_participants[unique_participants['meg_group_type'] == 'experimental'].shape[0]
control_count = unique_participants[unique_participants['meg_group_type'] == 'control'].shape[0]
# Punkte innerhalb der Kreise
point_size = 5 # Größere Punktgröße
point_color_experimental = 'green'
point_color_control = 'gray'
# Kreisradius
radius_experimental = 5
radius_control = 5
# Erstellen der Figur und Achsen
fig, ax = plt.subplots(figsize=(12, 6))
# Hinzufügen der Punkte für die Kontrollgruppe
for i in range(control_count):
angle = np.random.uniform(0, 2 * np.pi)
r = radius_control * np.sqrt(np.random.uniform(0, 1))
x = r * np.cos(angle) - 10 # Verschiebung des Kontrollkreises nach links
y = r * np.sin(angle)
ax.plot(x, y, 'o', color=point_color_control, markersize=point_size)
# Hinzufügen der Punkte für die Experimentalgruppe
for i in range(experimental_count):
angle = np.random.uniform(0, 2 * np.pi)
r = radius_experimental * np.sqrt(np.random.uniform(0, 1))
x = r * np.cos(angle) + 10 # Verschiebung des Experimentalkreises nach rechts
y = r * np.sin(angle)
ax.plot(x, y, 'o', color=point_color_experimental, markersize=point_size)
# Anpassen der Achsen und des Layouts
ax.set_xlim(-16, 16)## (-16.0, 16.0)ax.set_ylim(-6, 6)## (-6.0, 6.0)ax.set_aspect('equal')
plt.axis('off')## (-16.0, 16.0, -6.0, 6.0)plt.text(-10, 6.5, f'Control Group\n(n={control_count})', horizontalalignment='center', fontsize=12, color='gray')
plt.text(10, 6.5, f'Experimental Group\n(n={experimental_count})', horizontalalignment='center', fontsize=12, color='green')
# Anzeigen der Grafik
plt.show()
import pandas as pd
import matplotlib.pyplot as plt
import seaborn as sns
# Laden der Daten
data = pd.read_csv('data/processed/cleandata_long.csv')
# Daten auf einzigartige Versuchspersonen reduzieren
unique_data = data.drop_duplicates(subset=['ID'])
# Geschlechterverteilung nach Gruppe mit angepasster Farbpalette
plt.figure(figsize=(10, 8))
ax = sns.countplot(x='gender', hue='meg_group_type', data=unique_data, palette={'experimental': 'green', 'control': 'gray'})
plt.title('Gender Distribution by Group')
plt.xlabel('Gender')
plt.ylabel('Count')
plt.legend(title='Group Type')
# Anzahl der Fälle auf die Balken schreiben
for p in ax.patches:
if p.get_height() > 0: # Nur wenn der Wert größer als 0 ist
ax.annotate(f'{int(p.get_height())}', (p.get_x() + p.get_width() / 2., p.get_height()), ha='center', va='center', xytext=(0, 5), textcoords='offset points')
plt.show()
import pandas as pd
import matplotlib.pyplot as plt
import seaborn as sns
# Laden der Daten
data = pd.read_csv('data/processed/cleandata_long.csv')
# Daten auf einzigartige Versuchspersonen reduzieren
unique_data = data.drop_duplicates(subset=['ID'])
# Altersgruppen definieren
bins = [16, 21, 26, 31]
labels = ['[16, 20)', '[21, 25)', '[26, 30)', '30+']
unique_data['age_group'] = pd.cut(unique_data['age'], bins=bins + [unique_data['age'].max() + 1], labels=labels, right=False, include_lowest=True)## <string>:1: SettingWithCopyWarning:
## A value is trying to be set on a copy of a slice from a DataFrame.
## Try using .loc[row_indexer,col_indexer] = value instead
##
## See the caveats in the documentation: https://pandas.pydata.org/pandas-docs/stable/user_guide/indexing.html#returning-a-view-versus-a-copy# Altersverteilung nach Gruppe
plt.figure(figsize=(15, 8))
ax = sns.countplot(x='age_group', hue='meg_group_type', data=unique_data, palette={'experimental': 'green', 'control': 'gray'})
plt.title('Age Distribution by Group')
plt.xlabel('Age Group')
plt.ylabel('Count')
plt.legend(title='Group Type')
# Anzahl der Fälle auf die Balken schreiben
for p in ax.patches:
if p.get_height() > 0: # Nur wenn der Wert größer als 0 ist
ax.annotate(f'{int(p.get_height())}', (p.get_x() + p.get_width() / 2., p.get_height()), ha='center', va='center', xytext=(0, 5), textcoords='offset points')
plt.show()
Is this a Problem?
# Random-Forrest
# Check and load required packages
required_packages <- c("party", "lme4", "ggplot2", "dplyr")
# Function to install and load packages
install_and_load <- function(packages) {
for (package in packages) {
if (!require(package, character.only = TRUE)) {
install.packages(package)
library(package, character.only = TRUE)
}
}
}
# Install and load the required packages
install_and_load(required_packages)
# Prepare the data: Convert categorical variables to factors
data$meg_group_type <- as.factor(data$meg_group_type)
data$ID <- as.factor(data$ID)
data$gender <- as.factor(data$gender)
# Separate the data into experimental and control groups
experimental_data <- data %>% filter(meg_group_type == "experimental")
control_data <- data %>% filter(meg_group_type == "control")
# Function to train cforest and calculate variable importance
calculate_importance <- function(dataset) {
set.seed(42)
sample <- sample.int(n = nrow(dataset), size = floor(0.75 * nrow(dataset)), replace = FALSE)
train <- dataset[sample, ]
test <- dataset[-sample, ]
# Train cforest model with additional variables including gi_mean
cforest_model <- cforest(meg_level ~ svo_angle + round + meg_prediction + meg_belief_accuracy + meg_lowest_level + k3_mean + gender + age + gi_mean,
data = train,
controls = cforest_unbiased(ntree = 100, mtry = 2))
# Predict on test data
predictions <- predict(cforest_model, newdata = test, OOB = TRUE, type = "response")
mse <- mean((predictions - test$meg_level)^2)
print(paste("Mean Squared Error:", mse))
# Calculate variable importance
varimp <- varimp(cforest_model)
return(varimp)
}
# Calculate variable importance for the experimental group
experimental_importance <- calculate_importance(experimental_data)## [1] "Mean Squared Error: 2.1675285236749"print("Variable Importance for Experimental Group:")## [1] "Variable Importance for Experimental Group:"print(experimental_importance)## svo_angle round meg_prediction meg_belief_accuracy
## 0.2139453 0.3035142 5.8392125 0.8760949
## meg_lowest_level k3_mean gender age
## 9.8081234 0.2146097 0.1081013 0.2731221
## gi_mean
## 0.4607752# Calculate variable importance for the control group
control_importance <- calculate_importance(control_data)## [1] "Mean Squared Error: 1.21269985210126"print("Variable Importance for Control Group:")## [1] "Variable Importance for Control Group:"print(control_importance)## svo_angle round meg_prediction meg_belief_accuracy
## 0.2336322 0.3737713 5.5595013 0.7247172
## meg_lowest_level k3_mean gender age
## 3.4354669 0.2215525 0.1514866 0.1324244
## gi_mean
## 0.3558224# Determine the maximum value for y-axis limit
max_ylim <- max(c(experimental_importance, control_importance))
# Plot the importance of variables for both groups with adjusted label settings and unified y-axis limits
par(mfrow = c(1, 2), mar = c(10, 4, 6, 2) + 0.1) # Adjusting margins to increase top margin
# Experimental group plot with green bars
barplot(experimental_importance, main = "Variable Importance\n(Experimental Group)", las = 2, col = "lightgreen",
names.arg = c("SVO Angle", "Round", "Prediction", "Belief InAccuracy", "Lowest Level", "K3 Mean", "Gender", "Age", "GI Mean"), cex.names = 0.8, ylim = c(0, max_ylim))
# Control group plot with grey bars
barplot(control_importance, main = "Variable Importance\n(Control Group)", las = 2, col = "lightgrey",
names.arg = c("SVO Angle", "Round", "Prediction", "Belief InAccuracy", "Lowest Level", "K3 Mean", "Gender", "Age", "GI Mean"), cex.names = 0.8, ylim = c(0, max_ylim))
import matplotlib.pyplot as plt
import numpy as np
import pandas as pd
# Laden der Daten
data = pd.read_csv('data/processed/cleandata_long.csv')
# Filtern der Daten für eindeutige Gruppen in den Experimental- und Kontrollgruppen
experimental_count = data[data['meg_group_type'] == 'experimental']['grp'].nunique()
control_count = data[data['meg_group_type'] == 'control']['grp'].nunique()
# Punkte innerhalb der Kreise
point_size = 10 # Größere Punktgröße
point_color_experimental = 'green'
point_color_control = 'gray'
# Kreisradius
radius_experimental = 5
radius_control = 5
# Erstellen der Figur und Achsen
fig, ax = plt.subplots(figsize=(12, 6))
# Hinzufügen der Punkte für die Kontrollgruppe
for i in range(control_count):
angle = np.random.uniform(0, 2 * np.pi)
r = radius_control * np.sqrt(np.random.uniform(0, 1))
x = r * np.cos(angle) - 10 # Verschiebung des Kontrollkreises nach links
y = r * np.sin(angle)
ax.plot(x, y, 'o', color=point_color_control, markersize=point_size)
# Hinzufügen der Punkte für die Experimentalgruppe
for i in range(experimental_count):
angle = np.random.uniform(0, 2 * np.pi)
r = radius_experimental * np.sqrt(np.random.uniform(0, 1))
x = r * np.cos(angle) + 10 # Verschiebung des Experimentalkreises nach rechts
y = r * np.sin(angle)
ax.plot(x, y, 'o', color=point_color_experimental, markersize=point_size)
# Anpassen der Achsen und des Layouts
ax.set_xlim(-16, 16)## (-16.0, 16.0)ax.set_ylim(-6, 6)## (-6.0, 6.0)ax.set_aspect('equal')
plt.axis('off')## (-16.0, 16.0, -6.0, 6.0)plt.text(-10, 6.5, f'Control Group\n(groups={control_count})', horizontalalignment='center', fontsize=12, color='gray')
plt.text(10, 6.5, f'Experimental Group\n(groups={experimental_count})', horizontalalignment='center', fontsize=12, color='green')
# Anzeigen der Grafik
plt.show()
import matplotlib.pyplot as plt
import matplotlib.patches as patches
fig, ax = plt.subplots(figsize=(10, 10))
# Draw the flowchart
def draw_flowchart():
steps = [
"Instructions & Comprehension Questions", "Minimum-Effort-Game (20 Rounds)", "Group_Identification, KUSIV3 & SVO", "Random Payout Selection",
"Demographics", "Payout&Debriefing"
]
y = 9 # Lower starting y-coordinate to make space for the title
for step in steps:
# Step rectangles without background color
rect = patches.Rectangle((1, y), 8, 0.8, edgecolor='black', facecolor='none')
ax.add_patch(rect)
plt.text(5, y + 0.4, step, horizontalalignment='center', verticalalignment='center', fontsize=12)
# Distinguish between Experimental and Control groups in the experiment part
if step == "Minimum-Effort-Game (20 Rounds)":
exp_rect = patches.Rectangle((1, y + 1), 3.8, 0.6, edgecolor='black', facecolor='lightgreen')
ctrl_rect = patches.Rectangle((5.2, y + 1), 3.8, 0.6, edgecolor='black', facecolor='lightgrey')
ax.add_patch(exp_rect)
ax.add_patch(ctrl_rect)
plt.text(2.9, y + 1.3, "Experimental Group", horizontalalignment='center', verticalalignment='center', fontsize=7)
plt.text(7.1, y + 1.3, "Control Group", horizontalalignment='center', verticalalignment='center', fontsize=7)
y -= 1.8 # Slightly reduce the distance between steps
plt.xlim(0, 10)
plt.ylim(0, 13)
plt.axis('off')
draw_flowchart()
plt.text(5, 12.5, "Study Flowchart", horizontalalignment='center', verticalalignment='center', fontsize=16)
plt.show()
Kusiv-Items: - Ich bin davon überzeugt, dass die meisten Menschen gute Absichten haben. [I am convinced that most people have good intentions.] - Heutzutage kann man sich auf niemanden mehr verlassen. (invers) [Nowadays, you can’t rely on anyone anymore. (inverse)] - Im Allgemeinen kann man den Menschen vertrauen. [In general, you can trust people.]
Group-Identification: - Ich fühlte mich mit meiner Gruppe verbunden. [I felt connected to my group.] - Ich bin froh, dass ich in meiner Gruppe war. [I am glad that I was in my group.] - Ich fühlte mich mit meiner Gruppe solidarisch. [I felt solidarity with my group.] - Ich fühlte mich meiner Gruppe verpflichtet. [I felt committed to my group.]
Hypothesis 1:
In groups where participants’ beliefs about others’ minimum effort levels are incentivized and those beliefs are communicated before they select their own effort level, there will be a higher likelihood of achieving higher equilibrium outcomes compared to groups where beliefs are also incentivized but not communicated.
Visualization 1: Average Lowest Effort Level by Group
# Calculate mean of meg_lowest_level by group type and round
data_grouped <- data %>%
group_by(meg_group_type, round) %>%
summarize(mean_lowest_level = mean(meg_lowest_level, na.rm = TRUE))## `summarise()` has grouped output by 'meg_group_type'. You can override using
## the `.groups` argument.# Plotting
ggplot(data_grouped, aes(x = round, y = mean_lowest_level, color = meg_group_type)) +
geom_line() +
scale_color_manual(values = c("control" = "grey", "experimental" = "green")) +
labs(title = 'Average Lowest Effort Level',
x = 'Round',
y = 'Average Lowest Effort Level',
color = 'Group Type') +
theme_minimal()
Interpretation 1: The visualization shows that in the treatment group, where beliefs are incentivized and communicated, there is a higher average lowest effort level compared to the control group. This supports the hypothesis that the communication of beliefs lead to higher equilibrium outcomes.
Hypothesis 2:
The inflation component (x) in participants’ beliefs is expected to be present or more pronounced in the treatment group, where beliefs are incentivized and communicated, as opposed to the control group, where beliefs are also incentivized but not communicated. In other words, first round communicated beliefs (and communicated beliefs over rounds) are higher than private beliefs (i.e., reported beliefs in the control group).”
Visualizations 2.1 - Initial Inflation Component (x) To attempt to isolate the initial inflation component (x), we focus on the first round. In the first round, participants have not yet received any feedback on the actual effort levels chosen by others in their group. Therefore, any inflation in their communicated beliefs is likely to be strategic, aimed at influencing the effort levels of others. This allows us to measure the initial inflation component without the confounding effect of feedback from previous rounds.
# Calculate the mean meg_prediction for the first round by group type
mean_prediction_first_round <- data %>%
filter(round == 1) %>%
group_by(meg_group_type) %>%
summarize(mean_prediction = mean(meg_prediction, na.rm = TRUE))
# Calculate the difference between experimental and control groups
diff_inflation_component <- mean_prediction_first_round %>%
summarize(diff = diff(mean_prediction))
# Plotting
ggplot(mean_prediction_first_round, aes(x = meg_group_type, y = mean_prediction, fill = meg_group_type)) +
geom_bar(stat = "identity", position = "dodge") +
geom_text(aes(label = round(mean_prediction, 2)), vjust = -0.5) +
labs(title = 'Average Predictions in First Round',
x = 'Group Type',
y = 'Average Prediction') +
theme_minimal() +
scale_fill_manual(values = c("control" = "grey", "experimental" = "green")) +
annotate("text", x = 1.5, y = max(mean_prediction_first_round$mean_prediction) + 0.5,
label = paste("Inflation Component (x):", round(diff_inflation_component$diff, 2)), size = 5, color = "black")
Interpretation 2.1 - Initial Inflation Component (x) The bar chart indicates that the average predictions in the first round are higher in the treatment group compared to the control group. Specifically, the inflation component (x) is calculated to be 2.43, indicating a substantial difference. This suggests that the inflation component is significantly more pronounced when beliefs are communicated, supporting our hypothesis that participants in the treatment group could be strategically overestimating their beliefs to influence the efforts of others in their group. However, an alternative explanation could be that participants in the treatment group genuinely believe that effort levels will be higher because beliefs are communicated. This means that their predictions reflect their true beliefs rather than a strategic overestimation. They might think that the act of communicating beliefs will itself lead to higher effort levels, as group members may be motivated by the communicated beliefs. Therefore, the observed difference of 2.43 points could be due to a genuine expectation of higher effort levels rather than a strategic manipulation.
Visualizations 2.2 - Effect of Feedback on Inflation Component (x) At the end of each round, participants receive feedback about the actual lowest effort levels chosen by their group. This feedback can possibly influence their future predictions, creating a confounding effect on the inflation component (x). By analyzing the difference between predictions and the actual lowest effort levels of the previous round, we can observe how feedback might alter the inflation component. Note that in round 0, this difference cannot be calculated due to the lack of prior data.
# Calculate the difference between predictions for each round and the actual lowest effort level of the previous round
data <- data %>%
arrange(round) %>%
group_by(meg_group_type) %>%
mutate(lag_meg_lowest_level = lag(meg_lowest_level))
diff_all_rounds <- data %>%
filter(round > 0) %>%
group_by(meg_group_type, round) %>%
summarize(diff_prediction = mean(meg_prediction - lag_meg_lowest_level, na.rm = TRUE))## `summarise()` has grouped output by 'meg_group_type'. You can override using
## the `.groups` argument.# Plotting
ggplot(diff_all_rounds, aes(x = round, y = diff_prediction, color = meg_group_type)) +
geom_line() +
labs(title = 'Diff. Between Predictions and Actual Lowest Level of Prev. Round (Rounds 1-19)',
x = 'Round',
y = 'Difference',
color = 'Group Type') +
theme_minimal()
Interpretation 2.2 - Effect of Feedback on Inflation Component (x) The line chart indicates the difference between the predictions for each round and the actual lowest effort levels of the previous round for the treatment and control groups over rounds 1 to 19. The treatment group consistently shows a larger positive difference compared to the control group, suggesting that the inflation component is more pronounced when beliefs are communicated.
Visualization 2.3 - Gap Analysis of Inflation Component (x)
# Calculate the difference between predictions for each round and the actual lowest effort level of the previous round
data <- data %>%
arrange(round) %>%
group_by(meg_group_type) %>%
mutate(lag_meg_lowest_level = lag(meg_lowest_level))
diff_all_rounds <- data %>%
filter(round > 0) %>%
group_by(meg_group_type, round) %>%
summarize(diff_prediction = mean(meg_prediction - lag_meg_lowest_level, na.rm = TRUE))## `summarise()` has grouped output by 'meg_group_type'. You can override using
## the `.groups` argument.# Calculate the gap between experimental and control groups
gap_diff <- diff_all_rounds %>%
pivot_wider(names_from = meg_group_type, values_from = diff_prediction) %>%
mutate(gap = experimental - control)
# Plotting the gap with a smoothing line
ggplot(gap_diff, aes(x = round, y = gap)) +
geom_line(color = 'purple') +
geom_smooth(method = "loess", color = 'blue', se = FALSE) +
labs(title = 'Gap Between Experimental and Control Groups in Difference Between Predictions and Actual Lowest Level',
x = 'Round',
y = 'Gap in Difference') +
theme_minimal()## `geom_smooth()` using formula = 'y ~ x'
Interpretation 2.3 - Gap Analysis of Inflation Component (x) The line chart shows the gap between the experimental and control groups in the difference between predictions and actual lowest effort levels over the rounds.
Decreasing Gap Over Rounds:
- The decreasing gap indicates that the difference in the inflation component (x) between the two groups diminishes over time. This suggests that participants in the experimental group may reduce their strategic overestimation of predictions as they receive ongoing feedback.
Final Increase in Gap:
- The final increase in the gap suggests that participants in the experimental group might be making a last strategic attempt to influence the group’s effort levels. This could reflect heightened motivation or a strategic push to boost the group’s performance in the final rounds.
Overall, the decreasing trend in the gap, highlighted by the smoothing line, suggests that feedback over the rounds influences participants to adjust their predictions, possibly leading to more accurate or less inflated beliefs. However, the final increase in the gap highlights that strategic behavior might still play a role, especially towards the end of the experiment.
Hypothesis 3:
We further assume that the reported (but not communicated) beliefs in the control group will be closer to participants’ actual beliefs (b), resulting in higher belief accuracy compared to the treatment group. In the treatment group, due to strategic adjustments prompted by the communication of beliefs, the reported beliefs are likely to deviate more significantly from the participants’ actual beliefs in the first rounds, affecting the accuracy negatively. In other words, (3) accuracy of beliefs will be lower in the first rounds in the treatment groups compared to the control groups.
Visualization 3.1 - belief accuracy over rounds
# Calculate mean absolute belief accuracy per round and group type
mean_abs_accuracy_over_rounds <- data %>%
group_by(round, meg_group_type) %>%
summarize(mean_abs_accuracy = mean(meg_absolute_belief_accuracy, na.rm = TRUE))## `summarise()` has grouped output by 'round'. You can override using the
## `.groups` argument.# Create the plot
ggplot(mean_abs_accuracy_over_rounds, aes(x = round, y = mean_abs_accuracy, color = meg_group_type, group = meg_group_type)) +
geom_line(size = 1) +
geom_point(size = 2) +
labs(title = 'Mean Absolute Belief Accuracy Over Rounds',
x = 'Round',
y = 'Mean Absolute Belief Accuracy\n(Lower values indicate higher accuracy)',
color = 'Group Type') +
theme_minimal() +
scale_color_manual(values = c("control" = "red", "experimental" = "blue"))## Warning: Using `size` aesthetic for lines was deprecated in ggplot2 3.4.0.
## ℹ Please use `linewidth` instead.
## This warning is displayed once every 8 hours.
## Call `lifecycle::last_lifecycle_warnings()` to see where this warning was
## generated.
Interpretation 3.1 Both groups show lower belief accuracy in the initial rounds, but the control group improves faster. The control group’s beliefs become more accurate over time, while the experimental group’s beliefs remain less accurate. This supports Hypothesis 3, indicating that belief accuracy is lower in the first rounds in the treatment group compared to the control group due to the strategic influence of communicated beliefs. Interestingly, this effect persists throughout all rounds, not just in the initial rounds, suggesting that the strategic adjustments in the experimental group have a lasting impact on belief accuracy over the entire course of the experiment.
Furthermore, the observed lower accuracy in the experimental group can be attributed to the inflation component (x) identified in Hypothesis 2, where participants strategically inflate their beliefs to influence others’ effort levels, which continues to affect belief accuracy across all rounds. It appears that participants in the experimental group might be sacrificing the payout for a correct prediction (belief accuracy) in an attempt to maximize the second payout derived from the Minimum Effort Game.
Exploratory Analysis: Interpersonal Trust, Group Identification, and Social Value Orientation (SVO)
We aim to use these measures to explore additional relationships between interpersonal trust and identification following collective decision-making (e.g., whether group identification is higher in treatment groups vs. control groups), and to which degree SVO influences effort levels and communicated beliefs (“strategic optimism”).
Relationship Between Group Trust (KUSIV3) and Final Effort Level Zum Beispiel könnte es ja sein, dass eine Gruppe mit Teilnehmenden die alle “hohes Vertrauen” hat es am Ende schafft auch auf einem höheren effort-Niveau zu landen als eine Gruppe in der z.B. eine oder zwei Personen sehr niedrig auf dem KUSV3 scored. Also, man könnte sich Gruppenkonstellationen (in der KUSIV3 Ausprägung) anschauen und versuchen aufgrund dieser Konstellationen Gruppendynamiken vorherzusagen.
- Final Effort Levels by Group Trust (KUSIV3)
# Filter for the last round
last_round_data <- data %>%
filter(round == max(round))
# Calculate the mean KUSIV3 score for each group
group_summary <- last_round_data %>%
group_by(grp, meg_group_type) %>%
summarize(final_effort = mean(meg_lowest_level, na.rm = TRUE),
mean_kusiv3 = mean(k3_mean, na.rm = TRUE))## `summarise()` has grouped output by 'grp'. You can override using the `.groups`
## argument.# Plotting the relationship
ggplot(group_summary, aes(x = mean_kusiv3, y = final_effort, color = meg_group_type)) +
geom_point(size = 3, alpha = 0.6) +
geom_smooth(method = "lm", se = FALSE) +
labs(title = 'Final Effort Levels by Group Trust (KUSIV3)',
x = 'Mean KUSIV3 Score',
y = 'Final Effort Level',
color = 'Group Type') +
theme_minimal() +
scale_color_manual(values = c("control" = "red", "experimental" = "blue"))## `geom_smooth()` using formula = 'y ~ x'
The scatter plot shows the relationship between the mean KUSIV3 score (group trust) and the final effort levels in each group. Each point represents a group, color-coded by whether it belongs to the experimental or control condition.
The trend lines indicate the general relationship between trust and effort levels within each condition. The visualization supports the hypothesis that groups with higher average trust levels (as measured by the KUSIV3 score) tend to achieve higher final effort levels. This effect is more pronounced in the experimental group compared to the control group. Specifically, the experimental groups with higher trust levels consistently reach higher effort levels, suggesting that trust within the group positively influences the ability to coordinate on higher effort levels. Conversely, groups with lower trust levels tend to coordinate on lower effort levels.
It is noteworthy that the experimental groups generally have higher mean KUSIV3 scores. This suggests that the experiment itself influenced how participants completed the trust questionnaire, potentially increasing their trust levels as a result of the experimental condition. This implies that the process of participating in the experimental condition may have positively impacted the participants’ perceptions of trust within their group.
- Mean KUSIV3 Scores by Group Type
# Calculate the mean KUSIV3 score for each group type
kusiv3_summary <- data %>%
group_by(meg_group_type) %>%
summarize(mean_kusiv3 = mean(k3_mean, na.rm = TRUE))
# Plotting the mean KUSIV3 scores
ggplot(kusiv3_summary, aes(x = meg_group_type, y = mean_kusiv3, fill = meg_group_type)) +
geom_bar(stat = "identity", position = "dodge") +
geom_text(aes(label = round(mean_kusiv3, 2)), vjust = -0.5) +
labs(title = 'Mean KUSIV3 Scores by Group Type',
x = 'Group Type',
y = 'Mean KUSIV3 Score') +
theme_minimal() +
scale_fill_manual(values = c("control" = "red", "experimental" = "blue"))
Interpretation: The bar chart shows the mean KUSIV3 scores for the experimental and control groups. Each bar represents the average trust score for the respective group type. This visualization allows us to compare the overall trust levels between the experimental and control conditions.
The observed difference in the mean KUSIV3 scores suggests that the group assignment influenced the responses to the KUSIV-3 questionnaire. This difference itself suggests that the experiment, conducted prior to the questionnaire, influenced the responses, indicating a possible increase in perceived trust levels due to the experimental manipulation.
- Conclusion The results show a positive relationship between the average trust level (KUSIV3 score) and the final effort level in the groups. The experimental groups tend to exhibit higher trust scores and achieve higher cooperation levels. These observations suggest that trust and cooperation are linked.
However, it remains unclear whether higher trust leads to better cooperation, whether achieving higher cooperation levels strengthens trust, or whether both variables mutually influence each other. Further investigations are necessary to clarify the direction of causality and to better understand the underlying mechanisms.
Is group identification higher in treatment groups vs. control groups?
# Calculate the mean gi_mean for each group type
mean_gi_by_group <- data %>%
group_by(meg_group_type) %>%
summarize(mean_gi = mean(gi_mean, na.rm = TRUE))
# Plotting
ggplot(mean_gi_by_group, aes(x = meg_group_type, y = mean_gi, fill = meg_group_type)) +
geom_bar(stat = "identity", position = "dodge") +
labs(title = 'Average Group Identification by Group Type',
x = 'Group Type',
y = 'Average Group Identification') +
theme_minimal() +
scale_fill_manual(values = c("control" = "red", "experimental" = "blue")) +
coord_flip()
Does SVO influences personal effort levels?
# Plotting the relationship between SVO angle and effort levels
ggplot(data, aes(x = svo_angle, y = meg_level)) +
geom_point(alpha = 0.6, color = "blue") +
geom_smooth(method = "lm", se = FALSE, color = "red") +
labs(title = 'Relationship Between SVO Angle and Effort Levels',
x = 'SVO Angle',
y = 'Effort Level (meg_level)') +
theme_minimal()## `geom_smooth()` using formula = 'y ~ x'
# Plotting the relationship between SVO angle and effort levels, differentiating by group type
ggplot(data, aes(x = svo_angle, y = meg_level, color = meg_group_type)) +
geom_point(alpha = 0.6) +
geom_smooth(method = "lm", se = FALSE) +
labs(title = 'Relationship Between SVO Angle and Effort Levels',
x = 'SVO Angle',
y = 'Effort Level (meg_level)',
color = 'Group Type') +
theme_minimal() +
scale_color_manual(values = c("control" = "red", "experimental" = "blue"))## `geom_smooth()` using formula = 'y ~ x'
#5 Furthermore, we plan to fit theoretical models to decision variables to recover latent parameters (i.e., x, b, a) and analyze effort stability over rounds (measured as variance of chosen effort levels) as well as earnings across treatments.
SPIELEREIEN
SVO und Alter
# Berechne die Korrelation zwischen Alter und SVO-Winkel
correlation <- cor(data$age, data$svo_angle, use = "complete.obs")
# Plotting the relationship between age and SVO angle
ggplot(data, aes(x = age, y = svo_angle)) +
geom_point(alpha = 0.6, color = "blue") +
geom_smooth(method = "lm", se = FALSE, color = "red") +
labs(title = 'Relationship Between Age and SVO Angle',
x = 'Age',
y = 'SVO Angle') +
theme_minimal() +
annotate("text", x = max(data$age, na.rm = TRUE), y = min(data$svo_angle, na.rm = TRUE),
label = paste("Correlation:", round(correlation, 2)),
hjust = 1, vjust = -1.5, size = 5, color = "black")## `geom_smooth()` using formula = 'y ~ x'
# Altersgruppen erstellen und deren SVO-Winkel vergleichen
data_unique <- data %>%
group_by(ID, age) %>%
summarize(svo_angle = mean(svo_angle, na.rm = TRUE)) %>%
ungroup() %>%
mutate(age_group = factor(case_when(
age < 25 ~ "Under 25",
age >= 25 & age < 35 ~ "25-34",
age >= 35 & age < 45 ~ "35-44",
age >= 45 & age < 55 ~ "45-54",
age >= 55 ~ "55+"
), levels = c("Under 25", "25-34", "35-44", "45-54", "55+")))## `summarise()` has grouped output by 'ID'. You can override using the `.groups`
## argument.# Anzahl der Personen in jeder Altersgruppe berechnen und Labels erstellen
age_group_counts <- data_unique %>%
group_by(age_group) %>%
summarize(count = n()) %>%
mutate(label = paste0(age_group, " (n = ", count, ")"))
# Labels in den Datensatz integrieren
data_unique <- data_unique %>%
left_join(age_group_counts, by = "age_group")
# Plotting the SVO angle by age group with counts in labels
ggplot(data_unique, aes(x = factor(label, levels = age_group_counts$label), y = svo_angle, fill = age_group)) +
geom_boxplot() +
labs(title = 'SVO Angle by Age Group',
x = 'Age Group',
y = 'SVO Angle') +
theme_minimal() +
coord_flip() +
annotate("text", x = 1, y = max(data_unique$svo_angle, na.rm = TRUE),
label = paste("Correlation:", round(correlation, 2)),
hjust = 0, vjust = 1.5, size = 5, color = "black")
SVO und Gender
# Daten auf einzigartige IDs reduzieren
data_unique <- data %>%
group_by(ID, gender) %>%
summarize(svo_angle = mean(svo_angle, na.rm = TRUE)) %>%
ungroup()## `summarise()` has grouped output by 'ID'. You can override using the `.groups`
## argument.# Anzahl der Personen in jeder Geschlechtskategorie berechnen und Labels erstellen
gender_counts <- data_unique %>%
group_by(gender) %>%
summarize(count = n()) %>%
mutate(label = paste0(gender, " (n = ", count, ")"))
# Labels in den Datensatz integrieren
data_unique <- data_unique %>%
left_join(gender_counts, by = "gender")
# Analysiere den Zusammenhang zwischen Geschlecht und SVO-Winkel
# Plotting the SVO angle by gender
ggplot(data_unique, aes(x = factor(label, levels = gender_counts$label), y = svo_angle, fill = gender)) +
geom_boxplot() +
labs(title = 'SVO Angle by Gender',
x = 'Gender',
y = 'SVO Angle') +
theme_minimal() +
scale_fill_manual(values = c("male" = "blue", "female" = "green", "diverse" = "purple"))
# Berechne die Korrelation zwischen Gender und SVO-Winkel (dummy kodieren)
data_unique <- data_unique %>%
mutate(gender_numeric = case_when(
gender == "male" ~ 1,
gender == "female" ~ 2,
gender == "diverse" ~ 3
))
correlation_gender_svo <- cor(data_unique$gender_numeric, data_unique$svo_angle, use = "complete.obs")
print(paste("Correlation between gender and SVO angle:", round(correlation_gender_svo, 2)))## [1] "Correlation between gender and SVO angle: 0.13"KUSIV3 und Alter
# Altersgruppen erstellen und deren k3_mean vergleichen
data_unique <- data %>%
group_by(ID, age) %>%
summarize(k3_mean = mean(k3_mean, na.rm = TRUE)) %>%
ungroup() %>%
mutate(age_group = factor(case_when(
age < 25 ~ "Under 25",
age >= 25 & age < 35 ~ "25-34",
age >= 35 & age < 45 ~ "35-44",
age >= 45 & age < 55 ~ "45-54",
age >= 55 ~ "55+"
), levels = c("Under 25", "25-34", "35-44", "45-54", "55+")))## `summarise()` has grouped output by 'ID'. You can override using the `.groups`
## argument.# Anzahl der Personen in jeder Altersgruppe berechnen und Labels erstellen
age_group_counts <- data_unique %>%
group_by(age_group) %>%
summarize(count = n()) %>%
mutate(label = paste0(age_group, " (n = ", count, ")"))
# Labels in den Datensatz integrieren
data_unique <- data_unique %>%
left_join(age_group_counts, by = "age_group")
# Berechne die Korrelation zwischen k3_mean und age
correlation <- cor(data_unique$age, data_unique$k3_mean, use = "complete.obs")
# Plotting the k3_mean by age group with counts in labels
ggplot(data_unique, aes(x = factor(label, levels = age_group_counts$label), y = k3_mean, fill = age_group)) +
geom_boxplot() +
labs(title = 'KUSIV3 (k3_mean) by Age Group',
x = 'Age Group',
y = 'KUSIV3 (k3_mean)') +
theme_minimal() +
coord_flip() +
theme(legend.position = "none") # Entfernt die Legende, da die Farben nicht manuell festgelegt werden
# Scatterplot und Regressionslinie für k3_mean und age
ggplot(data_unique, aes(x = age, y = k3_mean)) +
geom_point(alpha = 0.6, color = "blue") +
geom_smooth(method = "lm", se = FALSE, color = "red") +
labs(title = 'Relationship Between Age and KUSIV3 (k3_mean)',
x = 'Age',
y = 'KUSIV3 (k3_mean)') +
theme_minimal() +
annotate("text", x = max(data_unique$age, na.rm = TRUE), y = min(data_unique$k3_mean, na.rm = TRUE),
label = paste("Correlation:", round(correlation, 2)),
hjust = 1, vjust = -1.5, size = 5, color = "black")## `geom_smooth()` using formula = 'y ~ x'
KUSIV3 und Gender
# Daten auf einzigartige IDs reduzieren
data_unique <- data %>%
group_by(ID, gender) %>%
summarize(k3_mean = mean(k3_mean, na.rm = TRUE)) %>%
ungroup()## `summarise()` has grouped output by 'ID'. You can override using the `.groups`
## argument.# Anzahl der Personen in jeder Geschlechtskategorie berechnen und Labels erstellen
gender_counts <- data_unique %>%
group_by(gender) %>%
summarize(count = n()) %>%
mutate(label = paste0(gender, " (n = ", count, ")"))
# Labels in den Datensatz integrieren
data_unique <- data_unique %>%
left_join(gender_counts, by = "gender")
# Berechne die Korrelation zwischen k3_mean und Geschlecht (dummy kodieren)
data_unique <- data_unique %>%
mutate(gender_numeric = case_when(
gender == "male" ~ 1,
gender == "female" ~ 2,
gender == "diverse" ~ 3
))
correlation_gender_k3 <- cor(data_unique$gender_numeric, data_unique$k3_mean, use = "complete.obs")
# Plotting the k3_mean by gender with counts in labels
ggplot(data_unique, aes(x = factor(label, levels = gender_counts$label), y = k3_mean, fill = gender)) +
geom_boxplot() +
labs(title = 'KUSIV3 (k3_mean) by Gender',
x = 'Gender',
y = 'KUSIV3 (k3_mean)') +
theme_minimal() +
scale_fill_manual(values = c("male" = "blue", "female" = "green", "diverse" = "purple")) +
theme(legend.position = "none") # Entfernt die Legende, da die Farben nicht manuell festgelegt werden
Group-Identification and age
# Altersgruppen erstellen und deren gi_mean vergleichen
data_unique <- data %>%
group_by(ID, age) %>%
summarize(gi_mean = mean(gi_mean, na.rm = TRUE)) %>%
ungroup() %>%
mutate(age_group = factor(case_when(
age < 25 ~ "Under 25",
age >= 25 & age < 35 ~ "25-34",
age >= 35 & age < 45 ~ "35-44",
age >= 45 & age < 55 ~ "45-54",
age >= 55 ~ "55+"
), levels = c("Under 25", "25-34", "35-44", "45-54", "55+")))## `summarise()` has grouped output by 'ID'. You can override using the `.groups`
## argument.# Anzahl der Personen in jeder Altersgruppe berechnen und Labels erstellen
age_group_counts <- data_unique %>%
group_by(age_group) %>%
summarize(count = n()) %>%
mutate(label = paste0(age_group, " (n = ", count, ")"))
# Labels in den Datensatz integrieren
data_unique <- data_unique %>%
left_join(age_group_counts, by = "age_group")
# Berechne die Korrelation zwischen gi_mean und age
correlation <- cor(data_unique$age, data_unique$gi_mean, use = "complete.obs")
# Plotting the gi_mean by age group with counts in labels
ggplot(data_unique, aes(x = factor(label, levels = age_group_counts$label), y = gi_mean, fill = age_group)) +
geom_boxplot() +
labs(title = 'Group Identification (gi_mean) by Age Group',
x = 'Age Group',
y = 'Group Identification (gi_mean)') +
theme_minimal() +
coord_flip() +
theme(legend.position = "none")
# Scatterplot und Regressionslinie für gi_mean und age
ggplot(data_unique, aes(x = age, y = gi_mean)) +
geom_point(alpha = 0.6, color = "blue") +
geom_smooth(method = "lm", se = FALSE, color = "red") +
labs(title = 'Relationship Between Age and Group Identification (gi_mean)',
x = 'Age',
y = 'Group Identification (gi_mean)') +
theme_minimal() +
annotate("text", x = max(data_unique$age, na.rm = TRUE), y = min(data_unique$gi_mean, na.rm = TRUE),
label = paste("Correlation:", round(correlation, 2)),
hjust = 1, vjust = -1.5, size = 5, color = "black")## `geom_smooth()` using formula = 'y ~ x'
Group-Identification and Gender
# Daten auf einzigartige IDs reduzieren
data_unique <- data %>%
group_by(ID, gender) %>%
summarize(gi_mean = mean(gi_mean, na.rm = TRUE)) %>%
ungroup()## `summarise()` has grouped output by 'ID'. You can override using the `.groups`
## argument.# Anzahl der Personen in jeder Geschlechtskategorie berechnen und Labels erstellen
gender_counts <- data_unique %>%
group_by(gender) %>%
summarize(count = n()) %>%
mutate(label = paste0(gender, " (n = ", count, ")"))
# Labels in den Datensatz integrieren
data_unique <- data_unique %>%
left_join(gender_counts, by = "gender")
# Berechne die Korrelation zwischen gi_mean und Geschlecht (dummy kodieren)
data_unique <- data_unique %>%
mutate(gender_numeric = case_when(
gender == "male" ~ 1,
gender == "female" ~ 2,
gender == "diverse" ~ 3
))
correlation_gender_gi <- cor(data_unique$gender_numeric, data_unique$gi_mean, use = "complete.obs")
# Plotting the gi_mean by gender with counts in labels
ggplot(data_unique, aes(x = factor(label, levels = gender_counts$label), y = gi_mean, fill = gender)) +
geom_boxplot() +
labs(title = 'Group Identification (gi_mean) by Gender',
x = 'Gender',
y = 'Group Identification (gi_mean)') +
theme_minimal() +
scale_fill_manual(values = c("male" = "blue", "female" = "green", "diverse" = "purple")) +
theme(legend.position = "none")