Segmentation Pilot Analysis

————————————-Import Data————————————-

——————————-Exclude Participant——————————-

all_raw_data <- all_raw_data %>%
  filter(run_id != "38")

print(
  all_raw_data %>%
    count(video_attention_failure_type)
)

## # A tibble: 3 × 2
##   video_attention_failure_type     n
##   <chr>                        <int>
## 1 no_boundary_press                8
## 2 rapid_successive_press          12
## 3 <NA>                          1995

————————————-Clean Data————————————-

confidence_data <- clean_data %>%
  filter(!is.na(confidence_rating)) %>%
  select(run_id, stimulus_name, predictability, confidence_rating)

confidence_data %>%
  count(confidence_rating, sort = TRUE) %>%
  mutate(percent = round(100 * n / sum(n), 2))

## # A tibble: 5 × 3
##   confidence_rating        n percent
##   <chr>                <int>   <dbl>
## 1 Moderately confident   376   45.8 
## 2 Very confident         182   22.2 
## 3 Slightly unconfident   115   14.0 
## 4 Neutral                112   13.7 
## 5 Very unconfident        35    4.27

# Count Very unconfident
confidence_data %>%
  filter(confidence_rating == "Very unconfident") %>%
  nrow()

## [1] 35

library(dplyr)

clean_data2 <- clean_data %>%
  mutate(row_id = row_number())

# Rows containing "Very unconfident"
very_unconf_rows <- clean_data2 %>%
  filter(confidence_rating == "Very unconfident") %>%
  pull(row_id)

# Remove those rows AND the row immediately before them
clean_data2 <- clean_data2 %>%
  filter(!(row_id %in% c(very_unconf_rows,
                          very_unconf_rows - 1)))

segmentation_data <- clean_data2 %>%
  filter(trial_kind == "segmentation_video") %>%
  select(
    -any_of(c(
      "trial_type", "time_elapsed", "PROLIFIC_PID", "trial_index", "trial_kind", "pair_number"))
  )
dim(segmentation_data)

## [1] 786  13

———————————Descriptive Data———————————

Participant level

participant_mean <- segmentation_data %>%
  mutate(boundary_count_num = readr::parse_number(boundary_count)) %>%
  group_by(run_id) %>%
  summarise(mean_NoB = mean(boundary_count_num, na.rm = TRUE),.groups = "drop")

grand_mean <- mean(participant_mean$mean_NoB)
ground_truth_mean <- 13.64

ggplot(participant_mean, aes(x = mean_NoB)) +
  geom_histogram(binwidth = 1, color = "black", fill = "skyblue") +
  geom_vline(xintercept = grand_mean, linetype = "dashed", linewidth = 1.2, color = "red") +
  annotate("text", x = grand_mean, y = Inf, label = paste0("Participants' Mean = ", round(grand_mean, 2)), color = "red", vjust = 1.5, hjust = 0.6, size = 4) +
  labs(title = "Distribution of Participants' Average Number of Boundaries", x = "Average Number of Boundaries per Video", y = "Number of Participants") +
  theme_minimal(base_size = 14) +
  theme(plot.title = element_text(face = "bold")
  )

participant_condition_mean <- segmentation_data %>%
  mutate(boundary_count_num = readr::parse_number(boundary_count)) %>%
  group_by(run_id, predictability) %>%
  summarise(mean_NoB = mean(boundary_count_num, na.rm = TRUE), n_trials = n(),.groups = "drop")

ggplot(
  participant_condition_mean, aes(x = predictability, y = mean_NoB, group = run_id)) +
  geom_line(alpha = 0.35, color = "grey60") +
  geom_point(aes(color = predictability), size = 2.5) +
  geom_text(aes(label = run_id), size = 2.5, hjust = -0.15, alpha = 0.75) +
  stat_summary(aes(group = 1), fun = mean, geom = "line", linewidth = 1.4, color = "black") +
  labs(title = "Participant-Level Mean NoB Across Predictability Conditions", x = NULL, y = "Mean NoB") +
  theme_minimal(base_size = 14) +
  theme(legend.position = "none", plot.title = element_text(face = "bold"))

