Trolley Data

Experiment

We investigated three principles:

• The action principle: Harm caused by action is morally worse than equivalent harm caused by omission.
• The intention principle: Harm intended as the means to a goal is morally worse than equivalent harm foreseen as the side effect of a goal.
• The contact principle: Using physical contact to cause harm to a victim is morally worse than causing equivalent harm to a victim without using physical contact.

(Cushman et al., 2006)

For each scenario, subjects rated the protagonist’s harmful action or omission on a scale from 1 to 7, with 1 labeled ‘‘Forbidden,’’ 4 labeled ‘‘Permissible,’’ and 7 labeled ‘‘Obligatory.’’

(Cushman et al., 2006)

aqu

Aquariium

cfaqu (Contact)

Connor is at a new aquarium exhibit when he sees a visitor slip on a wet floor, fall down, and break his neck. The visitor is still alive and can be safely evacuated by medics so long as he is not moved. He has fallen, however, on top of the oxygen supply line servicing five other visitors in an underwater observation pod. Without oxygen, the five visitors will soon die. If Connor does nothing the one visitor will be safely evacuated, but the five visitors in the pod will die. If Connor pushes the one visitor off the supply line this one visitor will die, but the five visitors in the pod will have their oxygen restored and will live. Connor decides to push the one visitor. Pushing the one visitor is:

fkaqu (Action)

Mike is at a new aquarium exhibit when he sees a visitor slip on a wet floor, fall down, and break his neck. The visitor is still alive and can be safely evacuated by medics so long as he is not moved. He has fallen, however, on top of the oxygen supply line servicing five other visitors in an underwater observation pod. Without oxygen, the five visitors vnll soon die. If Mike does nothing the one visitor will be safely evacuated, but the five visitors in the pod will die. If Mike pulls the supply line out from under the one visitor this one visitor will die, but the five visitors in the pod viiill have their oxygen restored and will live. Mike decides to pull the supply line. Pulling the supply line is:

bur

Burning

cfbur (Contact)

Rick is a fireman trying to help five children out of a burning house. There is only one window from which the children can be safely evacuated, and it is jammed shut. Rick must immediately smash open this large, heavy window or else all five children will die. Outside the window, on the sill, is a man safely awaiting evacuation who Rick cannot help hitting with his fist if he breaks the window, causing the man to fall off the sill. Falling off the sill is certain to kill the man. If Rick breaks open the window he will hit the man with his fist, the man will fall off and die, but the five children will be safely evacuated. If Rick does not break open the window the man will be safely evacuated, but the children will die. Rick decides to break open the window. Breaking open the window is:

cibur (Intention, Contact)

Peter is a fireman trying to help five children out of a burning house. There is only one window from which the children can be safely evacuated, and it isjammed shut. Peter must immediately use an object to smash open this large, heavy window or else all five children will die. The only sufficiently large object is a man on his way towards safely escaping the buming house. Crashing through the window is certain to kill the man. If Peter pushes the man into the window and breaks it open, the man will fall out and die, but the five children will be safely evacuated. If Peter does not push the man into the window the man will safely escape, but the five children will die. Peter decides to push the man. Pushing the man is:

fkbur (Action)

Ken is a fireman trying to help five children out of a burning house. There is only one window from which the children can be safely evacuated, and it is jammed shut. Ken must immediately smash open this large, heavy window or else all five children will die. Outside the window, on the ground below, is a man safely awaiting evacuation who Ken cannot help hitting with heavy falling glass if he breaks the window. The falling glass is certain to kill the man. If Ken breaks open the window, he will hit the man with the glass, the man will die, but the five children will be safely evacuated. If Ken does not break open the window, the man will be safely evacuated, but the five children will die. Ken decides to break open the window. Breaking open the window is:

ikbur (Action, Intention)

Andy is a fireman trying to help five children out of a buming house. There is only one window from which the children can be safely evacuated, and it is jammed shut. Andy must immediately use an object to smash open this large, heavy window or else all five children will die. The only sufficiently large object is a man on his way towards safely escaping the buming house. Andy can break open the window by swinging a piece of burning debris towards the man, which will cause the man to Jump out of the way, lose his balance and crash into the window. Falling out of the window is certain to kill the man. If Andy swings the burning debris the man will break open the v«ndow, fall out and die, but the five children will be safely evacuated. If Andy does not swing the burning debris, causing the man to break open the window, the man will safely escape, but the five children will die. Andy decides to swing the burning debris. Swinging the burning debris is:

rub

Rubble

cfrub (Contact)

Fred is working on the top floor of a construction project when he sees a gearbox at the end of a steel beam is about to break. Suspended from the gearbox is an elevated platform with five workers on it, and if the gearbox breaks the five workers will fall to their deaths. Fred can save the five if he rushes across the steel beam immediately to engage the backup mechanism on the gearbox. In between Fred and the gearbox there is a worker standing on the beam. Fred knows that if he rushes across the narrow beam he is certain to bump into the other worker, causing this worker to fall to his death. The construction site is too noisy for Fred to warn the other worker. If Fred does nothing, the gearbox will break and the five workers will fall to their deaths, but the one worker will remain safe. If Fred rushes to engage the backup mechanism, the five workers will be saved but Fred VÄW bump into the one worker, who vnll fall to his death. Fred decides to rush to engage the backup mechanism. Rushing to engage the backup mechanism is:

nfrub (Action)

Ethan is working on the top floor of a construction project when he sees a gearbox at the end ofa steel beam is about to break. Suspended from the gearbox is an elevated platform withfiveworkers on it, and if the gearbox breaks thefiveworkers will fall to their deaths. Ethan can save the five if he rushes across the steel beam immediately to engage the backup mechanism on the gearbox. In between Ethan and the gearbox there is a gate and a worker standing next to the gate. Ethan knows that if he rushes through the gate, the gate is certain to bump into the other worker, causing this worker to fall to his death. The construction site is too noisy for Ethan to warn the other worker. If Ethan does nothing, the gearbox will break and the five workers will fall to their deaths, but the one worker will remain safe. If Ethan rushes to engage tbe backup mechanism, the five workers will be saved but Etban will cause the gate to bump into the one worker, wbo will fall to his death, Etban decides to rusb to engage tbe backup mechanism. Rushing to engage the backup mechanism is:

box

Boxcar

Control

Ben sees that an empty runaway boxcar is headed down a track. There is nobody on the track. There is one person working on a side track. If Ben flips the switch, the boxcar will turn onto the side track and hit the one person. If Ben does not flip the switch, the boxcar will continue on the track, and nobody will be hit. Ben decides to flip the switch. Flipping the switch is:

cibox (Intention, Contact)

Standing on a footbridge spanning the railroad tracks, Frank sees an empty, outof-control boxcar about to hit five people. Frank’s leg is stuck in the railing, but next to Frank is one person who he can push, causing the one person to fall off the footbridge and onto the main track where he will be hit by the boxcar. The boxcar will slow down because of the one person, therefore preventing the five from being hit. If Frank pushes the one person, the one person will fall and be hit by the boxcar, and therefore the boxcar will slow down and not hit the five people. If Frank does not push the one person the boxcar will continue down the tracks and hit five people, and the one person will remain safe above the main track. Frank decides to push the one person. Pushing the one person is:

fkbox (Action)

Standing by the railroad tracks, Dennis sees an empty, out-of-control boxcar about to hit five people. Next to Dennis is a lever that can be pulled, sending the boxcar down a side track and away from the five people. But pulling the lever will also lower the railing on a footbridge spanning the side track, causing one person to fall off the footbridge and onto the side track, where he will be hit by the boxcar. If Dennis pulls the lever the boxcar will switch tracks and not hit the five people, and the one person to fall and be hit by the boxcar. If Dennis does not pull the lever the boxcar will continue down the tracks and hit five people, and the one person will remain safe above the side track. Dennis decides to pull the lever. Pulling the lever is:

ikbox (Action, Intention)

Standing by the railroad tracks, Evan sees an empty, out-of-control boxcar about to hit five people. Next to Evan is a lever that can be pulled, lowering the railing on a footbridge that spans the main track, and causing one person to fall off the footbridge and onto the main track, where he wiil be hit by the boxcar. The boxcar will slow down because of the one person, therefore preventing the five from being hit. If Evan pulls the lever the one person vñll fall and be hit by the boxcar, and therefore the boxcar will slow down and not hit the five people. If Evan does not pull the lever the boxcar will continue dovm the tracks and hit the five people, and the one person will remain safe above the main track. Evan decides to pull the lever. Pulling the lever is:

ilbox (Intention)

Standing by the railroad tracks, Jeff sees an empty, out-of-control boxcar speeding toward five people. There is one person on a footbridge spanning the main tracks who is slipping and about to fall onto the main track, where he will be hit by the boxcar. The boxcar will slow down because of the one person, therefore preventing the five from being hit. Next to Jeff is a lever that can be pulled, raising the railing on the footbridge and preventing the one person from falling. If Jeff does not pull the lever the one person will fall and be hit by the boxcar, and therefore the boxcar will slow down and not hit thefivepeople. IfJeff pulls the lever the boxcar vnW continue down the tracks and hit five people, and the one person will remain safe above the main track. Jeff decides not to pull the lever. Not pulling the lever is:

spe

Speedboat

Control

Adam is driving his motorboat when he notices five swimmers drowning in the distance. If Adam does not drive towards them at top speed, all five will die. In order to drive at top speed, Adam must accelerate quickly. If Adam accelerates quickly, he will save the five drowning swimmers. If Adam does not accelerate quickly, the five swimmers will drown. Adam decides to accelerate quickly. Accelerating quickly is:

fkspe (Action)

Matt is driving a motorboat when he notices five swimmers drowning in the distance. If Matt does not drive toward them at top speed he will not arrive in time, and all five will die. In order to drive at top speed. Matt must accelerate quickly. Accelerating quickly will also cause a passenger to tumble off the back of the boat. This passenger cannot swim and will drown. If Matt accelerates quickly, the one passenger will drown, but Matt will save the five drowning swimmers. If Matt does not accelerate quickly, the one passenger will stay safely on the boat, but the five swimmers will drown. Matt decides to accelerate quickly. Accelerating quickly is:

ikspe (Action, Intention)

Dave is driving a motorboat when he notices five swimmers drovming in the distance. If Dave does not drive toward them at top speed he will not arrive in time, and all five will die. In order to drive at top speed, Dave must lighten the load on his boat. The only way to lighten the load is to accelerate quickly and cause a passenger to tumble of the back of the boat. This passenger cannot swim and will drown. If Dave accelerates quickly, the one passenger will drown, but Dave will save the five drowning svnmmers. If Dave does not accelerate quickly, the one passenger will not drown, but the five swimmers will drown. Dave decides to accelerate quickly. Accelerating quickly is:

cispe (Intention, Contact)

John is driving a motorboat when he notices five swimmers drowning in the distance. If John does not drive toward them at top speed, he will not arrive in time, and all five will die. In order to drive at top speed, John must lighten the load on his boat. The only way to lighten the load is to push his passenger with his hands and cause the passenger to tumble off the back of the boat. This passenger cannot swim and will drown. If John pushes the passenger, the one passenger will drown, but John will save the five drowning swim mers. IfJohn does not push the passenger, the one passenger will not drovm, but the five swimmers will drown. John decides to push the one passenger. Pushing the one passenger is:

boa

Boat

fkboa (Action)

Justin is driving his motorboat in the bay when he notices some swimmers in trouble. There are five swimmers drowning at the end of a narrow channel in front of Justin, In between Justin and the drowning swimmers is another swimmer who is safe and not in trouble. If Justin takes the narrow channel to the five drowning swimmers and saves them, the wake from Justin’s boat will wash over the safe swimmer, drovkining him. If Justin does nothing, the five swimmers will drown and the one swimmer will remain safe, Justin decides to take the narrow channel. Taking the narrow channel is:

flboa (none)

Don is driving his motorboat in the bay when he notices some swimmers in trouble. There are five swimmers drowning at the end of a channel in front of Don, To the side of the channel there is another swimmer drowning. If Don stops to save the one swimmer on the side of the channel, he will not be able to get to the five swimmers in time to save them. If Don continues to speed towards the five swimmers past the one swimmer, the one swimmer will drown, but he will reach the five swimmers in time to save them, Don decides to continue to speed towards the five swimmers. Continuing to speed towards the five swimmers is:

car

Car

fkcar (Action)

Ed is driving five sick people to the hospital. They are in critical condition and will die if Ed makes any stops along the way. In his hurry to pack them in the car Ed slams the door on a few feet of tbick cord that is now dangling beside the car. Ed takes the fastest route to the hospital, which is a narrow, unpaved mountain pass. On his way, Ed sees a rock climber hanging onto tbe side of the mountain beside the road. The rock climber is safe and in control, but if Ed drives by the thick cord dragging along the side of his car will dislodge the rock climber, causing him to fall to his death. If Ed slows to a stop and waits, tbe rock climber will be able to reach a stable landing where the cord will not dislodge him, but it will be too late to save the five people. If Ed continues to drive, the one person will fall to his death and the five will be saved. Ed decides to continue to drive. Continuing to drive is:

flcar (none)

Jack is driving five sick people to tbe hospital. They are in critical condition and will die ifJack makes any stops along tbe way. In bis hurry to pack them in the car Jack slams the door on a few feet of thick cord that is now dangling beside the car. Jack takes the fastest route to the hospital, which is a narrow, unpaved mountain pass. On his way. Jack sees a rock climber hanging onto the side of the mountain beside the road. The rock climber is losing control and is about to fall to his death, but he could be saved if he had a cord to pull himself up. IfJack slows to a stop the rock climber will be able to use the cord dangling from the side of the car to pull himself up to safety, but it will be too late to save thefivepeople. Ifjack continues to drive, the one person will fall to his death and the five will be saved, jack decides to continue to drive. Continuing to drive is:

swi

Switch

flswi (none)

Todd is operating the switch at a railroad station when he sees an empty, out of control boxcar coming down the tracks. It is moving so fast that anyone it hits will die immediately. The boxcar is beaded towards a repairman whose leg is caught in the switch. If Todd does nothing, the boxcar will hit the repairman and then come to a stop on the empty main track where nobody else is threatened. Todd can pull a lever that will switch the tracks and release the repairman’s leg, allowing him to Jump safely out of the way. However, switching the tracks will send the boxcar down a side track where it will hit five other repairmen working on the tracks. Todd decides not to pull the lever. Not pulling the lever is:

fkswi (Action)

Luke is operating the switch at a railroad station when he sees an empty, out of control boxcar coming down the tracks. It is moving so fast that anyone it hits will die immediately. The boxcar is headed towards five repairmen on the track. If Luke does nothing, the boxcar will hit the five repairmen on the track. Luke can pull a lever redirecting the boxcar to an empty sidetrack. However, pulling the lever will cause the switch to crush one other repairman working on the switch, who will die immediately. Luke decides to pull the lever. Pulling the lever is:

ilswi (Intention)

Alan is operating tbe switch at a railroad station when he sees an empty, out of control boxcar coming down the tracks. It is moving so fast that anyone it bits will die immediately. Tbe boxcar is headed towards a repairman whose leg is caught in tbe switch. Further down the main track are five more repairmen. If Alan does nothing, the boxcar will hit the one repairman and therefore slow to a stop and not hit the otber five repairmen. Alan can pull a lever and release tbe repairman’s leg, allowing him to jump safely out of tbe way. However, releasing the repairman will allow the boxcar to continue down tbe main track wbere it will hit the five otber repairmen working on tbe tracks. Alan decides not to pull tbe lever. Not pulling the lever is:

che

Chemical

flche (none)

Tim works at a hospital. He is in charge of a machine that can both increase and decrease the amount of a certain chemical in a patient’s bloodstream. Too much or too littie of the chemical results in death. Tim notices that the machine has pumped a near toxic amount of the chemical into a patient’s body. Tim must immediately stop the machine to save the patient’s life. However, he sees that five other patients with toxic amounts of the chemical are hooked up to the machine. The machine is removing the chemical from these five patients. If Tim stops the machine to save the one patient, the five other patients will die. If Tim does not stop the machine, the one patient will die, but the five other patients will survive. Tim decides not to stop the machine. Not stopping the machine is:

ilche (Intention)

Bob works at a hospital. He is in charge of a machine that can both increase and decrease the amount of a certain chemical in a patient’s bloodstream. Too much or too little of the chemical results in death. Bob notices that the machine has pumped a near toxic amount of the chemical into a patient’s body. Bob must immediately disconnect the patient to save the patient’s life. However, he sees that five other patients with toxic amounts of the chemical are hooked up to the machine. The machine is removing the chemical from these five patients and will continue to do so only if it can maintain equilibrium by continuing to pump the chemical into the one patient. If Bob disconnects the machine to save the one patient, the machine will not be abie to maintain equilibrium and the five other patients will die. If Bob does not disconnect the machine from the one patient, the one patient will die, but the five other patients will survive. Bob decides not to disconnect the machine from the one patient. Not disconnecting the machine from the one patient is:

sha

Shark

flsha (none)

Joe is drifting along in his motorboat at tbe mouth of a narrow channel wben he notices a shark approaching. Further down the channel he sees five swimmers. If Joe maintains his current position, his boat will obstruct the entrance to tbe channel, thereby preventing the shark from attacking tbe five swimmers. However, Joe sees another swimmer drowning in tbe distance, Joe can save the one swimmer by immediately moving toward him in tbe motorboat tbereby leaving the channel open to the sbark. If Joe moves towards tbe one swimmer in bis motorboat, the one swimmer will live but the five swimmers will be eaten by tbe shark. If Joe does not move toward bim, tbe one swimmer will drown but the five swimmers will remain safe. Joe decides not to move toward tbe one swimmer. Not moving toward tbe one swimmer is:

