# ============================================================================= # Structural.R — MLE strategy estimation with stratEst # for the Shaded Lights Experiment (2 Lights) # # STRATEGIES CONSIDERED: # # The experiment presents subjects with 4 possible light configurations # (Light_Config), each uniquely identifying the observable state: # State 1: (0,0) — both lights off # State 2: (0,1) — blue on, red off # State 3: (1,0) — red on, blue off # State 4: (1,1) — both lights on # # Strategies are Markovian: the action depends only on the current # Light_Config (state), not on any history. Transitions are trivial — # from any state, observing Light_Config x moves the automaton to the # unique state corresponding to x. # # For each state a deterministic strategy either predicts sound (1) # or no sound (0). With 4 binary states there are 2^4 = 16 deterministic # strategies, enumerated below by action vector (a1,a2,a3,a4) over # states (0,0), (0,1), (1,0), (1,1): # # always_0 : (0,0,0,0) — always predict no sound # AND : (0,0,0,1) — predict sound only when both on [true AND] # INHIBIT : (0,0,1,0) — predict sound only when red on, blue off [true INHIBIT] # red : (0,0,1,1) — predict sound whenever red is on # blue_alone : (0,1,0,0) — predict sound only when blue on, red off # blue : (0,1,0,1) — predict sound whenever blue is on # EITHER : (0,1,1,0) — predict sound when exactly one light on [true XOR / EITHER] # OR : (0,1,1,1) — predict sound when at least one on [true OR] # NOR : (1,0,0,0) — predict sound only when both off [true NOR] # JOINT : (1,0,0,1) — predict sound when lights share the same state (both off or both on) # not_blue : (1,0,1,0) — predict sound whenever blue is off # not_blue_alone : (1,0,1,1) — predict sound unless only blue is on # not_red : (1,1,0,0) — predict sound whenever red is off # not_INHIBIT : (1,1,0,1) — predict sound unless only red is on [NOT INHIBIT] # NAND : (1,1,1,0) — predict sound unless both on [NAND] # always_1 : (1,1,1,1) — always predict sound # # Additionally: # random : 1-state; always randomizes with P(predict sound) = 0.5 (fixed) # always_p : 1-state; always predicts sound with probability p, # where p is estimated from the data via MLE # ============================================================================= # ============================================================ # 0) Packages # ============================================================ library(dplyr) library(tidyr) library(stringr) library(stratEst) # ============================================================ # 1) Generate dataset (source cleaning script, rename variables) # ============================================================ # Source the data-cleaning script to produce df_final script_dir <- dirname(rstudioapi::getActiveDocumentContext()$path) source(file.path(script_dir, "My Eperiment.R")) # Rename and recode variables to stratEst conventions: # id <- subject_id # period <- Guess_Number # choice <- Guess as character ("0" = no sound, "1" = sound) # input <- Light_Config (the observable state; 4 possible values) # treatment <- treatment (unchanged; used to filter per-treatment models) df_strat <- df_final %>% rename( id = subject_id, period = Guess_Number, input = Light_Config ) %>% mutate( choice = as.character(Guess), treatment = as.character(treatment) ) %>% select(id, period, choice, input, treatment) %>% arrange(id, treatment, period) cat("Dataset ready:", nrow(df_strat), "rows |", n_distinct(df_strat$id), "subjects |", n_distinct(df_strat$treatment), "treatments\n") cat("Choice values:", paste(sort(unique(df_strat$choice)), collapse = ", "), "\n") cat("Input values: ", paste(sort(unique(df_strat$input)), collapse = ", "), "\n") # ============================================================ # 2) Strategy building blocks # ============================================================ # Choice labels — must match values in the data's 'choice' column choice_labels <- c("0", "1") # Input levels passed to stratEst.strategy (NA included for absent inputs) input_vals <- c("(0,0)", "(0,1)", "(1,0)", "(1,1)") inputs_strat <- c(NA, input_vals) # Shared transition matrix for all 4-state strategies. # States correspond 1-to-1 with Light_Config values: # state 1 = (0,0), state 2 = (0,1), state 3 = (1,0), state 4 = (1,1) # Transition rule: from any state, given input x, move to state(x). # tr.inputs layout: for each state (row), list next-state index per non-NA input (col). # Length = num.states (4) × num.non.NA.inputs (4) = 16. tr_4state <- rep(c(1L, 2L, 3L, 4L), times = 4L) # Helper: build a 4-state deterministic strategy from action vector (a1..a4). # a_i in {0, 1}: 0 = predict no sound in state i; 1 = predict sound in state i. # prob.choices layout: c(P("0"|s1), P("1"|s1), P("0"|s2), P("1"|s2), ...) length 8. make_det_strategy <- function(a1, a2, a3, a4) { pc <- as.double(c(1-a1, a1, 1-a2, a2, 1-a3, a3, 1-a4, a4)) stratEst.strategy( choices = choice_labels, inputs = inputs_strat, num.states = 4L, tr.inputs = tr_4state, prob.choices = pc ) } # ============================================================ # 3) Build all 16 deterministic strategies # ============================================================ det_strategies <- list( always_0 = make_det_strategy(0, 0, 0, 0), # never predict sound AND = make_det_strategy(0, 0, 0, 1), # sound iff both lights on INHIBIT = make_det_strategy(0, 0, 1, 0), # sound iff red on, blue off red = make_det_strategy(0, 0, 1, 1), # sound whenever red on blue_alone = make_det_strategy(0, 1, 0, 0), # sound iff blue on, red off blue = make_det_strategy(0, 1, 0, 1), # sound whenever blue on EITHER = make_det_strategy(0, 1, 1, 0), # sound iff exactly one on (XOR) OR = make_det_strategy(0, 1, 1, 1), # sound iff at least one on NOR = make_det_strategy(1, 0, 0, 0), # sound iff both off JOINT = make_det_strategy(1, 0, 0, 1), # sound iff same state (both off or both on) not_blue = make_det_strategy(1, 0, 1, 0), # sound whenever blue off not_blue_alone = make_det_strategy(1, 0, 1, 1), # sound unless only blue on not_red = make_det_strategy(1, 1, 0, 0), # sound whenever red off not_INHIBIT = make_det_strategy(1, 1, 0, 1), # sound unless only red on NAND = make_det_strategy(1, 1, 1, 0), # sound unless both on always_1 = make_det_strategy(1, 1, 1, 1) # always predict sound ) cat("Built", length(det_strategies), "deterministic strategies\n") # ============================================================ # 4) Build additional strategies: random and always_p # ============================================================ # random: 1-state automaton; P(predict sound) = 0.5, fixed random <- stratEst.strategy( choices = choice_labels, inputs = inputs_strat, num.states = 1L, tr.inputs = c(1L, 1L, 1L, 1L), # always stay in state 1 prob.choices = c(0.5, 0.5) # P("0") = P("1") = 0.5 ) # always_p: 1-state automaton; P(predict sound) = p, estimated from data # Setting both prob.choices to NA instructs stratEst to estimate p via MLE # (subject to P("0") + P("1") = 1, so only one free parameter). always_p <- stratEst.strategy( choices = choice_labels, inputs = inputs_strat, num.states = 1L, tr.inputs = c(1L, 1L, 1L, 1L), prob.choices = c(NA_real_, NA_real_) # p and (1-p) estimated ) cat("Built 2 additional strategies: random (p = 0.5 fixed) and always_p (p estimated)\n") # ============================================================ # 5) Assemble full strategy list # ============================================================ strategies_all <- c( det_strategies, list( random = random, always_p = always_p ) ) cat("Total strategies:", length(strategies_all), "\n") cat("Strategy names: ", paste(names(strategies_all), collapse = ", "), "\n") stopifnot(!any(sapply(strategies_all, is.null))) # ============================================================ # 6) Estimation: loop over all treatments # ============================================================ all_treatments <- sort(unique(df_strat$treatment)) results_list <- vector("list", length(all_treatments)) for (idx in seq_along(all_treatments)) { TREAT <- all_treatments[idx] cat("\n========== Treatment:", TREAT, "(", idx, "/", length(all_treatments), ") ==========\n") # Filter to this treatment; keep treatment as factor for stratEst df_t <- df_strat %>% filter(treatment == TREAT) %>% mutate(treatment = as.factor(treatment)) cat(" Rows:", nrow(df_t), "| Subjects:", n_distinct(df_t$id), "\n") model_t <- tryCatch( stratEst.model( data = df_t, strategies = strategies_all, inner.runs = 100, outer.runs = 2, inner.max = 100 ), error = function(e) { cat(" ERROR:", conditionMessage(e), "\n") NULL } ) if (!is.null(model_t)) { shares_vec <- as.numeric(model_t$shares) names(shares_vec) <- names(strategies_all) results_list[[idx]] <- data.frame( treatment = TREAT, loglike = model_t$loglike, num_par = model_t$num.par, t(shares_vec), check.names = FALSE, stringsAsFactors = FALSE ) cat(" Log-likelihood:", round(model_t$loglike, 3), "\n") cat(" Summary:\n") print(summary(model_t)) } else { results_list[[idx]] <- data.frame( treatment = TREAT, loglike = NA_real_, num_par = NA_integer_ ) } } # Combine all treatments into one results table ESTIMATION_RESULTS <- bind_rows(results_list) %>% arrange(treatment) cat("\n=== ESTIMATION_RESULTS (all treatments) ===\n") print(ESTIMATION_RESULTS) # Save to CSV next to this script output_path <- file.path(script_dir, "Structural_Results.csv") write.csv(ESTIMATION_RESULTS, output_path, row.names = FALSE) cat("Saved to", output_path, "\n")