Paired-Sample T-Test on Average NoB –> Participant Level

participant_condition_wide <- participant_condition_mean %>%
  select(run_id, predictability, mean_NoB) %>%
  pivot_wider(
    names_from = predictability,
    values_from = mean_NoB
  )

participant_ttest <- t.test(
  participant_condition_wide$Predictable,
  participant_condition_wide$Unpredictable,
  paired = TRUE
)

participant_ttest

## 
##  Paired t-test
## 
## data:  participant_condition_wide$Predictable and participant_condition_wide$Unpredictable
## t = -0.349, df = 13, p-value = 0.7327
## alternative hypothesis: true mean difference is not equal to 0
## 95 percent confidence interval:
##  -0.2020243  0.1458301
## sample estimates:
## mean difference 
##     -0.02809712

Average NoB

ggplot(button_count_long,
  aes(x = predictability, y = mean_button_count, group = stimulus_name)
  ) +
  geom_line(alpha = 0.4, color = "grey60") +
  geom_point(aes(color = predictability), size = 2.5) +
  stat_summary(aes(group = 1), fun = mean, geom = "line", linewidth = 1.2, color = "black"
  ) +
  stat_summary(aes(group = 1), fun = mean, geom = "point", size = 3.5, color = "black"
  ) +
  labs(x = NULL, y = "Mean NoB", title = "Mean NoB Across Predictability Conditions"
  ) +
  theme_minimal(base_size = 14) +
  theme(legend.position = "none", plot.title = element_text(face = "bold"), plot.subtitle = element_text(color = "grey40")
  )

Variance

top5_P <- consensus_long %>%
  filter(predictability == "Predictable") %>%
  arrange(desc(var_boundary_count)) %>%
  slice_head(n = 5)

top5_U <- consensus_long %>%
  filter(predictability == "Unpredictable") %>%
  arrange(desc(var_boundary_count)) %>%
  slice_head(n = 5)

top5_labels <- bind_rows(top5_P, top5_U) %>%
  select(stimulus_name, predictability)

consensus_long_labeled <- consensus_long %>%
  left_join(top5_labels %>% mutate(label = stimulus_name), by = c("stimulus_name", "predictability"))

ggplot(consensus_long_labeled,
  aes(x = predictability, y = var_boundary_count, group = stimulus_name)
  ) +
  geom_line(alpha = 0.4, color = "grey60") +
  geom_text(aes(label = label), hjust = -0.1, size = 3, na.rm = TRUE) +
  geom_point(aes(color = predictability), size = 2.5) +
  stat_summary(aes(group = 1), fun = mean, geom = "line", linewidth = 1.2, color = "black"
  ) +
  stat_summary(aes(group = 1), fun = mean, geom = "point", size = 3.5, color = "black"
  ) +
  labs(x = NULL, y = "Variance of NoB", title = "Within-Video Variability Across Predictability Conditions"
  ) +
  theme_minimal(base_size = 14) +
  theme(legend.position = "none", plot.title = element_text(face = "bold"), plot.subtitle = element_text(color = "grey40")
  )

Paired-Sample T-Test on Variance

Do participants disagree more about how many boundaries there are in unpredictable videos compared with predictable videos?

t.test(consensus_wide$Unpredictable, consensus_wide$Predictable, paired = TRUE)

## 
##  Paired t-test
## 
## data:  consensus_wide$Unpredictable and consensus_wide$Predictable
## t = -1.3664, df = 29, p-value = 0.1823
## alternative hypothesis: true mean difference is not equal to 0
## 95 percent confidence interval:
##  -0.26229767  0.05218945
## sample estimates:
## mean difference 
##      -0.1050541

—————————–Mixed Effect Regression—————————–

MEM for the effect of Predictability on NoB

After accounting for individual differences in segmentation tendencies and differences among videos, does predictability affect the average number of boundaries?

segmentation_data <- segmentation_data %>%
  mutate(boundary_count = as.numeric(boundary_count))

MEM_mean_Gaussian <- lmer(boundary_count ~ predictability + (1 | run_id) + (1 | stimulus_name), data = segmentation_data)