ilsha (Intention)

Casey is drifting along in bis motorboat near tbe mouth of a narrow channel when be notices a shark approaching. Further down tbe cbannel be sees five swimmers. However, one other swimmer is positioned at the mouth of the cbannel such that the shark will attack the one first, giving the five the necessary time to escape. Casey can save the one swimmer by immediately moving toward him in the motorboat, but saving the one swimmer would also leave the charmel open to the shark. If Casey moves towards the one swimmer, the one swimmer will live but the five swimmers will be eaten by the shark. If Casey does not move toward him, the one swimmer will be eaten by the shark but the five swimmers will remain safe. Casey decides not to move toward the one swimmer. Not moving toward the one swimmer is:

pon

Pond

ikpon (Action, Intention)

James is hiking through a foreign land when he comes across a remote village. James learns that one of the villagers fell into a cursed pond but, contrary to local superstition, did not die. If the one villager does not die by sunrise, five other innocent and unwilling villagers will be sacrificed to the gods to thank them for sparing the one. James, who has some medical training, realizes that he can prevent the sacrifice ofthe five villagers if he secretly poisons the one villager. If James poisons the one, the one will be dead by sunrise, and thefivewill not be sacrificed. If James does not poison the one, the one will not be dead by sunrise, and the five will be sacrificed as planned, James decides to poison the one. Poisoning the one is:

ilpon (Intention)

Robert is hiking through a foreign land when he comes across a remote village. Robert learns that one of the villagers fell into a cursed pond but, contrary to local superstition, did not die. If the one villager does not die by sunrise, five other innocent and unwilling villagers will be sacrificed to the gods to thank them for sparing the one. Robert, who has some medical training, notices that the one has accidentally consumed a poisonous substance. Robert can administer the antidote to the one villager. If Robert withholds the antidote from the one, the one will die by sunrise, and the five will not be sacrificed. If Robert does provide the antidote to the one, the one will not be dead by sunrise, and the five will be sacrificed as planned. Robert decides not to provide the antidote to the one. Not providing the antidote to the one is:

shi

Ship

ikshi (Action, Intention)

Mark receives a communication that the captain of a cargo ship has contracted a highly infectious disease. The captain himself is only a carrier of the disease and is immune to the symptoms, but anybody who comes into contact with him will die. No passengers are on the ship. The ship is headed for a remote island where the captain will hand-deliver the cargo to the five islanders. The captain does not know that he is carrjang the disease and has no radio on board to receive a warning. Mark takes off in a helicopter to intercept the ship, but from a distance he sees the ship about to dock. The only way Mark can stop the captain from transmitting the disease is to use a missile to blow up the ship. If Mark fires the missile, the captain vnll die and the five islanders will live. If Mark does not fire the missile, the captain will live and the five islanders will die. Mark decides to fire the missile. Firing the missile is:

ilshi (Intention)

George receives a communication that the captain of a cargo ship has contracted a highly infectious disease. The captain himself is only a carrier ofthe disease and is immune to the symptoms, but anybody who comes into contact with him will die. No passengers are on the ship. The ship is headed for a remote island where the captain will hand-deliver the cargo to the five islanders. The captain does not know that he is carrying the disease and has no radio to receive a warning. George takes off in a helicopter to intercept the ship, but from a distance he sees the ship about to dock. The ship is on fire, however, and the captain will be burned before the ship docks. George could fire a missile into the water next to the ship, causing a splash that wouid put out the fire and save the captain. If George fires the missile the captain will live but the disease will be transmitted, killing the five islanders. If George does not fire the missile the captain will die and the five islanders will live. George decides to fire the missile. Firing the missile is:

Data Set

Observations - 9930 total observations - 331 test takers - 30 stories per test taker

Response: 1 (Forbidden) to 7 (Obligatory)

Setup

library(tidyverse)
library(tidybayes)
library(bayesplot)
library(cmdstanr)
library(loo)

library(dagitty)
library(ggdag)

options(scipen = 100, digits = 4)

df <- read.csv("new_trolley.csv") |>
  mutate(
    response = as_factor(response),
    id = as_factor(id),
    case = as_factor(case),
    story = as_factor(story),
    gender = ifelse(male, "male", "female") |>
      as_factor() |>
      fct_relevel("male", "female"),
    age_std = scale(age) |> drop(),
    edu = as_factor(edu) |>
      fct_relevel(
        "Elementary School",
        "Middle School",
        "Some High School",
        "High School Graduate",
        "Some College",
        "Bachelor's Degree",
        "Master's Degree",
        "Graduate Degree"
      )
  )

Model 1: A, I, C

dagitty(
  'dag {
"A,I,C" [exposure,pos="-0.204,-0.022"]
Response [outcome,pos="-0.083,-0.022"]
"A,I,C" -> Response
}'
) |>
  tidy_dagitty() |>
  ggdag_status(text_size = 2) +
  theme_dag_gray(legend.position = "bottom")

\[ \begin{align} \mathit{R}_i &\sim \mathrm{OrderedLogit}(\phi_i, \alpha) \\ \phi_i &= \beta_{A}A_i + \beta_{I}I_i + \beta_{C}C_i \\ \beta_k &\sim \mathrm{Normal}(0, 0.5) \\ \alpha_j &\sim \mathrm{Normal}(0, 1), \quad \alpha_1 < \alpha_2 < \cdots \end{align} \]

new_trolley.stan

