Experiment

---

1 Getting started

To copy the code, click the button in the upper right corner of the code-chunks.

1.1 clean up

rm(list = ls())
gc()

1.2 custom functions

We defined a number custom functions, at Download custom_functions.R.

source("./custom_functions.R")

1.3 necessary packages

• tidyverse: data wrangling
• igraph: generate and visualize graphs
• parallel: parallel computing to speed up simulation
• foreach: looping in parallel
• doParallel: parallel backend for foreach
• ggplot2: data visualization
• ggh4x: hacks for ggplot2
• ggpubr: make visualizations publication-ready

packages = c("tidyverse", "igraph", "ggplot2", "parallel", "doParallel", "foreach", "ggh4x", "ggpubr",
    "plotly", "RColorBrewer", "grid", "gridExtra", "patchwork", "ggplotify", "ggraph", "gganimate", "RColorBrewer",
    "ggtext", "magick", "jsonlite", "lubridate", "ggtext")

invisible(fpackage.check(packages))
rm(packages)

---

2 import data

data <- read.csv("./rawdata/all_apps_wide_2026-03-06.csv")
times <- read.csv("./rawdata/PageTimes-2026-03-06.csv")

# cbind(data$participant.node,data$participant.role)[complete.cases(
# #cbind(data$participant.node,data$participant.role)),]

bonus <- data[, c("participant.bonus", "participant.label")]
bonus <- bonus[!is.na(bonus$participant.bonus), ]
bonus_out <- data.frame(id = bonus$participant.label, bonus = bonus$participant.bonus)
nrow(bonus_out)

#> [1] 40

write.table(bonus_out, "bonus.txt", sep = ",", row.names = FALSE, col.names = TRUE, quote = FALSE)

---

3 results

On 06-03-2026, I recruited 58 Prolific participants via a brief sign-up survey to populate a network of N=50 (with a 10% minority group).

net <- jsonlite::fromJSON("./networks/network_test_n50.json")

g <- graph_from_adjacency_matrix(net$adj_matrix, mode = "undirected")
V(g)$role <- ifelse(net$role_vector == 1, "trendsetter", "conformist")

fplot_graph(g)

3.1 diagnostics

3.1.1 dropout

dropout_long <- data %>%
    filter(!is.na(participant.node)) %>%
    select(participant.label, participant.role, matches("unpop\\.[0-9]+\\.player\\.is_dropout")) %>%
    pivot_longer(cols = matches("unpop\\.[0-9]+\\.player\\.is_dropout"), names_to = "round", values_to = "is_dropout") %>%
    mutate(round = str_extract(round, "[0-9]+"), round = as.numeric(round))

dropout_df <- data.frame(player = 1:nrow(data), dropout_round = apply(do.call(cbind, data[paste0("unpop.",
    1:25, ".player.is_dropout")]), 1, function(x) which(x == 1)[1]))
ggplot(na.omit(dropout_df), aes(x = dropout_round)) + geom_bar()

---

3.2 unpopular norm spread

df_long <- data %>%
  filter(!is.na(participant.node)) %>%
  select(participant.label, participant.role, participant.node, starts_with("unpop.")) %>% #also include network node.
  
  pivot_longer(
    cols = matches("unpop\\.\\d+\\.player\\.choice$"),  # only choice columns
    names_to = "round",
    values_to = "choice"
  ) %>%
  mutate(
    round = as.integer(gsub("unpop\\.(\\d+)\\.player\\.choice", "\\1", round)),
    is_bot = ifelse(participant.label == "", TRUE, FALSE)
  ) %>%
  select(participant.label, participant.node, participant.role, round, choice, is_bot)


# identify round of dropout:
first_dropout <- dropout_long %>%
  filter(is_dropout == 1) %>%
  group_by(participant.label) %>%
  summarise(dropout_round = min(round),
            .groups = "drop")

# and add to the df:
df_long <- df_long %>%
  left_join(first_dropout, by = "participant.label")

# aggregated
df_plot <- df_long %>%
  group_by(round) %>%
  summarise(
    pct_choice1 = mean(choice, na.rm = TRUE) * 100,  # proportion * 100
    n = n()
  )

ggplot(df_plot, aes(x = round, y = pct_choice1)) +
  geom_line(group = 1, color = "steelblue", size = .5) +
  geom_point(color = "steelblue", size = 2) +
   geom_hline(yintercept = 10, linetype = "longdash", color = "darkgrey", size = 0.8) +  # dashed line at 10
  scale_x_continuous(breaks = df_plot$round) +
  scale_y_continuous(limits = c(0, 100)) +  
  labs(
    x = "Round",
    y = "% agents choosing 'blue'",
    title = "Evolution of an unpopular norm"
  )

#sort by node
df_long <- df_long %>%
  arrange(participant.node) %>%
  select(-participant.label)

df_long$dropout_round[is.na(df_long$dropout_round)] <- 25 #non dropouts, set to 25.