summary(MEM_mean_Gaussian)

## Linear mixed model fit by REML. t-tests use Satterthwaite's method [
## lmerModLmerTest]
## Formula: boundary_count ~ predictability + (1 | run_id) + (1 | stimulus_name)
##    Data: segmentation_data
## 
## REML criterion at convergence: 2646.2
## 
## Scaled residuals: 
##     Min      1Q  Median      3Q     Max 
## -4.1383 -0.5572 -0.0404  0.4991  4.2860 
## 
## Random effects:
##  Groups        Name        Variance Std.Dev.
##  stimulus_name (Intercept) 0.912    0.955   
##  run_id        (Intercept) 2.833    1.683   
##  Residual                  1.400    1.183   
## Number of obs: 786, groups:  stimulus_name, 30; run_id, 14
## 
## Fixed effects:
##                              Estimate Std. Error        df t value Pr(>|t|)    
## (Intercept)                   4.57049    0.48615  17.21998   9.401 3.39e-08 ***
## predictabilityUnpredictable   0.01420    0.08458 742.00807   0.168    0.867    
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## 
## Correlation of Fixed Effects:
##             (Intr)
## prdctbltyUn -0.088

anova(MEM_mean_Gaussian)

## Type III Analysis of Variance Table with Satterthwaite's method
##                 Sum Sq Mean Sq NumDF  DenDF F value Pr(>F)
## predictability 0.03949 0.03949     1 742.01  0.0282 0.8667

MEM with Stimulus Duration as Fixed Effect

video_duration <- tibble(
  stimulus_name = c(
    "baking","balcony","bank","bathroom","beach","bedding",
    "bike","car","cleaning","cereal","fireplace","football",
    "gym","lamp","laundry","mouse","music","painting",
    "party","poster","printer","record","shopping",
    "skateboard","suitcase","sunbathing","tea","tennis",
    "walking","whiteboard"),
  video_duration_sec = c(
    28.75, 28.00, 19.11, 35.11, 26.75, 34.68,
    29.31, 39.44, 30.00, 37.71, 30.99, 36.00,
    29.31, 29.52, 30.84, 29.76, 38.12, 24.55,
    35.17, 23.53, 44.05, 19.11, 11.79,
    24.12, 27.15, 40.12, 31.00, 29.76,
    21.52, 36.54
  )
)

segmentation_data <- segmentation_data %>%
  left_join(video_duration, by = "stimulus_name") %>%
  mutate(
    video_duration_sec = as.numeric(video_duration_sec),
    duration_z = as.numeric(scale(video_duration_sec)),
    boundary_count = as.numeric(boundary_count)
  )

MEM_duration <- lmer(boundary_count ~ predictability + duration_z + (1 | run_id) + (1 | stimulus_name), data = segmentation_data)

summary(MEM_duration)

## Linear mixed model fit by REML. t-tests use Satterthwaite's method [
## lmerModLmerTest]
## Formula: boundary_count ~ predictability + duration_z + (1 | run_id) +  
##     (1 | stimulus_name)
##    Data: segmentation_data
## 
## REML criterion at convergence: 2622.9
## 
## Scaled residuals: 
##     Min      1Q  Median      3Q     Max 
## -4.0399 -0.5481 -0.0312  0.5025  4.3707 
## 
## Random effects:
##  Groups        Name        Variance Std.Dev.
##  stimulus_name (Intercept) 0.3573   0.5977  
##  run_id        (Intercept) 2.8361   1.6841  
##  Residual                  1.4001   1.1833  
## Number of obs: 786, groups:  stimulus_name, 30; run_id, 14
## 
## Fixed effects:
##                              Estimate Std. Error        df t value Pr(>|t|)    
## (Intercept)                   4.57976    0.46702  14.76456   9.806 7.44e-08 ***
## predictabilityUnpredictable   0.01529    0.08457 742.19575   0.181    0.857    
## duration_z                    0.73193    0.11562  28.18339   6.331 7.34e-07 ***
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## 
## Correlation of Fixed Effects:
##             (Intr) prdctU
## prdctbltyUn -0.091       
## duration_z   0.003  0.001