data {
  int<lower=1> n;
  int<lower=1> n_response;
  
  array[n] int<lower=1, upper=n_response> response;
  vector<lower=0, upper=1>[n] contact;
  vector<lower=0, upper=1>[n] intention;
  vector<lower=0, upper=1>[n] action;
}
parameters {
  ordered[n_response - 1] alpha;
  real bA;
  real bI;
  real bC;
}
model {
  vector[n] phi = bA * action + bI * intention + bC * contact;
  
  alpha ~ normal(0, 1);
  bA ~ normal(0, 0.5);
  bI ~ normal(0, 0.5);
  bC ~ normal(0, 0.5);
  
  response ~ ordered_logistic(phi, alpha);
}

Fitting and diagnostics

model <- cmdstan_model("new_trolley.stan")
fit <- compose_data(df) |>
  model$sample(chains = 4, parallel_chains = 4, output_dir = "stan_output")

mcmc_trace(fit$draws(), regex_pars = "alpha")

mcmc_trace(fit$draws(), regex_pars = "b")

mcmc_pairs(fit$draws(), regex_pars = "alpha")

mcmc_pairs(fit$draws(), regex_pars = "b")

Interpretation

posterior <- fit$draws() |>
  recover_types(df) |>
  spread_draws(alpha[n], bA, bI, bC) |>
  pivot_wider(names_from = n, names_prefix = "alpha_", values_from = alpha)

prediction_grid <- expand_grid(
  action = c(0, 1),
  intention = c(0, 1),
  contact = c(0, 1)
)

predictions <- posterior |>
  crossing(prediction_grid) |>
  mutate(
    phi = bA * action + bI * intention + bC * contact,
    p1 = plogis(alpha_1 - phi),
    p2 = plogis(alpha_2 - phi) - plogis(alpha_1 - phi),
    p3 = plogis(alpha_3 - phi) - plogis(alpha_2 - phi),
    p4 = plogis(alpha_4 - phi) - plogis(alpha_3 - phi),
    p5 = plogis(alpha_5 - phi) - plogis(alpha_4 - phi),
    p6 = plogis(alpha_6 - phi) - plogis(alpha_5 - phi),
    p7 = 1 - plogis(alpha_6 - phi)
  ) |>
  select(-c(phi)) |>
  pivot_longer(
    starts_with("p"),
    names_to = "cat",
    values_to = "prob"
  ) |>
  mutate(category = readr::parse_number(cat))

prediction_summary <- predictions |>
  group_by(action, intention, contact, category) |>
  summarise(
    mean_prob = mean(prob),
    lower = quantile(prob, 0.1),
    upper = quantile(prob, 0.9),
    .groups = "drop"
  ) |>
  mutate(
    combo = paste0(action, ",", intention, ",", contact) |>
      as_factor() |>
      fct_relevel(
        "0,0,0",
        "1,0,0",
        "0,1,0",
        "0,0,1",
        "1,1,0",
        "1,0,1",
        "0,1,1",
        "1,1,1"
      )
  )

prediction_summary |>
  filter(action + intention + contact <= 1) |>
  ggplot(
    aes(x = factor(category), y = mean_prob, ymin = lower, ymax = upper),
  ) +
  geom_col(width = 0.4, fill = "lightblue", color = "royalblue") +
  geom_errorbar(width = 0.2, alpha = 0.5) +
  facet_wrap(~combo, nrow = 2) +
  labs(x = "Action, Intention, Contact", y = NULL)

prediction_summary |>
  filter(action + intention + contact > 1) |>
  ggplot(
    aes(x = factor(category), y = mean_prob, ymin = lower, ymax = upper),
  ) +
  geom_col(width = 0.4, fill = "lightblue", color = "royalblue") +
  geom_errorbar(width = 0.2, alpha = 0.5) +
  facet_wrap(~combo, nrow = 2) +
  labs(x = "Action, Intention, Contact", y = NULL)

Model 2: + Gender

\[ \begin{align} \mathit{R}_i &\sim \mathrm{OrderedLogit}(\phi_i, \alpha) \\ \phi_i &= \beta_{A,\color{green}G[i]}A_i + \beta_{I,\color{green}G[i]}I_i + \beta_{C,\color{green}G[i]}C_i \\ \beta_{k,\color{green}g} &\sim \mathrm{Normal}(0, 0.5) \\ \alpha_j &\sim \mathrm{Normal}(0, 1), \quad \alpha_1 < \alpha_2 < \cdots \end{align} \]

new_trolley2.stan

data {
  int<lower=1> n;
  
  int<lower=1> n_response;
  int<lower=1> n_gender;
  
  array[n] int<lower=1, upper=n_response> response;
  array[n] int<lower=0, upper=1> contact;
  array[n] int<lower=0, upper=1> intention;
  array[n] int<lower=0, upper=1> action;
  
  array[n] int<lower=1, upper=n_gender> gender;
}
parameters {
  vector[n_gender] bA;
  vector[n_gender] bI;
  vector[n_gender] bC;
  
  ordered[n_response - 1] alpha;
}
model {
  // linear predictor
  vector[n] phi;
  for (i in 1 : n) 
    phi[i] = bA[gender[i]] * action[i] + bI[gender[i]] * intention[i]
             + bC[gender[i]] * contact[i];
  
  // priors
  bA ~ normal(0, 0.5);
  bI ~ normal(0, 0.5);
  bC ~ normal(0, 0.5);
  
  alpha ~ normal(0, 1);
  
  // likelihood function
  response ~ ordered_logistic(phi, alpha);
}

model2 <- cmdstan_model("new_trolley2.stan")
fit2 <- compose_data(df) |>
  model2$sample(chains = 4, parallel_chains = 4, output_dir = "stan_output")

fit2$summary()