# make roles consistent with utility function roles
df_long$role <- ifelse(df_long$participant.role == "Blue", "trendsetter", "conformist")

# specificy incentive structure parameters
params = list(s = 15, e = 10, w = 40, z = 50, lambda1 = 5, lambda2 = 1.8)

df_long$id <- df_long$participant.node + 1 #nodes are 0-indexed

#add degree
deg <- degree(g)
df_long <- df_long %>%
  mutate(degree = deg[id])

calculate_round_utilities <- function(current_round, df_long, network, params) {
  # previous round data
  df_prev <- df_long %>%
    filter(round == current_round - 1) %>%
    select(id, role, choice)
  
  # current round data
  df_curr <- df_long %>%
    filter(round == current_round)
  
  # compute utilities
  df_curr <- df_curr %>%
    rowwise() %>%
    mutate(
      util_0 = futility(agent_id = id, choice = 0,
                         agents = df_prev,
                         network = network,
                         params = params)$utility,
      util_1 = futility(agent_id = id, choice = 1,
                         agents = df_prev,
                         network = network,
                         params = params)$utility
    ) %>%
    ungroup()
  
  return(df_curr)
}

##calculate_round_utilities(2, df_long, network = g, params = params)

#compute utilities for all rounsd (except round 1)
max_round <- max(df_long$round)
df <- map_dfr(2:max_round, ~calculate_round_utilities(.x, df_long, g, params))

# identify best replies
df <- df %>%
  mutate(
    predicted_choice = ifelse(util_1 > util_0, 1, 0),
    best_reply = (choice == predicted_choice)  # TRUE if agent picked the choice with highest utility
  )


df_summary <- df %>%
  mutate(
    preferred_choice = ifelse(role == "trendsetter", 1, 0),    # define preferred option by role
    chose_preferred = (choice == preferred_choice)            # TRUE if they picked their preferred option
  ) %>%
  group_by(round, role) %>%
  summarize(
    n_agents = n(),
    prop_preferred = mean(chose_preferred),   # fraction that chose their preferred option
    prop_best_reply = mean(best_reply),       # fraction that picked the highest-utility choice
    .groups = "drop"
  )


ggplot(df_summary, aes(x = round)) +
  geom_line(aes(y = prop_preferred, color = "Preference"), size = 1) +
  geom_line(aes(y = prop_best_reply, color = "Best reply"), size = 1, linetype = "dashed") +
  facet_wrap(~role) +
  scale_y_continuous(labels = scales::percent_format(accuracy = 1), limits = c(0,1)) +
  scale_color_manual(values = c("Preference" = "darkgreen", "Best reply" = "steelblue")) +
  labs(
    x = "Round",
    y = "Proportion of agents",
    color = "Metric",
    title = "Following preference vs best-reply over rounds"
  )

table(data$survey.1.player.enjoyment)

#> 
#>  1  3  4  5 
#>  1  4 15 19

table(data$survey.1.player.clarity)

#> 
#>  4  5 
#> 16 23

table(data$survey.1.player.majority)

#> 
#>  1  2 
#> 20 19

fshowdf(unique(data$survey.1.player.strategy))

x
i tried to go with the flow with my neighbors
i tried to connect with the neighbours, so we can match more often, then i started picking red for the point increase
I tried to follow a pattern based on what my neighbors answered.
I expected everyone to choose Red since Red = assured number of points, and it’s the color that guarantees a maximum gain. For some reason not everyone did choose red, unless I missed a point where some people need the blue shirt for those initial 15 points. I kept choosing red until it became clear that blue was dominant and by dominant I mean 5/6 of my neighbors did choose it for some reason. a 4/6 they should have been having 39 points (only 2 points higher than me). So once I started choosing blue I kept it that way. I assumed that I have been grouped with different people who prioritized blue.
Since red team members were more, i used the ratio of 4:1 in deciding what to choose
Keeping in the color with the better recompense, changing to another when the occasion seems to promise better benefits
Didnt used any strategy but just some good guesses
I did not have a strategy
I would always try and look for how to gain more points by assessing which shirt was picked by most people the last round.
I choose the color if I see more than 3 people choosing that color
I always chose red because I knew it was the only option that guaranteed I’d benefit in each round.
I decided on the bases of the other members choices, if they choosing majorly red then i choose red but if they choose blue then i also choose blue according to the majority of the members decision
I saw in each round how many more shirts there were and in the next round I chose that one.
I used color which was chosen by more players in the previous rounds
I checked the one with higher points, judging from previous accumulated points
I followed what my neighbours seemed to choose keeping in mind which option benefits me more and is aligned to their choices.
Based on the previous neighbours wearings
I decided to wear the color that most people wore the day before hoping that I would get more points that way.
Firstly I was trying to convince them for the red to get the most points. but the were insisting on blue so I decided to go with flow for earning much points. from time to time I give a red one to convince them back for the red but I failed.
At first I was going to choose depending on what my neighbors did, but after picking blue one time and getting 0 points, I realised that picking red every time will just be a more sound strategy as there is no way to lose completely. I continued to pick red every single time until approximately halfway into the experiment my neighbors started picking blue every single time, at which point after two or three rounds I had to conform to the rest of the group because it seemed like they weren’t going to conform to me.
I tried to fit in with the rest of the team to get bonus
I was checking which T-shirt my neighbors chose most of the time.
I tried to predict my neighbors colors and choose the color that I tought the majority was choosing
One that would maximise my bonus by choosing red almost all the time.
non just chose the one felt good for that day
In the first rounds, I tried the blue because we can have more points and after that I always choose de blue. I see that the red neigbours does’nt at all . In the middle I changed to the red to insit the red one to bascule to the blue but it changed nothing and after I always choose the blue side.
That I should check my neighbors previous decisions, so I decide on which T-shirt to choose for the next day.
I used the instructions I was given
I went with the one that would give the most points every singke time
I prioritized coordinatio. I switch to blue when 2 or more neighbors chose it beacuse the payoff was higher than staying with red.
I chose depending on the color my neighbors and the majority chose
I noticed that my neighbours liked a certain colour, so I stuck with that colour
I always selected my colour because I was gurenteed points
Weighing my options before deciding on the perfect color was a crucial part of the game, but once my team stuck to one color, everything went perfect. The strategy i used was to pick a colour that has a fixed point, but it later changed.
At first i choose red bcz it seems we got a stable base points. But then we have to check the trend of our neighbors. Blue seems to get more points and Red at the same number of neighbors. So if it is equal in number, we need to switch to blue right away