MEM with Negative Biomodal Distribution

mean(segmentation_data$boundary_count, na.rm = TRUE)

## [1] 4.561069

var(segmentation_data$boundary_count, na.rm = TRUE)

## [1] 4.771425

MEM_mean_NB <- glmer.nb(boundary_count ~ predictability + (1 | run_id) + (1 | stimulus_name), data = segmentation_data)

## Warning in theta.ml(Y, mu, weights = object@resp$weights, limit = limit, :
## iteration limit reached

summary(MEM_mean_NB)

## Generalized linear mixed model fit by maximum likelihood (Laplace
##   Approximation) [glmerMod]
##  Family: Negative Binomial(742143.9)  ( log )
## Formula: boundary_count ~ predictability + (1 | run_id) + (1 | stimulus_name)
##    Data: segmentation_data
## 
##       AIC       BIC    logLik -2*log(L)  df.resid 
##    2936.0    2959.3   -1463.0    2926.0       781 
## 
## Scaled residuals: 
##      Min       1Q   Median       3Q      Max 
## -1.81994 -0.32732 -0.04052  0.27845  2.15534 
## 
## Random effects:
##  Groups        Name        Variance Std.Dev.
##  stimulus_name (Intercept) 0.04019  0.2005  
##  run_id        (Intercept) 0.12934  0.3596  
## Number of obs: 786, groups:  stimulus_name, 30; run_id, 14
## 
## Fixed effects:
##                             Estimate Std. Error z value Pr(>|z|)    
## (Intercept)                 1.440323   0.100499  14.332   <2e-16 ***
## predictabilityUnpredictable 0.001497   0.033262   0.045    0.964    
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## 
## Correlation of Fixed Effects:
##             (Intr)
## prdctbltyUn -0.152

MEM with Poisson Distribution

model_pois <- glmer(boundary_count ~ predictability + (1 | run_id) + (1 | stimulus_name), family = poisson,
data = segmentation_data)

summary(model_pois)

## Generalized linear mixed model fit by maximum likelihood (Laplace
##   Approximation) [glmerMod]
##  Family: poisson  ( log )
## Formula: boundary_count ~ predictability + (1 | run_id) + (1 | stimulus_name)
##    Data: segmentation_data
## 
##       AIC       BIC    logLik -2*log(L)  df.resid 
##    2934.0    2952.6   -1463.0    2926.0       782 
## 
## Scaled residuals: 
##      Min       1Q   Median       3Q      Max 
## -1.81994 -0.32732 -0.04052  0.27845  2.15534 
## 
## Random effects:
##  Groups        Name        Variance Std.Dev.
##  stimulus_name (Intercept) 0.04019  0.2005  
##  run_id        (Intercept) 0.12934  0.3596  
## Number of obs: 786, groups:  stimulus_name, 30; run_id, 14
## 
## Fixed effects:
##                             Estimate Std. Error z value Pr(>|z|)    
## (Intercept)                 1.440326   0.105782  13.616   <2e-16 ***
## predictabilityUnpredictable 0.001494   0.033367   0.045    0.964    
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## 
## Correlation of Fixed Effects:
##             (Intr)
## prdctbltyUn -0.159

overdispersion_ratio <-
    sum(residuals(model_pois, type = "pearson")^2) / df.residual(model_pois)

overdispersion_ratio

## [1] 0.2614318

—————————–Block Effect—————————–

#MEM with Block as a fixed effect

library(ggrepel)
model_block <- lmer(boundary_count ~ block + (1 | run_id) + (1 | stimulus_name), data = segmentation_data)

summary(model_block)