# A tibble: 13 × 10
   variable       mean     median     sd    mad       q5      q95  rhat ess_bulk
   <chr>         <dbl>      <dbl>  <dbl>  <dbl>    <dbl>    <dbl> <dbl>    <dbl>
 1 lp__     -18492.    -18492.    2.48   2.39   -1.85e+4 -1.85e+4  1.00    1552.
 2 bA[1]        -0.881     -0.881 0.0517 0.0518 -9.66e-1 -7.97e-1  1.00    4678.
 3 bA[2]        -0.529     -0.530 0.0481 0.0488 -6.09e-1 -4.52e-1  1.00    4320.
 4 bI[1]        -0.894     -0.894 0.0489 0.0488 -9.76e-1 -8.13e-1  1.00    4663.
 5 bI[2]        -0.554     -0.554 0.0457 0.0457 -6.29e-1 -4.78e-1  1.00    5465.
 6 bC[1]        -1.06      -1.06  0.0681 0.0684 -1.17e+0 -9.51e-1  1.00    4733.
 7 bC[2]        -0.837     -0.836 0.0635 0.0632 -9.39e-1 -7.36e-1  1.00    4529.
 8 alpha[1]     -2.83      -2.83  0.0462 0.0454 -2.91e+0 -2.75e+0  1.00    2866.
 9 alpha[2]     -2.15      -2.15  0.0415 0.0410 -2.22e+0 -2.08e+0  1.00    2989.
10 alpha[3]     -1.56      -1.56  0.0383 0.0380 -1.63e+0 -1.50e+0  1.00    3124.
11 alpha[4]     -0.532     -0.533 0.0358 0.0354 -5.91e-1 -4.75e-1  1.00    3357.
12 alpha[5]      0.143      0.143 0.0358 0.0361  8.46e-2  2.01e-1  1.00    3619.
13 alpha[6]      1.06       1.06  0.0385 0.0388  9.94e-1  1.12e+0  1.00    4290.
# ℹ 1 more variable: ess_tail <dbl>

Model 3: + Age and Edu

\[ \begin{align} \mathit{R}_i &\sim \mathrm{OrderedLogit}(\phi_i, \alpha) \\ \\ \phi_i &= \beta_{A,G[i]}A_i + \beta_{I,G[i]}I_i + \beta_{C,G[i]}C_i \\ &+ \color{green}\beta_{Age}Age_i \\ &+ \color{green}\beta_{Edu}\sum_{j=1}^{Edu_i}{\delta_j} \\ \\ \beta_{k,g} &\sim \mathrm{Normal}(0, 0.5) \\ \color{green}\delta &\sim \color{green}\mathrm{Dirichlet}(2) \\ \alpha_j &\sim \mathrm{Normal}(0, 1), \quad \alpha_1 < \alpha_2 < \cdots \end{align} \]

new_trolley3.stan

data {
  int<lower=1> n;
  
  int<lower=1> n_response;
  int<lower=1> n_gender;
  int<lower=1> n_edu;
  
  int<lower=1> n_story;
  int<lower=1> n_id;
  
  array[n] int<lower=1, upper=n_response> response;
  array[n] int<lower=0, upper=1> contact;
  array[n] int<lower=0, upper=1> intention;
  array[n] int<lower=0, upper=1> action;
  
  array[n] int<lower=1, upper=n_gender> gender;
  array[n] int<lower=1, upper=n_edu> edu;
  vector[n] age_std;
}
parameters {
  vector[n_gender] bA;
  vector[n_gender] bI;
  vector[n_gender] bC;
  
  real bAge;
  real bEdu;
  
  ordered[n_response - 1] alpha;
  simplex[n_edu] delta;
}
transformed parameters {
  vector[n_edu] delta_cum = cumulative_sum(delta);
  
  // linear predictor
  vector[n] phi;
  for (i in 1 : n) 
    phi[i] = bA[gender[i]] * action[i] + bI[gender[i]] * intention[i]
             + bC[gender[i]] * contact[i] + bAge * age_std[i]
             + bEdu * delta_cum[edu[i]];
}
model {
  // priors
  bA ~ normal(0, 0.5);
  bI ~ normal(0, 0.5);
  bC ~ normal(0, 0.5);
  
  bAge ~ normal(0, 0.5);
  bEdu ~ normal(0, 0.5);
  
  delta ~ dirichlet(rep_vector(2, n_edu));
  alpha ~ normal(0, 1);
  
  // likelihood function
  response ~ ordered_logistic(phi, alpha);
}
generated quantities {
  // pointwise log-likelihood
  vector[n] log_lik;
  for (i in 1 : n) 
    log_lik[i] = ordered_logistic_lpmf(response[i] | phi[i], alpha);
}

model3 <- cmdstan_model("new_trolley3.stan")
fit3 <- compose_data(df) |>
  model3$sample(chains = 4, parallel_chains = 4, output_dir = "stan_output")

fit3$summary(
  variables = c(
    "bA",
    "bI",
    "bC",
    "bAge",
    "bEdu",
    "alpha",
    "delta"
  )
) |>
  print(n = 30)

# A tibble: 22 × 10
   variable    mean  median     sd    mad      q5     q95  rhat ess_bulk
   <chr>      <dbl>   <dbl>  <dbl>  <dbl>   <dbl>   <dbl> <dbl>    <dbl>
 1 bA[1]    -0.879  -0.878  0.0513 0.0507 -0.966  -0.795  1.00     3058.
 2 bA[2]    -0.535  -0.534  0.0485 0.0482 -0.616  -0.458  1.00     3009.
 3 bI[1]    -0.893  -0.892  0.0480 0.0478 -0.972  -0.817  1.00     4040.
 4 bI[2]    -0.558  -0.559  0.0439 0.0446 -0.629  -0.483  1.000    3568.
 5 bC[1]    -1.06   -1.06   0.0677 0.0660 -1.17   -0.949  1.00     3838.
 6 bC[2]    -0.841  -0.842  0.0628 0.0628 -0.944  -0.739  1.00     3276.
 7 bAge     -0.0828 -0.0833 0.0208 0.0210 -0.116  -0.0477 1.00     1857.
 8 bEdu      0.184   0.206  0.155  0.127  -0.115   0.400  1.00     1078.
 9 alpha[1] -2.70   -2.69   0.123  0.108  -2.92   -2.52   1.00     1126.
