--- title: "Attribute Weights and Attention with Varying Sampling Noise" output: rmarkdown::html_vignette vignette: > %\VignetteIndexEntry{Attribute Weights and Attention with Varying Sampling Noise} %\VignetteEngine{knitr::rmarkdown} %\VignetteEncoding{UTF-8} --- ```{r, include = FALSE} knitr::opts_chunk$set( collapse = TRUE, comment = "#>" ) ``` ```{r setup} library(ggplot2) library(dplyr) library(tibble) library(purrr) library(patchwork) library(masc) ``` (A) Development of fixations to the higher weighted attribute over time with a fixed weight difference of 0.5. MASC predicts that higher sampling noise leads to prolonged sampling of the higher weighted attribute early on before attention switches to the other attribute. (B) shows the predicted difference in attention as a function of weight difference for varying levels of sampling noise. ```{r} # Function to simulate the MASC model behavior with various weight differences and noise levels simulate_weight_attention_relationship <- function( n_trials = 100, # Number of trials per condition weight_diffs = seq(0, 1, by = 0.05), # Weight differences to test noise_levels = seq(0.5, 3, by = 0.5),# Noise levels to test max_fixations = 100, # Maximum number of fixations alpha = 10, # High search sensitivity (as in MATLAB) delta = 0.05 # Threshold increase (as in MATLAB) ) { # Pre-allocate results data frames weight_att_results <- data.frame() fixation_development <- data.frame() # Loop through noise levels for (noise in noise_levels) { # Loop through weight differences for (w_diff in weight_diffs) { # Calculate weights - ensuring they're both positive and sum to 1 # When w_diff = 0, weights are equal (0.5, 0.5) # When w_diff = 1, weights are (1, 0) - not allowed, so we'll use (0.99, 0.01) w1 <- 0.5 + w_diff/2 w2 <- 1 - w1 # Ensure weights are positive and not exactly 0 (use small positive value) if (w2 <= 0) { w1 <- 0.99 w2 <- 0.01 } weights <- c(w1, w2) # Verify weights sum to 1 stopifnot(abs(sum(weights) - 1) < 1e-10) # Run simulation sim <- rMASC( n = n_trials, n_options = 2, n_attributes = 2, w = weights, sigma = noise, alpha = alpha, delta = delta, max_steps = max_fixations ) # Calculate attention metrics for each trial trial_att_diffs <- map_dbl(sim$raw, function(trial) { fix_seq <- trial$fix_sequence # Count fixations to each attribute att_indices <- ceiling(fix_seq / 2) att1_fixes <- sum(att_indices == 1) att2_fixes <- sum(att_indices == 2) total_fixes <- length(fix_seq) # Calculate attention difference att_diff <- (att1_fixes/total_fixes) - (att2_fixes/total_fixes) return(att_diff) }) # Add to weight-attention results weight_att_results <- bind_rows( weight_att_results, tibble( noise_level = noise, weight_diff = w_diff, attention_diff = mean(trial_att_diffs) ) ) # If weight difference is 0.5, extract fixation development data if (abs(w_diff - 0.5) < 0.001) { # Extract fixation development for each trial trial_fix_data <- map_dfr(sim$raw, function(trial) { fix_seq <- trial$fix_sequence max_fix <- min(length(fix_seq), max_fixations) # For each fixation position, calculate proportion to attribute 1 fix_props <- map_dfr(1:max_fix, function(fix_num) { # Only use data up to current fixation curr_fixes <- fix_seq[1:fix_num] # Calculate proportion to attribute 1 att_indices <- ceiling(curr_fixes / 2) att1_prop <- sum(att_indices == 1) / length(att_indices) tibble( trial = trial$trial, fixation_num = fix_num, att1_prop = att1_prop ) }) fix_props }) # Average across trials for each fixation position fix_dev_data <- trial_fix_data %>% group_by(fixation_num) %>% summarize(att1_prop = mean(att1_prop)) %>% mutate(noise_level = noise) # Add to fixation development results fixation_development <- bind_rows( fixation_development, fix_dev_data ) } } } # Return both datasets list( weight_att = weight_att_results, fix_dev = fixation_development ) } # Create color palette (green gradient as in MATLAB) create_color_palette <- function(noise_levels) { start_color <- c(194, 218, 184) / 255 end_color <- c(1, 50, 32) / 255 # Generate color gradient colors <- tibble( noise_level = noise_levels, r = seq(start_color[1], end_color[1], length.out = length(noise_levels)), g = seq(start_color[2], end_color[2], length.out = length(noise_levels)), b = seq(start_color[3], end_color[3], length.out = length(noise_levels)) ) # Convert to hex colors colors <- colors %>% mutate(hex = rgb(r, g, b)) # Return as named vector setNames(colors$hex, colors$noise_level) } # Plot the results plot_weight_attention_results <- function(results, colors) { # Panel A: Fixation development over time (when weight diff = 0.5) p1 <- results$fix_dev %>% filter(fixation_num <= 20) %>% # Limit to first 12 fixations ggplot(aes(x = fixation_num, y = att1_prop, color = factor(noise_level))) + geom_line() + geom_point() + scale_color_manual(values = colors, name = "Sampling Noise") + labs( x = "Fixation Number", y = "p(Fix)_Most Important" ) + theme_classic() + theme( legend.position = "none", panel.grid.minor = element_blank() ) + ylim(0, 1) # Panel B: Weight difference vs attention difference p2 <- results$weight_att %>% ggplot(aes(x = weight_diff, y = attention_diff, color = factor(noise_level))) + geom_line() + geom_point() + geom_abline(intercept = 0, slope = 1, color = "gray70") + geom_vline(xintercept = 0.50, color = "gray70") + scale_color_manual(values = colors, name = "Sampling Noise") + labs( x = "Weight_Att1 - Weight_Att2", y = "p(Fix)_Att1 - p(Fix)_Att2" ) + theme_classic() + theme( legend.position = "bottom", panel.grid.minor = element_blank() ) + ylim(-0.01, 1.01) + xlim(-0.01, 1.01) # Combine plots combined_plot <- p1 + p2 + plot_layout(widths = c(1, 1)) + plot_annotation( title = "Attribute Weights and Attention with Varying Sampling Noise", subtitle = "MASC Model Simulation", theme = theme( plot.title = element_text(size = 16, face = "bold"), plot.subtitle = element_text(size = 12) ) ) & theme(legend.position = "bottom") combined_plot } ``` ```{r} # Run the simulation set.seed(2025) noise_levels <- seq(0.5, 3, by = 0.5) weight_diffs <- seq(0, 1, by = 0.125) # Create color palette color_palette <- create_color_palette(noise_levels) # Run simulation (this may take some time) results <- simulate_weight_attention_relationship( n_trials = 200, weight_diffs = weight_diffs, noise_levels = noise_levels, alpha = 10, # High search sensitivity as in MATLAB delta = 0.05 # Same as MATLAB ) ``` ```{r, fig.width=12, fig.height=8, out.width="100%"} # Plot results fig9_plot <- plot_weight_attention_results(results, color_palette) # Display plot print(fig9_plot) ```