## Linear mixed model fit by REML. t-tests use Satterthwaite's method [
## lmerModLmerTest]
## Formula: boundary_count ~ block + (1 | run_id) + (1 | stimulus_name)
##    Data: segmentation_data
## 
## REML criterion at convergence: 2643.7
## 
## Scaled residuals: 
##     Min      1Q  Median      3Q     Max 
## -4.0825 -0.5573 -0.0411  0.5248  4.2274 
## 
## Random effects:
##  Groups        Name        Variance Std.Dev.
##  stimulus_name (Intercept) 0.9123   0.9551  
##  run_id        (Intercept) 2.8335   1.6833  
##  Residual                  1.3955   1.1813  
## Number of obs: 786, groups:  stimulus_name, 30; run_id, 14
## 
## Fixed effects:
##              Estimate Std. Error        df t value Pr(>|t|)    
## (Intercept)   4.51169    0.48614  17.21028   9.281 4.11e-08 ***
## block2        0.13377    0.08447 742.00634   1.584    0.114    
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## 
## Correlation of Fixed Effects:
##        (Intr)
## block2 -0.086

block_summary <- segmentation_data %>%
  group_by(run_id, block) %>%
  summarise(
    mean_boundary_count = mean(boundary_count),
    .groups = "drop"
  )

ggplot(
  block_summary,
  aes(
    x = factor(block),
    y = mean_boundary_count,
    group = run_id
  )
) +
  geom_line(alpha = 0.4, color = "grey60") +
  geom_point(aes(color = factor(block)), size = 2.5) +
  geom_text_repel(
  aes(label = run_id),
  size = 3,
  show.legend = FALSE,
  max.overlaps = Inf
)+

  stat_summary(
    aes(group = 1),
    fun = mean,
    geom = "line",
    linewidth = 1.2,
    color = "black"
  ) +

  stat_summary(
    aes(group = 1),
    fun = mean,
    geom = "point",
    size = 3.5,
    color = "black"
  ) +

  scale_color_manual(
    values = c(
      "1" = "#1f77b4",
      "2" = "#d62728"
    ),
    labels = c("Block 1", "Block 2")
  ) +

  labs(
    x = NULL,
    y = "Mean number of boundaries",
    color = NULL,
    title = "Segmentation Across Experimental Blocks"
  ) +

  theme_minimal(base_size = 14)

——————-Analyzsis on Pre/Critical/Post——————-

library(jsonlite)

## 
## Attaching package: 'jsonlite'

## The following object is masked from 'package:purrr':
## 
##     flatten

critical_windows <- tribble(
  ~stimulus_name, ~critical_start, ~critical_end,
  "baking",11.0,17.2,
  "balcony",19.5,22.75,
  "bank",10.0,12.4,
  "bathroom",17.4,24.0,
  "beach",17.80,20.0,
  "bedding",11.60,18.0,
  "bike",12.00,17.20,
  "car",17.80,20.60,
  "cleaning",8.20,11.40,
  "cereal",16.50,22.00,
  "fireplace",16.80,17.50,
  "football",11.85,22.60,
  "gym",9.00,12.60,
  "lamp",17.40,19.20,
  "laundry",7.20,9.00,
  "mouse",15.60,24.20,
  "music",14.20,17.40,
  "painting",9.00,18.40,
  "party",15.00,22.60,
  "poster",14.40,17.20,
  "printer",16.60,32.20,
  "record",8.40,13.00,
  "shopping",6.60,7.60,
  "skateboard",11.00,15.80,
  "suitcase",10.65,14.80,
  "sunbathing",15.00,22.00,
  "tea",14.60,19.20,
  "tennis",14.60,16.40,
  "walking",7.00,8.20,
  "whiteboard",14.40,17.35
)

window_counts <- clean_data %>%
  filter(trial_kind == "segmentation_video") %>%
  select(run_id, stimulus_name, predictability, boundary_times_sec) %>%
  left_join(critical_windows, by = "stimulus_name") %>%
  left_join(video_duration, by = "stimulus_name") %>%
  rowwise() %>%
  mutate(
    boundary_times = list(jsonlite::fromJSON(boundary_times_sec)),
    pre_count = sum(boundary_times >= 0 & boundary_times < critical_start),
    critical_count = sum(boundary_times >= critical_start & boundary_times <= critical_end),
    post_count = sum(boundary_times > critical_end & boundary_times <= video_duration_sec)
  ) %>%
  ungroup() %>%
  mutate(
    predictability = factor(predictability),
    run_id = factor(run_id),
    stimulus_name = factor(stimulus_name)
  )