10 alpha[2] -2.02   -2.01   0.122  0.108  -2.24   -1.84   1.00     1107.
11 alpha[3] -1.43   -1.42   0.121  0.105  -1.65   -1.25   1.00     1113.
12 alpha[4] -0.397  -0.385  0.121  0.105  -0.619  -0.217  1.00     1112.
13 alpha[5]  0.279   0.292  0.121  0.105   0.0562  0.458  1.00     1101.
14 alpha[6]  1.19    1.20   0.122  0.105   0.974   1.37   1.00     1077.
15 delta[1]  0.140   0.125  0.0874 0.0850  0.0283  0.308  1.000    3335.
16 delta[2]  0.112   0.0968 0.0745 0.0652  0.0220  0.256  1.00     3663.
17 delta[3]  0.118   0.103  0.0762 0.0716  0.0222  0.265  1.00     4186.
18 delta[4]  0.0923  0.0770 0.0654 0.0554  0.0161  0.220  1.00     3124.
19 delta[5]  0.0762  0.0600 0.0614 0.0472  0.0120  0.199  1.00     1977.
20 delta[6]  0.276   0.285  0.137  0.150   0.0437  0.491  1.00     1192.
21 delta[7]  0.0858  0.0696 0.0630 0.0522  0.0145  0.205  1.00     3195.
22 delta[8]  0.0995  0.0848 0.0673 0.0585  0.0199  0.230  1.00     3543.
# ℹ 1 more variable: ess_tail <dbl>

Model 4: + Partial Pooling

\[ \begin{align} \mathit{R}_i &\sim \mathrm{OrderedLogit}(\phi_i, \alpha) \\ \\ \phi_i &= \beta_{A,G[i]}A_i + \beta_{I,G[i]}I_i + \beta_{C,G[i]}C_i \\ &+ \beta_{Age}Age_i \\ &+ \beta_{Edu}\sum_{j=1}^{Edu_i}{\delta_j} \\ &+ \color{green}u_{id[i]} \\ \\ \beta_{k,g} &\sim \mathrm{Normal}(0, 0.5) \\ \delta &\sim \mathrm{Dirichlet}(2) \\ \alpha_j &\sim \mathrm{Normal}(0, 1), \quad \alpha_1 < \alpha_2 < \cdots \\ \\ \color{green}u_{n} &\sim \color{green}\mathrm{Normal}(\mu_u, \sigma_u) \\ \color{green}\mu_u &\sim \color{green}\mathrm{Normal}(0, 1) \\ \color{green}\sigma_u &\sim \color{green}\mathrm{Exponential}(1) \end{align} \]

new_trolley4.stan

data {
  int<lower=1> n;
  
  int<lower=1> n_response;
  int<lower=1> n_gender;
  int<lower=1> n_edu;
  
  int<lower=1> n_id;
  // int<lower=1> n_story;
  
  array[n] int<lower=1, upper=n_response> response;
  array[n] int<lower=0, upper=1> contact;
  array[n] int<lower=0, upper=1> intention;
  array[n] int<lower=0, upper=1> action;
  
  array[n] int<lower=1, upper=n_gender> gender;
  array[n] int<lower=1, upper=n_edu> edu;
  vector[n] age_std;
  
  array[n] int<lower=1, upper=n_id> id;
  // array[n] int<lower=1, upper=n_story> story;
}
parameters {
  vector[n_gender] bA;
  vector[n_gender] bI;
  vector[n_gender] bC;
  
  real bAge;
  real bEdu;
  
  // categorical hyperparameters
  ordered[n_response - 1] alpha;
  simplex[n_edu] delta;
  
  // partial pooling
  real a_id_bar;
  real<lower=0> a_id_sigma;
  vector[n_id] a_id_raw;
}
transformed parameters {
  vector[n_edu] delta_cum = cumulative_sum(delta);
  vector[n_id] a_id = a_id_bar + a_id_sigma * a_id_raw;
  
  // linear predictor
  vector[n] phi;
  for (i in 1 : n) 
    phi[i] = bA[gender[i]] * action[i] + bI[gender[i]] * intention[i]
             + bC[gender[i]] * contact[i] + bAge * age_std[i]
             + bEdu * delta_cum[edu[i]] + a_id[id[i]];
}
model {
  // priors
  bA ~ normal(0, 0.5);
  bI ~ normal(0, 0.5);
  bC ~ normal(0, 0.5);
  
  bAge ~ normal(0, 0.5);
  bEdu ~ normal(0, 0.5);
  
  // categorical hyperparameter priors
  delta ~ dirichlet(rep_vector(2, n_edu));
  alpha ~ normal(0, 1);
  
  // group-level priors
  a_id_bar ~ normal(0, 1);
  a_id_sigma ~ exponential(1);
  a_id_raw ~ normal(0, 1);
  
  // likelihood function
  response ~ ordered_logistic(phi, alpha);
}
generated quantities {
  // pointwise log-likelihood
  vector[n] log_lik;
  for (i in 1 : n) 
    log_lik[i] = ordered_logistic_lpmf(response[i] | phi[i], alpha);
}

model4 <- cmdstan_model("new_trolley4.stan")
fit4 <- compose_data(df) |>
  model4$sample(chains = 4, parallel_chains = 4, output_dir = "stan_output")

fit4$summary(
  variables = c(
    "bA",
    "bI",
    "bC",
    "bAge",
    "bEdu",
    "alpha",
    "delta",
    "a_id_bar",
    "a_id_sigma",
    "a_id"
  )
) |>
  print(n = 30)