fshowdf(unique(data$survey.1.player.perceived_rq))

x
it was about influence of other people at my choice
perhaps the decision making given the fact that, the preferred t shirt color gave always some points
I think i was a logic and coorditation game, like a behavior study.
At what point is the person ready to gamble and risk his safety line of 15 points? Maybe Or maybe it’s at what point does the person start following the masses.
To check decision making in the context of synchronization with team members
Influence of behaviors within communities
Trying to see how the majority of the votes affect the choice of each player.
Maybe they were trying to understand people’s working of mind? like where does they lean to gurantee little points? or risked but bigger rewardss
they are trying to see what people will often side with
I think it is judge how people influence each other when it comes to decision making.
I think the researchers wanted to study whether a person’s psychology and decision-making are based on the changes in those around them.
Study about herd mentality
I think this study was examining how people’s decisions are influenced by assumptions of others’ actions.
The experiment was based on the decision making in the pressure situation. How we react in a pressure situation.
What majority chooses red and what majority chooses blue?
Strategic thinking
The study was about the fashion dilemma
How our neighbours’ choice affects ours and to what extent.
The experiment is studying how people make decisions in social networks when coordination matters.
I think that the experiment is about how people are pressured into choosing something based on what other people choose.
I think the idea was to try to see how easily others are influenced by the majority and willing to fit in.
Psychology of the affection with people choices and how long would you consist on your opinion if different. The money was added to attract you more toward following the majority and matching with neighbors. I guess also my neighbors were AI bots to make the study on me
This experiment was definitely about peer pressure and conforming to expectations. With something on the line (a bonus payment) I am more likely to change my strategy if what I’ve been doing until then isn’t working.
this was test decision making within the group
to see if people could take risks
About team work and critical thinking
I think this experiment is about psychology + behavioral economics and social influence
If individuals follow the crowd or not
seeing the decising people make or the decision people chose
I think it is about groups psychological behaviours. The researcher try to find the degree of mutual help within a group.
The experiment was about finding out what the majority is going to choose based on the colors and the decisions of the others.
Memory and speed
Whether people can change their choices (even though they provide the best outcome) based on the actions of others.
Social coordination and how individual preferences change to match the group’s behaviour for higher rewards.
I think the researcher is trying to answer the question of how players in group setting maximize profits by predicting the trend or other players’ mind
Red was preferred more than blue
Seeing people’s decsion making skills based on external influence
I think the researcher is trying to discover decision-making in a group of people, and what factors influence those decisions.
To test the mentality in group behaviours

fshowdf(unique(data$survey.1.player.comments))

x
no, thank you
nothing else to add.
None
Can I see which color will be the dominant one in the whole game after finishing?
I enjoyed it very much.
I want more!!!
I would like to participate in similar tasks again.
Thank you for the fun experiment and the game in the waiting room!
I had fun with this experiment.
I would like to receive the explanation of the study and share in any future similar studies
I liked that there was a minigame!
no
No, this experiment is clear and interesting
n/a
enjoyed the game
I enjoyed the experiment, thank you.
N/A
Everything was clear and the interface was easy to use. I would like to participate in a similar experiment.
Thank you, this was fun
I like this study and theme. wish u all the best

# completion_code:CI5BFLAB

---

Copyright © Rob Franken