model_pre <- lmer(pre_count ~ predictability + (1 | run_id) + (1 | stimulus_name), data = window_counts)

model_critical <- lmer(critical_count ~ predictability + (1 | run_id) + (1 | stimulus_name), data = window_counts)

model_post <- lmer(post_count ~ predictability + (1 | run_id) + (1 | stimulus_name), data = window_counts)

summary(model_pre)

## Linear mixed model fit by REML. t-tests use Satterthwaite's method [
## lmerModLmerTest]
## Formula: pre_count ~ predictability + (1 | run_id) + (1 | stimulus_name)
##    Data: window_counts
## 
## REML criterion at convergence: 2098
## 
## Scaled residuals: 
##     Min      1Q  Median      3Q     Max 
## -2.8271 -0.5986 -0.0260  0.5526  4.7852 
## 
## Random effects:
##  Groups        Name        Variance Std.Dev.
##  stimulus_name (Intercept) 0.4732   0.6879  
##  run_id        (Intercept) 0.6177   0.7859  
##  Residual                  0.6305   0.7941  
## Number of obs: 820, groups:  stimulus_name, 30; run_id, 14
## 
## Fixed effects:
##                              Estimate Std. Error        df t value Pr(>|t|)    
## (Intercept)                 1.891e+00  2.478e-01 2.295e+01   7.628 9.76e-08 ***
## predictabilityUnpredictable 7.763e-03  5.549e-02 7.761e+02   0.140    0.889    
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## 
## Correlation of Fixed Effects:
##             (Intr)
## prdctbltyUn -0.112

summary(model_critical)

## Linear mixed model fit by REML. t-tests use Satterthwaite's method [
## lmerModLmerTest]
## Formula: critical_count ~ predictability + (1 | run_id) + (1 | stimulus_name)
##    Data: window_counts
## 
## REML criterion at convergence: 1482.3
## 
## Scaled residuals: 
##     Min      1Q  Median      3Q     Max 
## -3.0713 -0.6845 -0.0376  0.6520  6.3505 
## 
## Random effects:
##  Groups        Name        Variance Std.Dev.
##  stimulus_name (Intercept) 0.13793  0.3714  
##  run_id        (Intercept) 0.07269  0.2696  
##  Residual                  0.30891  0.5558  
## Number of obs: 820, groups:  stimulus_name, 30; run_id, 14
## 
## Fixed effects:
##                              Estimate Std. Error        df t value Pr(>|t|)    
## (Intercept)                   0.66233    0.10268  34.29174   6.451 2.17e-07 ***
## predictabilityUnpredictable   0.04392    0.03884 776.06592   1.131    0.258    
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## 
## Correlation of Fixed Effects:
##             (Intr)
## prdctbltyUn -0.189

summary(model_post)

## Linear mixed model fit by REML. t-tests use Satterthwaite's method [
## lmerModLmerTest]
## Formula: post_count ~ predictability + (1 | run_id) + (1 | stimulus_name)
##    Data: window_counts
## 
## REML criterion at convergence: 2126.9
## 
## Scaled residuals: 
##     Min      1Q  Median      3Q     Max 
## -3.9520 -0.5874 -0.0382  0.6044  5.5076 
## 
## Random effects:
##  Groups        Name        Variance Std.Dev.
##  stimulus_name (Intercept) 0.4324   0.6576  
##  run_id        (Intercept) 0.4811   0.6936  
##  Residual                  0.6592   0.8119  
## Number of obs: 820, groups:  stimulus_name, 30; run_id, 14
## 
## Fixed effects:
##                              Estimate Std. Error        df t value Pr(>|t|)    
## (Intercept)                   2.00600    0.22446  24.61226   8.937 3.38e-09 ***
## predictabilityUnpredictable  -0.04839    0.05674 776.05930  -0.853    0.394    
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## 
## Correlation of Fixed Effects:
##             (Intr)
## prdctbltyUn -0.126