# A tibble: 355 × 10
   variable    mean  median     sd    mad      q5    q95  rhat ess_bulk ess_tail
   <chr>      <dbl>   <dbl>  <dbl>  <dbl>   <dbl>  <dbl> <dbl>    <dbl>    <dbl>
 1 bA[1]    -0.771  -0.772  0.0603 0.0605 -0.869  -0.673 1.00     2339.    3058.
 2 bA[2]    -1.07   -1.07   0.0576 0.0565 -1.17   -0.978 1.00     2638.    2855.
 3 bI[1]    -0.865  -0.865  0.0552 0.0553 -0.956  -0.771 1.00     3060.    2874.
 4 bI[2]    -1.01   -1.01   0.0506 0.0518 -1.09   -0.922 1.00     3580.    2960.
 5 bC[1]    -1.04   -1.04   0.0748 0.0734 -1.17   -0.920 1.00     2292.    2423.
 6 bC[2]    -1.41   -1.41   0.0698 0.0713 -1.53   -1.30  1.00     3053.    3066.
 7 bAge     -0.0537 -0.0529 0.105  0.103  -0.227   0.118 1.03      154.     374.
 8 bEdu      0.114   0.0959 0.402  0.407  -0.528   0.795 1.01      419.     965.
 9 alpha[1] -2.79   -2.80   0.379  0.368  -3.41   -2.15  1.00     2798.    2709.
10 alpha[2] -1.87   -1.88   0.379  0.364  -2.49   -1.23  1.00     2814.    2810.
11 alpha[3] -1.09   -1.10   0.378  0.365  -1.71   -0.451 1.00     2795.    2809.
12 alpha[4]  0.373   0.365  0.378  0.365  -0.244   1.02  1.00     2808.    2728.
13 alpha[5]  1.41    1.41   0.378  0.366   0.792   2.05  1.00     2815.    2769.
14 alpha[6]  2.82    2.81   0.381  0.368   2.19    3.46  1.00     2789.    2655.
15 delta[1]  0.128   0.112  0.0815 0.0773  0.0254  0.284 1.00     5699.    2735.
16 delta[2]  0.126   0.111  0.0817 0.0772  0.0247  0.286 1.00     5931.    2734.
17 delta[3]  0.126   0.109  0.0814 0.0761  0.0254  0.282 1.00     4535.    2766.
18 delta[4]  0.124   0.109  0.0792 0.0750  0.0257  0.276 1.00     4694.    2575.
19 delta[5]  0.123   0.108  0.0771 0.0713  0.0241  0.272 1.00     3877.    2595.
20 delta[6]  0.130   0.112  0.0841 0.0773  0.0264  0.294 1.00     2419.    2401.
21 delta[7]  0.121   0.107  0.0782 0.0730  0.0227  0.271 1.000    3645.    2566.
22 delta[8]  0.122   0.107  0.0764 0.0751  0.0243  0.265 1.000    3764.    2467.
23 a_id_bar  1.08    1.09   0.466  0.465   0.332   1.84  1.00      952.    1690.
24 a_id_si…  1.92    1.92   0.0838 0.0829  1.79    2.07  1.01      387.     847.
25 a_id[1]   0.301   0.313  0.518  0.516  -0.562   1.13  1.00     1218.    2471.
26 a_id[2]  -0.447  -0.433  0.629  0.607  -1.50    0.578 1.00     1366.    2241.
27 a_id[3]  -1.65   -1.64   0.598  0.605  -2.64   -0.682 1.00     1457.    2480.
28 a_id[4]   0.878   0.877  0.669  0.668  -0.252   1.97  1.00     1102.    1382.
29 a_id[5]  -2.47   -2.46   0.649  0.633  -3.57   -1.40  1.00     1193.    2304.
30 a_id[6]   1.56    1.57   0.544  0.528   0.641   2.44  1.00     1561.    2520.
# ℹ 325 more rows

PSIS-LOO estimates

loo3 <- fit3$draws('log_lik') |> loo()
loo3

Computed from 4000 by 9930 log-likelihood matrix.

         Estimate   SE
elpd_loo -18473.0 38.9
p_loo        15.7  0.1
looic     36946.1 77.8
------
MCSE of elpd_loo is 0.1.
MCSE and ESS estimates assume independent draws (r_eff=1).

All Pareto k estimates are good (k < 0.7).
See help('pareto-k-diagnostic') for details.

loo4 <- fit4$draws('log_lik') |> loo()
loo4

Computed from 4000 by 9930 log-likelihood matrix.

         Estimate    SE
elpd_loo -15657.1  88.5
p_loo       357.7   4.6
looic     31314.1 177.1
------
MCSE of elpd_loo is 0.3.
MCSE and ESS estimates assume independent draws (r_eff=1).

All Pareto k estimates are good (k < 0.7).
See help('pareto-k-diagnostic') for details.

loo_compare(loo3, loo4)

       elpd_diff se_diff
model2     0.0       0.0
model1 -2816.0      85.9

Visuals

df |>
  mutate(
    global_median = mean(as.integer(response))
  ) |>
  group_by(id) |>
  summarize(
    r_median = quantile(as.integer(response), probs = 0.50),
    r_0 = quantile(as.integer(response), probs = 0.0),
    r_20 = quantile(as.integer(response), probs = 0.25),
    r_80 = quantile(as.integer(response), probs = 0.75),
    r_100 = quantile(as.integer(response), probs = 1.0),
    global_median = median(global_median)
  ) |>
  slice(1:40) |>
  ggplot(aes(x = id, y = r_median)) +
  geom_point(color = "blue", size = 3) +
  geom_errorbar(
    aes(ymin = r_0, ymax = r_100),
    width = 0.2,
    color = "blue",
    alpha = 0.5
  ) +
  geom_errorbar(
    aes(ymin = r_20, ymax = r_80),
    width = 0,
    color = "blue",
    alpha = 0.5,
    size = 2,
  ) +
  geom_hline(
    aes(yintercept = global_median),
    linetype = "dashed",
    alpha = 0.5,
    color = "red"
  ) +
  scale_y_continuous(breaks = 1:7) +
  theme_minimal() +
  theme(axis.text.x = element_text(angle = 90, vjust = 0.5, hjust = 1))

Warning: Using `size` aesthetic for lines was deprecated in ggplot2 3.4.0.
ℹ Please use `linewidth` instead.