window_counts_long <- window_counts %>%
  select(run_id, stimulus_name, predictability, pre_count, critical_count, post_count) %>%
  pivot_longer( cols = c(pre_count, critical_count, post_count), names_to = "window", values_to = "boundary_count" ) %>%
  mutate(
    window = recode( window, pre_count = "Pre-critical", critical_count = "Critical", post_count = "Post-critical"),
    window = factor(window, levels = c("Pre-critical", "Critical", "Post-critical")),
    predictability = factor(predictability, levels = c("Predictable", "Unpredictable")))

window_means <- window_counts_long %>%
  group_by(window, predictability) %>%
  summarise( mean_boundary_count = mean(boundary_count, na.rm = TRUE), se = sd(boundary_count, na.rm = TRUE) / sqrt(n()), .groups = "drop")

ggplot(window_means,
  aes(x = predictability, y = mean_boundary_count, group = window, color = window)) +
  geom_line(linewidth = 1.3) +
  geom_point(size = 3.5) +
  geom_errorbar(
    aes(ymin = mean_boundary_count - se, ymax = mean_boundary_count + se),
    width = 0.08, linewidth = 0.7) +
  scale_color_manual(
    values = c("Pre-critical" = "#1b9e77", "Critical" = "#d95f02", "Post-critical" = "#7570b3")) +
  labs(x = NULL, y = "Mean boundary count", color = "Video window", title = "Boundary Counts Across Predictability Conditions") +
  theme_minimal(base_size = 14)

—————————–Model Comparison—————————–

Compare Different Models

library(jtools)
library(performance)

MEM_mean_Gaussian <- lmer(boundary_count ~ predictability + (1 | run_id) + (1 | stimulus_name), data = segmentation_data)
MEM_wBlock <- lmer(boundary_count ~ predictability + block + (1 | run_id) + (1 | stimulus_name), data = segmentation_data)
MEM_WoStimulus <- lmer(boundary_count ~ predictability + (1 | run_id), data = segmentation_data)
## MEM_randomSlopIntecept <- lmer(boundary_count ~ predictability * block + (1 | run_id) + (1 + predictability| stimulus_name), data = segmentation_data)
model_pois <- glmer(boundary_count ~ predictability + (1 | run_id) + (1 | stimulus_name), family = poisson, data = segmentation_data)

r2_nakagawa(MEM_mean_Gaussian)

## # R2 for Mixed Models
## 
##   Conditional R2: 0.728
##      Marginal R2: 0.000

r2_nakagawa(MEM_wBlock)

## # R2 for Mixed Models
## 
##   Conditional R2: 0.729
##      Marginal R2: 0.001

r2_nakagawa(model_pois)

## # R2 for Mixed Models
## 
##   Conditional R2: 0.463
##      Marginal R2: 0.000

r2_nakagawa(MEM_WoStimulus)

## # R2 for Mixed Models
## 
##   Conditional R2: 0.548
##      Marginal R2: 0.000

anova(MEM_mean_Gaussian, MEM_wBlock)

## refitting model(s) with ML (instead of REML)

## Data: segmentation_data
## Models:
## MEM_mean_Gaussian: boundary_count ~ predictability + (1 | run_id) + (1 | stimulus_name)
## MEM_wBlock: boundary_count ~ predictability + block + (1 | run_id) + (1 | stimulus_name)
##                   npar    AIC    BIC  logLik -2*log(L)  Chisq Df Pr(>Chisq)
## MEM_mean_Gaussian    5 2653.4 2676.8 -1321.7    2643.4                     
## MEM_wBlock           6 2652.9 2680.9 -1320.4    2640.9 2.5664  1     0.1092

anova(MEM_mean_Gaussian, MEM_WoStimulus
      )

## refitting model(s) with ML (instead of REML)

## Data: segmentation_data
## Models:
## MEM_WoStimulus: boundary_count ~ predictability + (1 | run_id)
## MEM_mean_Gaussian: boundary_count ~ predictability + (1 | run_id) + (1 | stimulus_name)
##                   npar    AIC    BIC  logLik -2*log(L)  Chisq Df Pr(>Chisq)    
## MEM_WoStimulus       4 2942.4 2961.1 -1467.2    2934.4                         
## MEM_mean_Gaussian    5 2653.4 2676.8 -1321.7    2643.4 290.98  1  < 2.2e-16 ***
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1