── Attaching core tidyverse packages ──────────────────────── tidyverse 2.0.0 ──
✔ dplyr 1.1.4 ✔ readr 2.1.5
✔ forcats 1.0.0 ✔ stringr 1.5.1
✔ ggplot2 3.5.2 ✔ tibble 3.2.1
✔ lubridate 1.9.4 ✔ tidyr 1.3.1
✔ purrr 1.0.4
── Conflicts ────────────────────────────────────────── tidyverse_conflicts() ──
✖ dplyr::filter() masks stats::filter()
✖ dplyr::lag() masks stats::lag()
ℹ Use the conflicted package (<http://conflicted.r-lib.org/>) to force all conflicts to become errors
here() starts at /Users/visuallearninglab/Documents/visvocab
Note: The package "relayer" is highly experimental. Use at your own risk.
Loading required package: viridisLite
Loading required package: lme4
Loading required package: Matrix
Attaching package: 'Matrix'
The following objects are masked from 'package:tidyr':
expand, pack, unpack
Attaching package: 'lmerTest'
The following object is masked from 'package:lme4':
lmer
The following object is masked from 'package:stats':
step
Attaching package: 'cowplot'
The following object is masked from 'package:lubridate':
stamp
Attaching package: 'scales'
The following object is masked from 'package:viridis':
viridis_pal
The following object is masked from 'package:purrr':
discard
The following object is masked from 'package:readr':
col_factor
Attaching package: 'rlang'
The following objects are masked from 'package:purrr':
%@%, flatten, flatten_chr, flatten_dbl, flatten_int, flatten_lgl,
flatten_raw, invoke, splice
Registering fonts with RPotential plots for CCN 2025 poster
PROCESSED_DATA_PATH = here("data","main","processed_data")
trial_summary_data <- read.csv(here(PROCESSED_DATA_PATH, "level-trials_data.csv"))
trial_metadata <- read.csv(here("data", "metadata", "level-trialtype_data.csv"))
cvcl_similarities <- read.csv(here("data", "embeddings", "similarities-cvcl_data.csv"))
openclip_similarities <- read.csv(here("data", "embeddings", "similarities-openclip_data.csv"))
saycamvit_similarities <- read.csv(here("data", "embeddings", "similarities-saycamvit_data.csv"))
imagenetvit_similarities <- read.csv(here("data", "embeddings", "similarities-imagenetvit_data.csv"))
target_looking_trial_level <- read.csv(here("data", PROJECT_VERSION, "processed_data", "level-trialType_added-accuracy_data.csv"))
looking_data_summarized <- trial_summary_data |>
filter(trial_exclusion == 0 & exclude_participant == 0 & exclude_participant_insufficient_data == 0) |>
left_join(trial_metadata) |>
arrange(AoA_Est_target)Joining with `by = join_by(Trials.trialID, Trials.targetImage,
Trials.distractorImage, Trials.imagePair)`openclip checkpoint number fix
## comparisons for openclip
total_checkpoints <- 256
num_selections <- 40
# Step 1: Log-spaced values in base 2
log_scale_checkpoints <- 2 ^ seq(log2(1), log2(total_checkpoints), length.out = num_selections)
# Step 2: Round to nearest integers
log_scale_checkpoints <- round(log_scale_checkpoints)
# Step 3: Remove duplicates and sort
unique_checkpoints <- sort(unique(log_scale_checkpoints))helpers
fit_image_model <- function(summary_data) {
lmer(
scale(corrected_target_looking) ~
scale(image_similarity) * scale(age_in_months) +
scale(AoA_Est_target) +
scale(MeanSaliencyDiff) +
(1 | SubjectInfo.subjID) +
(1 | Trials.targetImage),
data = summary_data |>
mutate(age_in_months = SubjectInfo.testAge / 30)
)
}
fit_text_model <- function(summary_data) {
lmer(
scale(corrected_target_looking) ~
scale(text_similarity) * scale(age_in_months) +
scale(AoA_Est_target) +
scale(MeanSaliencyDiff) +
(1 | SubjectInfo.subjID) +
(1 | Trials.targetImage),
data = summary_data |>
mutate(age_in_months = SubjectInfo.testAge / 30)
)
}CLIP plot
multiple_similarity_effects_plot <- function(data, x_var, y_var = "mean_value", group_var, input_title, prod = FALSE) {
sim_type <- strsplit(x_var, "_")[[1]][1]
# Conditionally filter data if prod is TRUE
if (prod) {
label_data <- data %>%
filter(Trials.targetImage == "acorn" | Trials.distractorImage == "acorn") %>%
mutate(label = paste("Target:", Trials.targetImage, "\nDistractor:", Trials.distractorImage))
} else {
label_data <- data %>%
mutate(label = paste("Target:", Trials.targetImage, "\nDistractor:", Trials.distractorImage))
}
# Build the plot
p <- ggplot(data, aes(x = .data[[x_var]], y = .data[[y_var]], color = .data[[group_var]])) +
geom_hline(yintercept = 0, linetype = "dashed", size=1.5) +
geom_point(size = 8, alpha = 0.8) +
geom_smooth(alpha = 0.3, size = 0, method = "lm", show.legend = FALSE) +
stat_smooth(geom = "line", alpha = 0.8, size = 1.5, method = "lm", show.legend = FALSE) +
coord_cartesian(ylim = c(-0.12, 0.22)) +
geom_label_repel(
color = "black", # force label text to be black
fill = "white", # optional: white label background
segment.color = "black", # force label line to be black
data = label_data,
aes(label = label),
segment.alpha = 0.7,
nudge_y = ifelse(label_data$Trials.targetImage == "bulldozer", -0.02, 0.02),
force = 10,
force_pull = 0.1,
size = 5,
segment.size = 1.2,
point.padding = unit(1, "lines"),
min.segment.length = 0,
box.padding = unit(0.5, "lines"),
max.overlaps = Inf,
label.padding = unit(0.25, "lines"),
label.r = unit(0.5, "lines"),
show.legend = FALSE
) +
ylab("Baseline-corrected\nproportion target looking") +
xlab("Target-distractor embedding similarity") +
scale_y_continuous(breaks = seq(-0.1, 0.2, by = 0.1)) +
scale_color_manual(values = c(
"image_similarity" = "#215D89", # blue
"text_similarity" = "#B8481C" # orange
)) +
guides(color = "none") + # Remove legend (optional)
theme(
text = element_text(size = 16, face = "bold"),
axis.title.x = element_text(
face = "bold",
size = 29,
margin = margin(t = 15, r = 0, b = 0, l = 0)
),
legend.key = element_blank(),
axis.title.y = element_text(
face = "bold",
size = 29,
margin = margin(t = 0, r = 10, b = 0, l = 0)
),
axis.text = element_text(size = 24, face = "bold"),
legend.title = element_blank(),
legend.text = element_text(size = 22, face = "bold"),
legend.position = "bottom",
strip.text = element_text(size = 28, face = "bold"),
strip.background = element_rect(fill = "gray90", color = NA),
strip.text.x = element_text(margin = margin(t = 8, b = 8)),
panel.spacing = unit(0.5, "cm")
) +
facet_wrap(
facets = ~ .data[[group_var]],
dir = "v",
strip.position = "top",
labeller = as_labeller(c(
"image_similarity" = "Image Similarity",
"text_similarity" = "Text Similarity"
)),
ncol = 1,
scales = "free"
)
# Conditionally add custom x-axis scales
if (prod) {
p <- p + facetted_pos_scales(
x = list(
image_similarity = scale_x_continuous(
breaks = seq(0.5, 0.9, by = 0.1),
limits = c(0.43, 0.85)
),
text_similarity = scale_x_continuous(
breaks = seq(0.7, 0.9, by = 0.05),
limits = c(0.7, 0.91)
)
)
)
}
return(p)
}clip_data_summarized <- summarize_similarity_data(looking_data_summarized)
clip_data_long <- clip_data_summarized |>
pivot_longer(cols = c("text_similarity", "image_similarity"), names_to = "sim_type", values_to = "similarity")
all_clip_plot <- multiple_similarity_effects_plot(clip_data_long, "similarity", group_var="sim_type", input_title="Looking time and CLIP embedding correlations", prod=TRUE)Warning: Using `size` aesthetic for lines was deprecated in ggplot2 3.4.0.
ℹ Please use `linewidth` instead.all_clip_plotWarning: `is.ggproto()` was deprecated in ggplot2 3.5.2.
ℹ Please use `is_ggproto()` instead.`geom_smooth()` using formula = 'y ~ x'
`geom_smooth()` using formula = 'y ~ x'
ggsave(here("figures",PROJECT_VERSION,"clip_plot_poster.svg"),all_clip_plot,width=7.5, height=10,bg = "white",device="pdf")`geom_smooth()` using formula = 'y ~ x'
`geom_smooth()` using formula = 'y ~ x'Saliency plots
# Prepare the data by combining both datasets with a grouping variable
trialid_level_summary <- target_looking_trial_level |> left_join(trial_metadata)Joining with `by = join_by(Trials.trialID, AoA_Est_distractor, AoA_Est_target,
Trials.targetImage, Trials.distractorImage, Trials.imagePair)`looking_data_first_appearance <- looking_data_summarized |>
group_by(SubjectInfo.subjID, Trials.targetImage) |>
arrange(Trials.ordinal, .by_group = TRUE) |>
slice(1) |>
ungroup()
baseline_looking_trial_level <- summarized_data(looking_data_first_appearance, "Trials.trialID", "mean_target_looking_baseline_window", c("Trials.trialID")) |> left_join(trial_metadata) Joining with `by = join_by(Trials.trialID)`trialid_level_summary_firstinstance <- summarized_data(looking_data_first_appearance, "Trials.trialID", "corrected_target_looking", c("Trials.trialID")) |> left_join(trial_metadata) Joining with `by = join_by(Trials.trialID)`trialid_level_summary_firstinstance$plot_type <- "Baseline-corrected"
baseline_looking_trial_level$plot_type <- "Baseline window"
combined_data <- bind_rows(trialid_level_summary_firstinstance, baseline_looking_trial_level)
# Create labels for trials where target is acorn and distractor is coconut
combined_data$label_text <- ifelse(
combined_data$Trials.targetImage == "acorn" & combined_data$Trials.distractorImage == "coconut",
paste("Target:", combined_data$Trials.targetImage, "\nDistractor:", combined_data$Trials.distractorImage),
""
)
# Create the combined faceted plot
combined_saliency_plot <- ggplot(combined_data, aes(x = MeanSaliencyDiff, y = mean_value)) +
geom_smooth(alpha = 0.3, size = 0, method = "lm", show.legend = F, color = "#182B49") + # Set color outside aes()
stat_smooth(geom = "line", alpha = 0.8, size = 1.5, method = "lm", show.legend = F, color = "#182B49") +
geom_point(size = 8, alpha = 0.8, color = "#182B49") +
geom_label_repel(
color = "black", # force label text to be black
fill = "white", # optional: white label background
segment.color = "black", # force label line to be black
aes(label = label_text),
segment.alpha = 0.7,
nudge_y = 0.04,
force = 10,
force_pull = 0.1,
size = 5,
segment.size = 1.2,
point.padding = unit(1, "lines"),
min.segment.length = 0,
box.padding = unit(0.5, "lines"),
max.overlaps = Inf,
label.padding = unit(0.25, "lines"),
label.r = unit(0.5, "lines"),
show.legend = FALSE
) +
geom_hline(data = data.frame(plot_type = "Baseline window", yint = 0.5),
aes(yintercept = yint), size=1.5, linetype = "dashed", color = "gray40", inherit.aes = FALSE) +
# Dashed line at 0 for 'Baseline-corrected' facet
geom_hline(data = data.frame(plot_type = "Baseline-corrected", yint = 0),
aes(yintercept = yint), linetype = "dashed", size=1.5, color = "gray40", inherit.aes = FALSE) +
facet_wrap(~ plot_type, scales = "free_y", ncol = 2) +
xlab("Target-distractor GBVS mean saliency difference") +
ylab("Prop. target looking") +
theme(
text = element_text(size = 16, face = "bold"),
axis.title.x = element_text(
face = "bold",
size = 30,
margin = margin(t = 15, r = 0, b = 0, l = 0)
),
legend.key = element_blank(),
axis.title.y = element_text(
face = "bold",
size = 30,
margin = margin(t = 0, r = 10, b = 0, l = 0)
),
axis.text = element_text(size = 26, face = "bold"),
legend.title = element_text(size = 22, face = "bold"),
legend.text = element_text(size = 22, face = "bold"),
legend.position = "bottom",
strip.text = element_text(size = 28, face = "bold"),
strip.background = element_rect(fill = "gray90", color = NA),
strip.text.x = element_text(margin = margin(t = 8, b = 8)),
panel.spacing = unit(0.5, "cm")
)Warning in geom_hline(data = data.frame(plot_type = "Baseline window", yint =
0.5), : Ignoring unknown parameters: `inherit.aes`Warning in geom_hline(data = data.frame(plot_type = "Baseline-corrected", :
Ignoring unknown parameters: `inherit.aes`# Display the plot
combined_saliency_plot`geom_smooth()` using formula = 'y ~ x'
`geom_smooth()` using formula = 'y ~ x'
# Save the combined plot
ggsave(here("figures", PROJECT_VERSION, "saliency_plot_poster_combined.svg"),
combined_saliency_plot, width = 10, height = 5, bg = "white", device = "pdf")`geom_smooth()` using formula = 'y ~ x'
`geom_smooth()` using formula = 'y ~ x'Saliency lmers
The singular effect for the baseline window here throws me off. When I add in a random effect for the target image the effect disappears?
## Baseline window looking
looking_data_summarized <- looking_data_summarized |>
mutate(age_in_months = SubjectInfo.testAge / 30)
baseline_looking_image <- lmer(scale(mean_target_looking_baseline_window) ~ scale(MeanSaliencyDiff)
+ (1 | SubjectInfo.subjID)
+ (1 | Trials.targetImage)
+ (1 | Trials.ordinal)
+ (1 | Trials.imagePair),
data = looking_data_summarized)boundary (singular) fit: see help('isSingular')baseline_looking_imagepair <- lmer(scale(mean_target_looking_baseline_window) ~ scale(MeanSaliencyDiff)
+ (1 | SubjectInfo.subjID)
+ (1 | Trials.imagePair),
data = looking_data_summarized)boundary (singular) fit: see help('isSingular')critical_looking_image <- lmer(scale(mean_target_looking_critical_window) ~ scale(MeanSaliencyDiff)
+ (1 | SubjectInfo.subjID)
+ (1 | Trials.imagePair)
+ (1 | Trials.targetImage),
data = looking_data_summarized)
baseline_corrected_looking_image <- lmer(scale(corrected_target_looking) ~ scale(MeanSaliencyDiff)
+ (1 | SubjectInfo.subjID)
+ (1 | Trials.imagePair)
+ (1 | Trials.targetImage),
data = looking_data_summarized)
baseline_covariate_looking_image <- lmer(scale(mean_target_looking_critical_window) ~ scale(MeanSaliencyDiff)
+ scale(mean_target_looking_baseline_window)
+ (1 | SubjectInfo.subjID)
+ (1 | Trials.imagePair)
+ (1|Trials.targetImage),
data = looking_data_summarized)
summary(baseline_looking_image)Linear mixed model fit by REML. t-tests use Satterthwaite's method [
lmerModLmerTest]
Formula:
scale(mean_target_looking_baseline_window) ~ scale(MeanSaliencyDiff) +
(1 | SubjectInfo.subjID) + (1 | Trials.targetImage) + (1 |
Trials.ordinal) + (1 | Trials.imagePair)
Data: looking_data_summarized
REML criterion at convergence: 6998.2
Scaled residuals:
Min 1Q Median 3Q Max
-1.97410 -0.71028 -0.01657 0.75334 1.91832
Random effects:
Groups Name Variance Std.Dev.
SubjectInfo.subjID (Intercept) 0.000000 0.00000
Trials.ordinal (Intercept) 0.008331 0.09127
Trials.targetImage (Intercept) 0.027617 0.16618
Trials.imagePair (Intercept) 0.002946 0.05428
Residual 0.965507 0.98260
Number of obs: 2476, groups:
SubjectInfo.subjID, 91; Trials.ordinal, 52; Trials.targetImage, 24; Trials.imagePair, 16
Fixed effects:
Estimate Std. Error df t value Pr(>|t|)
(Intercept) 0.02535 0.04488 14.00802 0.565 0.581
scale(MeanSaliencyDiff) 0.03824 0.03363 33.08656 1.137 0.264
Correlation of Fixed Effects:
(Intr)
scl(MnSlnD) 0.026
optimizer (nloptwrap) convergence code: 0 (OK)
boundary (singular) fit: see help('isSingular')summary(baseline_looking_imagepair)Linear mixed model fit by REML. t-tests use Satterthwaite's method [
lmerModLmerTest]
Formula:
scale(mean_target_looking_baseline_window) ~ scale(MeanSaliencyDiff) +
(1 | SubjectInfo.subjID) + (1 | Trials.imagePair)
Data: looking_data_summarized
REML criterion at convergence: 7030.1
Scaled residuals:
Min 1Q Median 3Q Max
-1.73380 -0.74024 -0.02707 0.75524 1.72027
Random effects:
Groups Name Variance Std.Dev.
SubjectInfo.subjID (Intercept) 0.0000 0.0000
Trials.imagePair (Intercept) 0.0000 0.0000
Residual 0.9974 0.9987
Number of obs: 2476, groups: SubjectInfo.subjID, 91; Trials.imagePair, 16
Fixed effects:
Estimate Std. Error df t value Pr(>|t|)
(Intercept) 1.638e-15 2.007e-02 2.474e+03 0.000 1.00000
scale(MeanSaliencyDiff) 5.492e-02 2.007e-02 2.474e+03 2.736 0.00626 **
---
Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
Correlation of Fixed Effects:
(Intr)
scl(MnSlnD) 0.000
optimizer (nloptwrap) convergence code: 0 (OK)
boundary (singular) fit: see help('isSingular')summary(critical_looking_image)Linear mixed model fit by REML. t-tests use Satterthwaite's method [
lmerModLmerTest]
Formula:
scale(mean_target_looking_critical_window) ~ scale(MeanSaliencyDiff) +
(1 | SubjectInfo.subjID) + (1 | Trials.imagePair) + (1 |
Trials.targetImage)
Data: looking_data_summarized
REML criterion at convergence: 6903.9
Scaled residuals:
Min 1Q Median 3Q Max
-2.32798 -0.72305 0.08992 0.77506 2.29301
Random effects:
Groups Name Variance Std.Dev.
SubjectInfo.subjID (Intercept) 0.036293 0.19051
Trials.targetImage (Intercept) 0.057970 0.24077
Trials.imagePair (Intercept) 0.008672 0.09313
Residual 0.904240 0.95092
Number of obs: 2476, groups:
SubjectInfo.subjID, 91; Trials.targetImage, 24; Trials.imagePair, 16
Fixed effects:
Estimate Std. Error df t value Pr(>|t|)
(Intercept) 0.01168 0.06139 25.56388 0.190 0.851
scale(MeanSaliencyDiff) 0.04125 0.04123 42.12734 1.001 0.323
Correlation of Fixed Effects:
(Intr)
scl(MnSlnD) 0.027 summary(baseline_corrected_looking_image)Linear mixed model fit by REML. t-tests use Satterthwaite's method [
lmerModLmerTest]
Formula: scale(corrected_target_looking) ~ scale(MeanSaliencyDiff) + (1 |
SubjectInfo.subjID) + (1 | Trials.imagePair) + (1 | Trials.targetImage)
Data: looking_data_summarized
REML criterion at convergence: 7006
Scaled residuals:
Min 1Q Median 3Q Max
-2.86800 -0.61847 -0.02582 0.66003 2.81873
Random effects:
Groups Name Variance Std.Dev.
SubjectInfo.subjID (Intercept) 0.020513 0.14322
Trials.targetImage (Intercept) 0.016016 0.12655
Trials.imagePair (Intercept) 0.004581 0.06768
Residual 0.961104 0.98036
Number of obs: 2476, groups:
SubjectInfo.subjID, 91; Trials.targetImage, 24; Trials.imagePair, 16
Fixed effects:
Estimate Std. Error df t value Pr(>|t|)
(Intercept) -0.009580 0.040032 24.752795 -0.239 0.813
scale(MeanSaliencyDiff) 0.005423 0.029624 33.456665 0.183 0.856
Correlation of Fixed Effects:
(Intr)
scl(MnSlnD) 0.022 summary(baseline_covariate_looking_image)Linear mixed model fit by REML. t-tests use Satterthwaite's method [
lmerModLmerTest]
Formula:
scale(mean_target_looking_critical_window) ~ scale(MeanSaliencyDiff) +
scale(mean_target_looking_baseline_window) + (1 | SubjectInfo.subjID) +
(1 | Trials.imagePair) + (1 | Trials.targetImage)
Data: looking_data_summarized
REML criterion at convergence: 6696.6
Scaled residuals:
Min 1Q Median 3Q Max
-2.76241 -0.71706 0.06881 0.74548 2.39607
Random effects:
Groups Name Variance Std.Dev.
SubjectInfo.subjID (Intercept) 0.03541 0.18817
Trials.targetImage (Intercept) 0.04193 0.20476
Trials.imagePair (Intercept) 0.00619 0.07868
Residual 0.83069 0.91142
Number of obs: 2476, groups:
SubjectInfo.subjID, 91; Trials.targetImage, 24; Trials.imagePair, 16
Fixed effects:
Estimate Std. Error df
(Intercept) 3.574e-03 5.385e-02 2.773e+01
scale(MeanSaliencyDiff) 3.430e-02 3.673e-02 4.549e+01
scale(mean_target_looking_baseline_window) 2.804e-01 1.876e-02 2.436e+03
t value Pr(>|t|)
(Intercept) 0.066 0.948
scale(MeanSaliencyDiff) 0.934 0.355
scale(mean_target_looking_baseline_window) 14.944 <2e-16 ***
---
Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
Correlation of Fixed Effects:
(Intr) s(MSD)
scl(MnSlnD) 0.027
scl(mn____) -0.009 -0.016Do we see an interaction with window type? More of an effect of saliency in baseline vs critical?
trials_window_type_separated <- looking_data_summarized |>
pivot_longer(cols=c(mean_target_looking_critical_window, mean_target_looking_baseline_window), names_to="window_type", values_to="target_looking") |>
mutate(window_type = str_replace(window_type, "mean_target_looking_", "")) |>
mutate(trial_window_c = case_when(
window_type=="critical_window" ~ 0.5,
window_type=="baseline_window" ~ -0.5))
window_type_looking <- lmer(scale(target_looking) ~ trial_window_c*scale(MeanSaliencyDiff) +
+ scale(AoA_Est_target)
+ (1 | SubjectInfo.subjID)
+ (1 | Trials.ordinal)
+ (1 | Trials.targetImage),
data = trials_window_type_separated)
summary(window_type_looking)Linear mixed model fit by REML. t-tests use Satterthwaite's method [
lmerModLmerTest]
Formula: scale(target_looking) ~ trial_window_c * scale(MeanSaliencyDiff) +
+scale(AoA_Est_target) + (1 | SubjectInfo.subjID) + (1 |
Trials.ordinal) + (1 | Trials.targetImage)
Data: trials_window_type_separated
REML criterion at convergence: 13873.6
Scaled residuals:
Min 1Q Median 3Q Max
-2.20398 -0.72783 0.03463 0.76740 2.06713
Random effects:
Groups Name Variance Std.Dev.
SubjectInfo.subjID (Intercept) 0.012554 0.11205
Trials.ordinal (Intercept) 0.007444 0.08628
Trials.targetImage (Intercept) 0.026501 0.16279
Residual 0.937535 0.96826
Number of obs: 4952, groups:
SubjectInfo.subjID, 91; Trials.ordinal, 52; Trials.targetImage, 24
Fixed effects:
Estimate Std. Error df t value
(Intercept) 1.968e-02 4.097e-02 3.094e+01 0.480
trial_window_c 1.763e-01 2.752e-02 4.793e+03 6.407
scale(MeanSaliencyDiff) 2.773e-02 2.671e-02 9.004e+01 1.038
scale(AoA_Est_target) -1.040e-01 3.474e-02 2.163e+01 -2.993
trial_window_c:scale(MeanSaliencyDiff) 6.623e-03 2.752e-02 4.793e+03 0.241
Pr(>|t|)
(Intercept) 0.63433
trial_window_c 1.63e-10 ***
scale(MeanSaliencyDiff) 0.30186
scale(AoA_Est_target) 0.00678 **
trial_window_c:scale(MeanSaliencyDiff) 0.80984
---
Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
Correlation of Fixed Effects:
(Intr) trl_w_ s(MSD) s(AA_E
tril_wndw_c 0.000
scl(MnSlnD) 0.026 0.000
scl(AA_Es_) 0.014 0.000 0.033
trl__:(MSD) 0.000 0.000 0.000 0.000 Checking the difference between baseline window looking and baseline-corrected looking even though that is a little strange
trials_window_type_separated_baselinecorrected <- looking_data_summarized |>
mutate(corrected_target_looking = scale(corrected_target_looking),
mean_target_looking_baseline_window = scale(mean_target_looking_baseline_window)) |>
pivot_longer(cols=c(corrected_target_looking, mean_target_looking_baseline_window), names_to="window_type", values_to="target_looking") |>
mutate(window_type = str_replace(window_type, "mean_target_looking_", "")) |>
mutate(trial_window_c = case_when(
window_type=="corrected_target_looking" ~ 0.5,
window_type=="baseline_window" ~ -0.5))
window_type_looking_baselinecorrected <- lmer(scale(target_looking) ~ trial_window_c*scale(MeanSaliencyDiff) +
+ (1 | SubjectInfo.subjID)
+ (1 | Trials.targetImage),
data = trials_window_type_separated_baselinecorrected)boundary (singular) fit: see help('isSingular')summary(window_type_looking_baselinecorrected)Linear mixed model fit by REML. t-tests use Satterthwaite's method [
lmerModLmerTest]
Formula: scale(target_looking) ~ trial_window_c * scale(MeanSaliencyDiff) +
+(1 | SubjectInfo.subjID) + (1 | Trials.targetImage)
Data: trials_window_type_separated_baselinecorrected
REML criterion at convergence: 14048.7
Scaled residuals:
Min 1Q Median 3Q Max
-2.83311 -0.68017 -0.03613 0.71390 2.70289
Random effects:
Groups Name Variance Std.Dev.
SubjectInfo.subjID (Intercept) 4.746e-16 2.178e-08
Trials.targetImage (Intercept) 9.233e-03 9.609e-02
Residual 9.904e-01 9.952e-01
Number of obs: 4952, groups: SubjectInfo.subjID, 91; Trials.targetImage, 24
Fixed effects:
Estimate Std. Error df t value
(Intercept) 7.939e-03 2.453e-02 2.235e+01 0.324
trial_window_c -2.035e-15 2.828e-02 4.926e+03 0.000
scale(MeanSaliencyDiff) 2.427e-02 2.145e-02 4.961e+01 1.132
trial_window_c:scale(MeanSaliencyDiff) -4.930e-02 2.829e-02 4.926e+03 -1.743
Pr(>|t|)
(Intercept) 0.7492
trial_window_c 1.0000
scale(MeanSaliencyDiff) 0.2632
trial_window_c:scale(MeanSaliencyDiff) 0.0814 .
---
Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
Correlation of Fixed Effects:
(Intr) trl_w_ s(MSD)
tril_wndw_c 0.000
scl(MnSlnD) 0.027 0.000
trl__:(MSD) 0.000 0.000 0.000
optimizer (nloptwrap) convergence code: 0 (OK)
boundary (singular) fit: see help('isSingular')Collapsing across trial types for a single image pair
looking_data_summarized_image_pair <- looking_data_summarized %>%
mutate(across(
c(mean_target_looking_baseline_window, MeanSaliencyDiff),
~ ifelse(grepl("distractor", Trials.trialID), -.x, .x)
))
baseline_looking_collapsed <- lmer(scale(mean_target_looking_baseline_window) ~ scale(MeanSaliencyDiff)
+ (1 | SubjectInfo.subjID)
+ (1 | Trials.imagePair),
data = looking_data_summarized_image_pair)boundary (singular) fit: see help('isSingular')summary(baseline_looking_collapsed)Linear mixed model fit by REML. t-tests use Satterthwaite's method [
lmerModLmerTest]
Formula:
scale(mean_target_looking_baseline_window) ~ scale(MeanSaliencyDiff) +
(1 | SubjectInfo.subjID) + (1 | Trials.imagePair)
Data: looking_data_summarized_image_pair
REML criterion at convergence: 7033.6
Scaled residuals:
Min 1Q Median 3Q Max
-1.74206 -0.84535 0.03319 0.83807 1.80623
Random effects:
Groups Name Variance Std.Dev.
SubjectInfo.subjID (Intercept) 2.831e-17 5.321e-09
Trials.imagePair (Intercept) 9.848e-04 3.138e-02
Residual 9.980e-01 9.990e-01
Number of obs: 2476, groups: SubjectInfo.subjID, 91; Trials.imagePair, 16
Fixed effects:
Estimate Std. Error df t value Pr(>|t|)
(Intercept) 1.465e-04 2.156e-02 1.406e+01 0.007 0.9947
scale(MeanSaliencyDiff) 3.893e-02 2.156e-02 1.404e+01 1.805 0.0925 .
---
Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
Correlation of Fixed Effects:
(Intr)
scl(MnSlnD) 0.000
optimizer (nloptwrap) convergence code: 0 (OK)
boundary (singular) fit: see help('isSingular')checking variance across predictors
looking_data_summarized %>%
group_by(Trials.targetImage) %>%
summarize(var_saliency = var(MeanSaliencyDiff),
var_similarity = var(image_similarity))# A tibble: 24 × 3
Trials.targetImage var_saliency var_similarity
<chr> <dbl> <dbl>
1 acorn 0.00567 0.00539
2 bulldozer 0.00338 0.00843
3 butter 0 0
4 cheese 0.00935 0.0387
5 coconut 0 0
6 cow 0 0
7 eagle 0 0
8 frog 0 0
9 glasses 0 0
10 goat 0 0
# ℹ 14 more rowswhat about across excluded participants as well: this is a little sketchy.
baseline_looking_image_full_sample <- lmer(scale(mean_target_looking_baseline_window) ~ scale(MeanSaliencyDiff)
+ (1 | SubjectInfo.subjID)
+ (1 | Trials.targetImage)
+ (1 | Trials.imagePair),
data = trial_summary_data |> left_join(trial_metadata))Joining with `by = join_by(Trials.trialID, Trials.targetImage,
Trials.distractorImage, Trials.imagePair)`
Joining with `by = join_by(Trials.trialID, Trials.targetImage,
Trials.distractorImage, Trials.imagePair)`
Joining with `by = join_by(Trials.trialID, Trials.targetImage,
Trials.distractorImage, Trials.imagePair)`
Joining with `by = join_by(Trials.trialID, Trials.targetImage,
Trials.distractorImage, Trials.imagePair)`
boundary (singular) fit: see help('isSingular')
Joining with `by = join_by(Trials.trialID, Trials.targetImage,
Trials.distractorImage, Trials.imagePair)`
Joining with `by = join_by(Trials.trialID, Trials.targetImage,
Trials.distractorImage, Trials.imagePair)`
Joining with `by = join_by(Trials.trialID, Trials.targetImage,
Trials.distractorImage, Trials.imagePair)`
Joining with `by = join_by(Trials.trialID, Trials.targetImage,
Trials.distractorImage, Trials.imagePair)`summary(baseline_looking_image_full_sample)Linear mixed model fit by REML. t-tests use Satterthwaite's method [
lmerModLmerTest]
Formula:
scale(mean_target_looking_baseline_window) ~ scale(MeanSaliencyDiff) +
(1 | SubjectInfo.subjID) + (1 | Trials.targetImage) + (1 |
Trials.imagePair)
Data: left_join(trial_summary_data, trial_metadata)
REML criterion at convergence: 10049.6
Scaled residuals:
Min 1Q Median 3Q Max
-1.66102 -0.80979 -0.02603 0.81625 1.75542
Random effects:
Groups Name Variance Std.Dev.
SubjectInfo.subjID (Intercept) 0.00000 0.0000
Trials.targetImage (Intercept) 0.01118 0.1057
Trials.imagePair (Intercept) 0.00000 0.0000
Residual 0.98569 0.9928
Number of obs: 3548, groups:
SubjectInfo.subjID, 122; Trials.targetImage, 24; Trials.imagePair, 16
Fixed effects:
Estimate Std. Error df t value Pr(>|t|)
(Intercept) 0.01129 0.02767 19.01107 0.408 0.6877
scale(MeanSaliencyDiff) 0.05002 0.02450 40.13875 2.042 0.0478 *
---
Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
Correlation of Fixed Effects:
(Intr)
scl(MnSlnD) 0.025
optimizer (nloptwrap) convergence code: 0 (OK)
boundary (singular) fit: see help('isSingular')saliency order effects - planning to use these!
this is interesting! order effects showing up in the baseline window
order_ranked_trials <- looking_data_summarized |>
group_by(SubjectInfo.subjID, Trials.targetImage) |>
arrange(Trials.ordinal, .by_group = TRUE) |>
mutate(
slice_num = row_number(),
order = case_when(
slice_num == 1 ~ -0.5,
slice_num == 2 ~ 0.5,
TRUE ~ NA
)
)
main_image_effect_ranked <- lmer(scale(mean_target_looking_baseline_window) ~ (scale(order))
+ scale(age_in_months)
+ scale(MeanSaliencyDiff)
+ (1 | SubjectInfo.subjID)
+ (1|Trials.targetImage),
data = order_ranked_trials |> mutate(age_in_months = SubjectInfo.testAge / 30))boundary (singular) fit: see help('isSingular')# |> filter(Trials.trialType %in% c("easy", "hard")
summary(main_image_effect_ranked)Linear mixed model fit by REML. t-tests use Satterthwaite's method [
lmerModLmerTest]
Formula: scale(mean_target_looking_baseline_window) ~ (scale(order)) +
scale(age_in_months) + scale(MeanSaliencyDiff) + (1 | SubjectInfo.subjID) +
(1 | Trials.targetImage)
Data: mutate(order_ranked_trials, age_in_months = SubjectInfo.testAge/30)
REML criterion at convergence: 7007.2
Scaled residuals:
Min 1Q Median 3Q Max
-1.89727 -0.72117 -0.02422 0.76639 1.95451
Random effects:
Groups Name Variance Std.Dev.
SubjectInfo.subjID (Intercept) 0.00000 0.0000
Trials.targetImage (Intercept) 0.01816 0.1348
Residual 0.97515 0.9875
Number of obs: 2476, groups: SubjectInfo.subjID, 91; Trials.targetImage, 24
Fixed effects:
Estimate Std. Error df t value Pr(>|t|)
(Intercept) 1.512e-02 3.451e-02 1.989e+01 0.438 0.66595
scale(order) -6.128e-02 2.206e-02 1.080e+03 -2.778 0.00557 **
scale(age_in_months) -8.574e-03 1.986e-02 2.451e+03 -0.432 0.66597
scale(MeanSaliencyDiff) 4.703e-02 3.016e-02 4.441e+01 1.559 0.12603
---
Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
Correlation of Fixed Effects:
(Intr) scl(r) sc(__)
scale(ordr) 0.077
scl(g_n_mn) -0.002 -0.002
scl(MnSlnD) 0.022 -0.064 -0.011
optimizer (nloptwrap) convergence code: 0 (OK)
boundary (singular) fit: see help('isSingular')looking_data_first_appearance <- looking_data_summarized |>
group_by(SubjectInfo.subjID, Trials.targetImage) |>
arrange(Trials.ordinal, .by_group = TRUE) |>
slice(1) |>
ungroup()
baseline_looking_first_appearance_model <- lmer(scale(mean_target_looking_baseline_window) ~ scale(MeanSaliencyDiff)
+ (1 | SubjectInfo.subjID)
+ (1 | Trials.targetImage)
+ (1 | Trials.imagePair),
data = looking_data_first_appearance)boundary (singular) fit: see help('isSingular')# |> filter(Trials.trialType %in% c("easy", "hard")
summary(baseline_looking_first_appearance_model)Linear mixed model fit by REML. t-tests use Satterthwaite's method [
lmerModLmerTest]
Formula:
scale(mean_target_looking_baseline_window) ~ scale(MeanSaliencyDiff) +
(1 | SubjectInfo.subjID) + (1 | Trials.targetImage) + (1 |
Trials.imagePair)
Data: looking_data_first_appearance
REML criterion at convergence: 5484.5
Scaled residuals:
Min 1Q Median 3Q Max
-1.8970 -0.7264 -0.0091 0.7935 1.8791
Random effects:
Groups Name Variance Std.Dev.
SubjectInfo.subjID (Intercept) 0.003995 0.06321
Trials.targetImage (Intercept) 0.015223 0.12338
Trials.imagePair (Intercept) 0.000000 0.00000
Residual 0.977207 0.98854
Number of obs: 1936, groups:
SubjectInfo.subjID, 91; Trials.targetImage, 24; Trials.imagePair, 16
Fixed effects:
Estimate Std. Error df t value Pr(>|t|)
(Intercept) 0.001781 0.034434 22.555797 0.052 0.9592
scale(MeanSaliencyDiff) 0.070894 0.031748 34.942005 2.233 0.0321 *
---
Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
Correlation of Fixed Effects:
(Intr)
scl(MnSlnD) 0.004
optimizer (nloptwrap) convergence code: 0 (OK)
boundary (singular) fit: see help('isSingular')OpenCLIP training
openclip_similarities_combined <- openclip_similarities |>
rename(word_a = word1, word_b = word2) |>
bind_rows(
openclip_similarities |>
rename(word_a = word2, word_b = word1)
)
looking_data_w_openclip <- looking_data_summarized |>
select(-text_similarity, -multimodal_similarity, -image_similarity) |>
left_join(openclip_similarities_combined, by = c("Trials.distractorImage"="word_a", "Trials.targetImage"="word_b"))Warning in left_join(select(looking_data_summarized, -text_similarity, -multimodal_similarity, : Detected an unexpected many-to-many relationship between `x` and `y`.
ℹ Row 1 of `x` matches multiple rows in `y`.
ℹ Row 6 of `y` matches multiple rows in `x`.
ℹ If a many-to-many relationship is expected, set `relationship =
"many-to-many"` to silence this warning.common_cols <- intersect(colnames(looking_data_w_openclip), colnames(looking_data_summarized))
looking_data_w_openclip_clip <- looking_data_w_openclip |> bind_rows(
looking_data_summarized %>%
mutate(epoch = 33) %>%
select(all_of(common_cols), epoch)
)
openclip_data_summarized <- summarize_similarity_data(looking_data_w_openclip, extra_fields=c("epoch"))
openclip_clip_data_summarized <- summarize_similarity_data(looking_data_w_openclip_clip, extra_fields=c("epoch"))
openclip_age_half_summarized <- looking_data_w_openclip |>
add_age_split() |>
summarize_similarity_data(extra_fields = c("age_half", "epoch"))
# Function to calculate Pearson's correlation per epoch
calculate_correlations <- function(data, x_var, y_var, group_var = c("epoch"), conf_level = 0.95) {
data |>
group_by(across(all_of(group_var))) |>
summarize(
{
cor_test <- cor.test(.data[[x_var]], .data[[y_var]], method = "pearson", conf.level = conf_level)
tibble(
pearson_cor = cor_test$estimate,
p_value = cor_test$p.value,
ci_lower = cor_test$conf.int[1],
ci_upper = cor_test$conf.int[2]
)
},
.groups = "drop"
)
}
image_correlation_results_age_split <- calculate_correlations(openclip_age_half_summarized, "image_similarity", "mean_value", group_var=c("epoch", "age_half"))
text_correlation_results <- calculate_correlations(openclip_data_summarized, "text_similarity", "mean_value", group_var=c("epoch")) %>%
mutate(similarity_type = "Text similarity")
image_correlation_results <- calculate_correlations(openclip_data_summarized, "image_similarity", "mean_value", group_var=c("epoch")) %>%
mutate(similarity_type = "Image similarity")
combined_correlation_results <- bind_rows(text_correlation_results, image_correlation_results)CCN plot
oc_plot <- ggplot(combined_correlation_results |>
rowwise() |>
mutate(epoch = unique_checkpoints[[epoch]]),
aes(x = log(epoch), y = pearson_cor, color = similarity_type)) +
#geom_errorbar(aes(ymin = ci_lower, ymax = ci_upper), width = 0.1) +
#geom_hline(yintercept = 0, linetype = "dashed", color = "gray40") +
geom_point(size = 6, alpha = 0.8) +
geom_smooth(alpha = 0.3, size = 0, span = 2, show.legend = FALSE) +
stat_smooth(geom = "line", alpha = 0.8, size = 1.5, span = 2, show.legend = FALSE) +
labs(x = "log (OpenCLIP epoch)",
y = "Pearson's\ncorrelation (r)",
color = "Similarity Type") +
scale_color_manual(values = c(
"Text similarity" = "#B8481C",
"Image similarity" = "#215D89"
)) +
scale_shape_manual(values = c(`TRUE` = 16, `FALSE` = 1)) +
theme(
text = element_text(size=26, face="bold"),
legend.position = c(0.25, 0.8), # Adjust x/y values as needed
legend.background = element_rect(fill = "white", color = "gray80"),
legend.key = element_blank(),
legend.title = element_blank(),
legend.text = element_text(size = 26, face = "bold"),
axis.title = element_text(size = 28),
axis.title.x = element_text(
face = "bold",
size = 32,
margin = margin(t = 15, r = 0, b = 0, l = 0)
),
axis.title.y = element_text(
face = "bold",
size = 32,
margin = margin(t = 0, r = 10, b = 0, l = 0)
),
axis.text = element_text(size = 30, face = "bold")
)Warning: A numeric `legend.position` argument in `theme()` was deprecated in ggplot2
3.5.0.
ℹ Please use the `legend.position.inside` argument of `theme()` instead.oc_plot`geom_smooth()` using method = 'loess' and formula = 'y ~ x'
`geom_smooth()` using method = 'loess' and formula = 'y ~ x'Warning: No shared levels found between `names(values)` of the manual scale and the
data's shape values.
ggsave(here("figures",PROJECT_VERSION,"oc_plot_poster.svg"),oc_plot,width=10, height=5,bg = "white",device="pdf")`geom_smooth()` using method = 'loess' and formula = 'y ~ x'
`geom_smooth()` using method = 'loess' and formula = 'y ~ x'Warning: No shared levels found between `names(values)` of the manual scale and the
data's shape values.Comparing to random values
library(dplyr)
library(purrr)
get_randomized_correlation <- function(data, sim_type, group_var = c("epoch")) {
randomized_values <- data %>%
distinct(Trials.trialID, .keep_all = TRUE) %>%
mutate(shuffled_value = sample(mean_value)) %>%
select(Trials.trialID, shuffled_value)
randomized_data <- data %>%
left_join(randomized_values, by = "Trials.trialID") %>%
mutate(mean_value = shuffled_value) %>%
select(-shuffled_value)
calculate_correlations(randomized_data, sim_type, "mean_value", group_var = group_var)
}
image_correlations_randomized <- get_randomized_correlation(openclip_data_summarized, "image_similarity") |>
mutate(similarity_type = "Image randomized")
text_correlations_randomized <- get_randomized_correlation(openclip_data_summarized, "text_similarity") |>
mutate(similarity_type = "Text randomized")
n_boot <- 1000
boot_results <- map_dfr(1:n_boot, function(i) {
image_corr <- get_randomized_correlation(openclip_data_summarized, "image_similarity") %>%
mutate(similarity_type = "Image randomized bootstrapped", bootstrap = i)
text_corr <- get_randomized_correlation(openclip_data_summarized, "text_similarity") %>%
mutate(similarity_type = "Text randomized bootstrapped", bootstrap = i)
bind_rows(image_corr, text_corr)
})
boot_summary <- boot_results %>%
group_by(epoch, similarity_type) %>%
summarize(
pearson_cor = mean(pearson_cor, na.rm = TRUE),
ci_lower = quantile(pearson_cor, 0.025, na.rm = TRUE),
ci_upper = quantile(pearson_cor, 0.975, na.rm = TRUE),
.groups = "drop"
)
combined_correlation_results <- bind_rows(combined_correlation_results, image_correlations_randomized, text_correlations_randomized, boot_summary) %>%
mutate(is_randomized = grepl("randomized", similarity_type) & !grepl("bootstrap", similarity_type))
ggplot(combined_correlation_results |> rowwise() |> mutate(epoch = unique_checkpoints[[epoch]]), aes(x = log(epoch), y = pearson_cor, color = similarity_type, alpha = is_randomized)) +
geom_point(size = 3, aes(shape = !is.na(p_value) & p_value < 0.05)) +
geom_smooth(span = 2, se = FALSE) +
#geom_errorbar(aes(ymin = ci_lower, ymax = ci_upper), width = 0.1) +
geom_hline(yintercept = 0, linetype = "dashed", color = "gray40") +
labs(title = "Correlation Across Open-CLIP Training",
x = "log (Epoch)",
y = "Pearson correlation between\nbaseline-corrected prop. target looking\nand embedding similarity",
color = "Similarity Type",
shape = "p < 0.05") +
scale_color_manual(values = c(
"Text" = "#1f77b4", # Default blue
"Image" = "#215D89", # Default orange
"Image randomized bootstrapped" = "#ffbb78", # Lighter orange
"Text randomized bootstrapped" = "#1fa2b0",
"Image randomized" = "#ffbb78",
"Text randomized" = "#1fa2b0"
)) +
scale_alpha_manual(values = c(`TRUE` = 0.3, `FALSE` = 1)) +
guides(alpha = "none") +
scale_shape_manual(values = c(`TRUE` = 16, `FALSE` = 1)) + # Filled vs hollow dots for significance
theme_minimal()`geom_smooth()` using method = 'loess' and formula = 'y ~ x'
It is unadvised to do model comparisons with such few items! However, interesting future direction.
checking out epoch 3 which had the highest correlation
still had to remove the random slope for image_similarity because of a singular fit but we definitely see a stronger effect
stopifnot(nrow(looking_data_w_openclip |> filter(epoch == 3)) == nrow(looking_data_summarized))
epoch3_data_summarized <- summarize_similarity_data(looking_data_w_openclip |> filter(epoch == 3))
openclip_data_long <- epoch3_data_summarized |>
pivot_longer(cols = c("text_similarity", "image_similarity"), names_to = "sim_type", values_to = "similarity")
all_clip_plot <- multiple_similarity_effects_plot(openclip_data_long, "similarity", group_var="sim_type", input_title="Looking time and Open CLIP epoch 3 embedding correlations")
all_clip_plot`geom_smooth()` using formula = 'y ~ x'
`geom_smooth()` using formula = 'y ~ x'
Comparing models from different epochs
library(MuMIn)
epoch3_image_effect <- fit_image_model(looking_data_w_openclip |> filter(epoch == 3))
summary(epoch3_image_effect)Linear mixed model fit by REML. t-tests use Satterthwaite's method [
lmerModLmerTest]
Formula:
scale(corrected_target_looking) ~ scale(image_similarity) * scale(age_in_months) +
scale(AoA_Est_target) + scale(MeanSaliencyDiff) + (1 | SubjectInfo.subjID) +
(1 | Trials.targetImage)
Data: mutate(summary_data, age_in_months = SubjectInfo.testAge/30)
REML criterion at convergence: 7005.6
Scaled residuals:
Min 1Q Median 3Q Max
-2.81337 -0.62233 -0.01623 0.66566 2.78508
Random effects:
Groups Name Variance Std.Dev.
SubjectInfo.subjID (Intercept) 0.017035 0.13052
Trials.targetImage (Intercept) 0.007234 0.08506
Residual 0.961386 0.98050
Number of obs: 2476, groups: SubjectInfo.subjID, 91; Trials.targetImage, 24
Fixed effects:
Estimate Std. Error df
(Intercept) -7.377e-03 3.003e-02 2.768e+01
scale(image_similarity) -5.637e-02 2.317e-02 1.240e+02
scale(age_in_months) 5.790e-02 2.402e-02 9.101e+01
scale(AoA_Est_target) -7.868e-02 2.680e-02 2.326e+01
scale(MeanSaliencyDiff) 2.785e-03 2.507e-02 3.511e+01
scale(image_similarity):scale(age_in_months) -3.601e-02 1.977e-02 2.384e+03
t value Pr(>|t|)
(Intercept) -0.246 0.80779
scale(image_similarity) -2.433 0.01641 *
scale(age_in_months) 2.411 0.01792 *
scale(AoA_Est_target) -2.936 0.00737 **
scale(MeanSaliencyDiff) 0.111 0.91216
scale(image_similarity):scale(age_in_months) -1.822 0.06864 .
---
Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
Correlation of Fixed Effects:
(Intr) scl(_) sc(__) s(AA_E s(MSD)
scl(mg_sml) -0.004
scl(g_n_mn) 0.003 -0.009
scl(AA_Es_) 0.009 -0.232 0.011
scl(MnSlnD) 0.018 -0.015 -0.009 0.027
scl(_):(__) -0.004 -0.010 0.009 0.010 -0.007epoch32_image_effect <- fit_image_model(looking_data_w_openclip |> filter(epoch == 28))
summary(epoch32_image_effect)Linear mixed model fit by REML. t-tests use Satterthwaite's method [
lmerModLmerTest]
Formula:
scale(corrected_target_looking) ~ scale(image_similarity) * scale(age_in_months) +
scale(AoA_Est_target) + scale(MeanSaliencyDiff) + (1 | SubjectInfo.subjID) +
(1 | Trials.targetImage)
Data: mutate(summary_data, age_in_months = SubjectInfo.testAge/30)
REML criterion at convergence: 7010.1
Scaled residuals:
Min 1Q Median 3Q Max
-2.82004 -0.62033 -0.01545 0.67083 2.79780
Random effects:
Groups Name Variance Std.Dev.
SubjectInfo.subjID (Intercept) 0.01717 0.1310
Trials.targetImage (Intercept) 0.01005 0.1002
Residual 0.96185 0.9807
Number of obs: 2476, groups: SubjectInfo.subjID, 91; Trials.targetImage, 24
Fixed effects:
Estimate Std. Error df
(Intercept) -8.310e-03 3.202e-02 2.745e+01
scale(image_similarity) -4.673e-02 2.525e-02 7.178e+01
scale(age_in_months) 5.803e-02 2.405e-02 9.100e+01
scale(AoA_Est_target) -8.175e-02 2.874e-02 2.256e+01
scale(MeanSaliencyDiff) 1.432e-03 2.658e-02 3.786e+01
scale(image_similarity):scale(age_in_months) -2.031e-02 1.967e-02 2.380e+03
t value Pr(>|t|)
(Intercept) -0.260 0.79714
scale(image_similarity) -1.851 0.06835 .
scale(age_in_months) 2.413 0.01783 *
scale(AoA_Est_target) -2.845 0.00928 **
scale(MeanSaliencyDiff) 0.054 0.95732
scale(image_similarity):scale(age_in_months) -1.032 0.30206
---
Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
Correlation of Fixed Effects:
(Intr) scl(_) sc(__) s(AA_E s(MSD)
scl(mg_sml) -0.008
scl(g_n_mn) 0.003 -0.007
scl(AA_Es_) 0.012 -0.212 0.010
scl(MnSlnD) 0.021 0.010 -0.009 0.025
scl(_):(__) -0.003 -0.002 0.004 0.003 -0.006fully_trained_clip_effect <- fit_image_model(looking_data_summarized)
summary(fully_trained_clip_effect)Linear mixed model fit by REML. t-tests use Satterthwaite's method [
lmerModLmerTest]
Formula:
scale(corrected_target_looking) ~ scale(image_similarity) * scale(age_in_months) +
scale(AoA_Est_target) + scale(MeanSaliencyDiff) + (1 | SubjectInfo.subjID) +
(1 | Trials.targetImage)
Data: mutate(summary_data, age_in_months = SubjectInfo.testAge/30)
REML criterion at convergence: 7009.3
Scaled residuals:
Min 1Q Median 3Q Max
-2.82154 -0.62402 -0.01811 0.67410 2.81296
Random effects:
Groups Name Variance Std.Dev.
SubjectInfo.subjID (Intercept) 0.017207 0.13118
Trials.targetImage (Intercept) 0.009785 0.09892
Residual 0.961620 0.98062
Number of obs: 2476, groups: SubjectInfo.subjID, 91; Trials.targetImage, 24
Fixed effects:
Estimate Std. Error df
(Intercept) -8.565e-03 3.185e-02 2.657e+01
scale(image_similarity) -4.591e-02 2.429e-02 1.146e+02
scale(age_in_months) 5.786e-02 2.406e-02 9.098e+01
scale(AoA_Est_target) -7.913e-02 2.886e-02 2.245e+01
scale(MeanSaliencyDiff) 6.125e-04 2.645e-02 3.581e+01
scale(image_similarity):scale(age_in_months) -2.562e-02 1.970e-02 2.385e+03
t value Pr(>|t|)
(Intercept) -0.269 0.7901
scale(image_similarity) -1.890 0.0612 .
scale(age_in_months) 2.405 0.0182 *
scale(AoA_Est_target) -2.742 0.0118 *
scale(MeanSaliencyDiff) 0.023 0.9817
scale(image_similarity):scale(age_in_months) -1.301 0.1935
---
Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
Correlation of Fixed Effects:
(Intr) scl(_) sc(__) s(AA_E s(MSD)
scl(mg_sml) -0.004
scl(g_n_mn) 0.003 -0.005
scl(AA_Es_) 0.011 -0.255 0.010
scl(MnSlnD) 0.021 0.029 -0.009 0.019
scl(_):(__) 0.000 -0.008 0.006 0.003 -0.010Plotting full lmer model values across epochs
library(dplyr)
library(MuMIn)
library(ggplot2)
library(patchwork) # for combining plots
Attaching package: 'patchwork'The following object is masked from 'package:cowplot':
align_plots# Define the epochs you want to analyze
epochs <- 1:33
# Initialize results storage
results <- data.frame(epoch = numeric(),
r2_marginal = numeric(),
corr_similarity_behavior = numeric())
common_cols <- intersect(colnames(looking_data_w_openclip), colnames(looking_data_summarized))
# Bind rows using only common columns, adding epoch = 33 to summarized data
looking_data_w_openclip_clip <- looking_data_w_openclip %>%
bind_rows(
looking_data_summarized %>%
mutate(epoch = 33) %>%
select(all_of(common_cols), epoch)
)
# Loop over epochs
for (e in epochs) {
df <- looking_data_w_openclip_clip |> filter(epoch == e)
# Skip if not enough data
if (nrow(df) < 10) next
# Fit model (update to your exact model formula if needed)
model <- fit_image_model(df)
# Extract marginal R²
r2 <- tryCatch(r.squaredGLMM(model)[1, "R2m"], error = function(e) NA)
# Compute Pearson correlation between image similarity and behavior
coefs <- summary(model)$coefficients
p_val <- NA
if ("scale(image_similarity)" %in% rownames(coefs)) {
p_val <- coefs["scale(image_similarity)", "Pr(>|t|)"]
}
# Store results
results <- rbind(results, data.frame(epoch = e,
r2_marginal = r2,
p_value = p_val))
}
# Plot R²
plot_r2 <- ggplot(results, aes(x = epoch, y = r2_marginal)) +
geom_smooth(color = "steelblue", size = 1.2) +
geom_point(size = 2) +
labs(title = "Marginal R² of image similarity LMER vs. CLIP Epoch",
x = "Epoch",
y = "Marginal R²") +
theme_minimal()
# Plot correlation
plot_corr <- ggplot(results, aes(x = epoch, y = p_value)) +
geom_smooth(color = "firebrick", size = 1.2) +
geom_point(size = 2) +
geom_hline(yintercept = 0.05, linetype = "dotted", color = "gray40") +
annotate("text", x = max(results$epoch), y = 0.055,
label = "p = 0.05", hjust = 4, vjust = 0, size = 4, color = "gray40") +
labs(title = "p-value of image similarity in full LMER vs. CLIP epoch",
x = "Epoch",
y = "p-value") +
theme_minimal()
# Combine and display
plot_r2 / plot_corr`geom_smooth()` using method = 'loess' and formula = 'y ~ x'`geom_smooth()` using method = 'loess' and formula = 'y ~ x'
Looking time across epochs
epoch_model <- lmer(
scale(corrected_target_looking) ~
scale(image_similarity) * scale(epoch) +
scale(age_in_months) +
scale(AoA_Est_target) +
scale(MeanSaliencyDiff) +
(1 | SubjectInfo.subjID) +
(1 | Trials.targetImage) +
(1 | Trials.imagePair),
data = looking_data_w_openclip_clip |>
mutate(age_in_months = SubjectInfo.testAge / 30)
)
summary(epoch_model)Linear mixed model fit by REML. t-tests use Satterthwaite's method [
lmerModLmerTest]
Formula:
scale(corrected_target_looking) ~ scale(image_similarity) * scale(epoch) +
scale(age_in_months) + scale(AoA_Est_target) + scale(MeanSaliencyDiff) +
(1 | SubjectInfo.subjID) + (1 | Trials.targetImage) + (1 |
Trials.imagePair)
Data:
mutate(looking_data_w_openclip_clip, age_in_months = SubjectInfo.testAge/30)
REML criterion at convergence: 225194.3
Scaled residuals:
Min 1Q Median 3Q Max
-3.0236 -0.6281 -0.0126 0.6838 3.1906
Random effects:
Groups Name Variance Std.Dev.
SubjectInfo.subjID (Intercept) 0.05218 0.2284
Trials.targetImage (Intercept) 0.02820 0.1679
Trials.imagePair (Intercept) 0.01562 0.1250
Residual 0.91538 0.9568
Number of obs: 81708, groups:
SubjectInfo.subjID, 91; Trials.targetImage, 24; Trials.imagePair, 16
Fixed effects:
Estimate Std. Error df t value
(Intercept) -1.973e-02 5.235e-02 4.227e+01 -0.377
scale(image_similarity) -1.372e-03 6.505e-03 3.843e+04 -0.211
scale(epoch) 2.719e-04 3.714e-03 8.051e+04 0.073
scale(age_in_months) 5.515e-02 2.404e-02 8.906e+01 2.294
scale(AoA_Est_target) -6.191e-02 3.391e-02 1.954e+01 -1.826
scale(MeanSaliencyDiff) 1.300e-02 2.628e-02 2.563e+01 0.494
scale(image_similarity):scale(epoch) -4.642e-04 3.581e-03 7.033e+04 -0.130
Pr(>|t|)
(Intercept) 0.7082
scale(image_similarity) 0.8330
scale(epoch) 0.9416
scale(age_in_months) 0.0241 *
scale(AoA_Est_target) 0.0832 .
scale(MeanSaliencyDiff) 0.6252
scale(image_similarity):scale(epoch) 0.8969
---
Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
Correlation of Fixed Effects:
(Intr) scl(_) scl(p) sc(__) s(AA_E s(MSD)
scl(mg_sml) -0.016
scale(epch) 0.000 -0.326
scl(g_n_mn) 0.006 0.000 0.000
scl(AA_Es_) 0.011 -0.001 0.000 0.000
scl(MnSlnD) 0.023 0.010 -0.003 0.000 -0.025
scl(mg_):() -0.023 0.669 -0.007 0.000 -0.001 0.008r.squaredGLMM(epoch_model) R2m R2c
[1,] 0.007045641 0.1013007Additional models
create_model_plots <- function(input_similarities, median_age, name="CVCL") {
similarities_combined <- input_similarities |>
rename(word_a = word1, word_b = word2) |>
bind_rows(
input_similarities |>
rename(word_a = word2, word_b = word1)
)
looking_data_w_model <- looking_data_summarized |>
select(-text_similarity, -multimodal_similarity, -image_similarity) |>
left_join(similarities_combined, by = c("Trials.distractorImage"="word_a", "Trials.targetImage"="word_b"))
data_summarized <- summarize_similarity_data(looking_data_w_model)
age_half_summarized <- looking_data_w_model |>
add_age_split() |>
summarize_similarity_data(extra_fields = c("age_half"))
p <- generate_multimodal_plots(data_summarized, name)
return(list(
plot = p,
data = looking_data_w_model
))
}CVCL
cvcl_similarities word1 word2 image_similarity text_similarity multimodal_similarity
1 turkey swan 0.17444706 0.02558377 0.13672301
2 turtle horse 0.17161047 0.12650073 0.08804899
3 cheese mud 0.12267336 0.04901435 -0.03633275
4 squirrel eagle 0.22197309 0.17859630 0.20261563
5 potato glasses 0.15317366 0.07150085 0.11340694
6 bulldozer orange -0.02197811 0.02320719 -0.03731379
7 snail cow -0.02817563 0.03850634 -0.04224624
8 acorn key 0.19834010 0.13790375 0.22495553
9 turkey goat 0.15390062 0.25035784 0.15649948
10 turtle frog 0.30299562 -0.05592079 0.02503634
11 cheese butter 0.35650474 0.10390703 0.08898249
12 squirrel monkey 0.34328401 0.04259083 0.20561886
13 potato pot 0.06314112 -0.02086087 0.06438187
14 bulldozer tractor 0.43432832 0.10392722 0.32970104
15 snail worm 0.07686698 0.13534546 0.05373919
16 acorn coconut 0.34766978 1.00000012 0.69287187
17 turkey swan 0.17444706 0.02558377 0.13672301
18 turtle horse 0.17161047 0.12650073 0.08804899
19 cheese mud 0.12267336 0.04901435 -0.03633275
20 squirrel eagle 0.22197309 0.17859630 0.20261563
21 potato glasses 0.15317366 0.07150085 0.11340694
22 bulldozer orange -0.02197811 0.02320719 -0.03731379
23 snail cow -0.02817563 0.03850634 -0.04224624
24 acorn key 0.19834010 0.13790375 0.22495553
25 turkey goat 0.15390062 0.25035784 0.15649948
26 turtle frog 0.30299562 -0.05592079 0.02503634
27 cheese butter 0.35650474 0.10390703 0.08898249
28 squirrel monkey 0.34328401 0.04259083 0.20561886
29 potato pot 0.06314112 -0.02086087 0.06438187
30 bulldozer tractor 0.43432832 0.10392722 0.32970104
31 snail worm 0.07686698 0.13534546 0.05373919
32 acorn coconut 0.34766978 1.00000012 0.69287187cvcl_summary <- create_model_plots(cvcl_similarities, name="CVCL", median_age=input_median_age)Warning in left_join(select(looking_data_summarized, -text_similarity, -multimodal_similarity, : Detected an unexpected many-to-many relationship between `x` and `y`.
ℹ Row 1 of `x` matches multiple rows in `y`.
ℹ Row 6 of `y` matches multiple rows in `x`.
ℹ If a many-to-many relationship is expected, set `relationship =
"many-to-many"` to silence this warning.Registered S3 methods overwritten by 'broom':
method from
nobs.fitdistr MuMIn
nobs.multinom MuMIn`geom_smooth()` using formula = 'y ~ x'
`geom_smooth()` using formula = 'y ~ x'
`geom_smooth()` using formula = 'y ~ x'Warning: ggrepel: 60 unlabeled data points (too many overlaps). Consider
increasing max.overlapsWarning: ggrepel: 56 unlabeled data points (too many overlaps). Consider
increasing max.overlapsWarning: ggrepel: 60 unlabeled data points (too many overlaps). Consider
increasing max.overlapsimagenet_vit_summary <- create_model_plots(imagenetvit_similarities, name="ImageNetVIT", median_age=input_median_age)`geom_smooth()` using formula = 'y ~ x'Warning: ggrepel: 4 unlabeled data points (too many overlaps). Consider
increasing max.overlapssaycamvit_summary <- create_model_plots(saycamvit_similarities, name="SayCamVIT",median_age=input_median_age)`geom_smooth()` using formula = 'y ~ x'Warning: ggrepel: 7 unlabeled data points (too many overlaps). Consider
increasing max.overlapscvcl_model <- fit_image_model(cvcl_summary$data)
summary(cvcl_model)Linear mixed model fit by REML. t-tests use Satterthwaite's method [
lmerModLmerTest]
Formula:
scale(corrected_target_looking) ~ scale(image_similarity) * scale(age_in_months) +
scale(AoA_Est_target) + scale(MeanSaliencyDiff) + (1 | SubjectInfo.subjID) +
(1 | Trials.targetImage)
Data: mutate(summary_data, age_in_months = SubjectInfo.testAge/30)
REML criterion at convergence: 13912.5
Scaled residuals:
Min 1Q Median 3Q Max
-2.92934 -0.62674 -0.02029 0.67233 2.95343
Random effects:
Groups Name Variance Std.Dev.
SubjectInfo.subjID (Intercept) 0.03494 0.1869
Trials.targetImage (Intercept) 0.01582 0.1258
Residual 0.94062 0.9699
Number of obs: 4952, groups: SubjectInfo.subjID, 91; Trials.targetImage, 24
Fixed effects:
Estimate Std. Error df
(Intercept) -1.464e-02 3.544e-02 3.817e+01
scale(image_similarity) -9.371e-03 2.048e-02 1.640e+02
scale(age_in_months) 5.670e-02 2.393e-02 9.002e+01
scale(AoA_Est_target) -8.775e-02 2.880e-02 2.194e+01
scale(MeanSaliencyDiff) 6.229e-03 2.403e-02 5.537e+01
scale(image_similarity):scale(age_in_months) -1.591e-02 1.376e-02 4.859e+03
t value Pr(>|t|)
(Intercept) -0.413 0.68175
scale(image_similarity) -0.458 0.64786
scale(age_in_months) 2.369 0.01997 *
scale(AoA_Est_target) -3.047 0.00592 **
scale(MeanSaliencyDiff) 0.259 0.79641
scale(image_similarity):scale(age_in_months) -1.157 0.24752
---
Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
Correlation of Fixed Effects:
(Intr) scl(_) sc(__) s(AA_E s(MSD)
scl(mg_sml) 0.002
scl(g_n_mn) 0.005 -0.007
scl(AA_Es_) 0.012 -0.182 0.006
scl(MnSlnD) 0.025 0.115 -0.007 0.012
scl(_):(__) -0.001 0.003 0.010 0.003 -0.004cvcl_summary$plotWarning: ggrepel: 60 unlabeled data points (too many overlaps). Consider
increasing max.overlapsWarning: ggrepel: 62 unlabeled data points (too many overlaps). Consider increasing max.overlaps
ggrepel: 62 unlabeled data points (too many overlaps). Consider increasing max.overlaps
SayCAM-VIT
saycamvit_model <- fit_image_model(saycamvit_summary$data)
summary(saycamvit_model)Linear mixed model fit by REML. t-tests use Satterthwaite's method [
lmerModLmerTest]
Formula:
scale(corrected_target_looking) ~ scale(image_similarity) * scale(age_in_months) +
scale(AoA_Est_target) + scale(MeanSaliencyDiff) + (1 | SubjectInfo.subjID) +
(1 | Trials.targetImage)
Data: mutate(summary_data, age_in_months = SubjectInfo.testAge/30)
REML criterion at convergence: 7007.2
Scaled residuals:
Min 1Q Median 3Q Max
-2.8292 -0.6194 -0.0167 0.6710 2.8328
Random effects:
Groups Name Variance Std.Dev.
SubjectInfo.subjID (Intercept) 0.01728 0.1315
Trials.targetImage (Intercept) 0.01008 0.1004
Residual 0.96066 0.9801
Number of obs: 2476, groups: SubjectInfo.subjID, 91; Trials.targetImage, 24
Fixed effects:
Estimate Std. Error df
(Intercept) -9.100e-03 3.205e-02 2.673e+01
scale(image_similarity) -2.098e-02 2.573e-02 7.299e+01
scale(age_in_months) 5.751e-02 2.407e-02 9.096e+01
scale(AoA_Est_target) -8.641e-02 2.926e-02 2.267e+01
scale(MeanSaliencyDiff) 1.293e-03 2.659e-02 3.654e+01
scale(image_similarity):scale(age_in_months) -5.101e-02 1.976e-02 2.383e+03
t value Pr(>|t|)
(Intercept) -0.284 0.7786
scale(image_similarity) -0.815 0.4175
scale(age_in_months) 2.390 0.0189 *
scale(AoA_Est_target) -2.953 0.0072 **
scale(MeanSaliencyDiff) 0.049 0.9615
scale(image_similarity):scale(age_in_months) -2.582 0.0099 **
---
Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
Correlation of Fixed Effects:
(Intr) scl(_) sc(__) s(AA_E s(MSD)
scl(mg_sml) -0.002
scl(g_n_mn) 0.003 -0.004
scl(AA_Es_) 0.010 -0.279 0.010
scl(MnSlnD) 0.021 0.028 -0.009 0.018
scl(_):(__) 0.003 0.008 0.006 0.000 -0.002saycamvit_summary$plotWarning: ggrepel: 29 unlabeled data points (too many overlaps). Consider
increasing max.overlaps
ImageNet-VIT
imagenet_vit_model <- fit_image_model(imagenet_vit_summary$data)
summary(imagenet_vit_model)Linear mixed model fit by REML. t-tests use Satterthwaite's method [
lmerModLmerTest]
Formula:
scale(corrected_target_looking) ~ scale(image_similarity) * scale(age_in_months) +
scale(AoA_Est_target) + scale(MeanSaliencyDiff) + (1 | SubjectInfo.subjID) +
(1 | Trials.targetImage)
Data: mutate(summary_data, age_in_months = SubjectInfo.testAge/30)
REML criterion at convergence: 7010.3
Scaled residuals:
Min 1Q Median 3Q Max
-2.82125 -0.62190 -0.02172 0.66775 2.83401
Random effects:
Groups Name Variance Std.Dev.
SubjectInfo.subjID (Intercept) 0.01724 0.1313
Trials.targetImage (Intercept) 0.01031 0.1015
Residual 0.96184 0.9807
Number of obs: 2476, groups: SubjectInfo.subjID, 91; Trials.targetImage, 24
Fixed effects:
Estimate Std. Error df
(Intercept) -9.089e-03 3.220e-02 2.645e+01
scale(image_similarity) -1.220e-02 2.618e-02 4.980e+01
scale(age_in_months) 5.747e-02 2.407e-02 9.098e+01
scale(AoA_Est_target) -9.012e-02 2.884e-02 2.157e+01
scale(MeanSaliencyDiff) 1.361e-03 2.673e-02 3.600e+01
scale(image_similarity):scale(age_in_months) -3.926e-02 1.978e-02 2.384e+03
t value Pr(>|t|)
(Intercept) -0.282 0.77998
scale(image_similarity) -0.466 0.64320
scale(age_in_months) 2.388 0.01900 *
scale(AoA_Est_target) -3.124 0.00501 **
scale(MeanSaliencyDiff) 0.051 0.95968
scale(image_similarity):scale(age_in_months) -1.985 0.04728 *
---
Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
Correlation of Fixed Effects:
(Intr) scl(_) sc(__) s(AA_E s(MSD)
scl(mg_sml) -0.002
scl(g_n_mn) 0.003 -0.003
scl(AA_Es_) 0.010 -0.199 0.009
scl(MnSlnD) 0.021 0.039 -0.009 0.019
scl(_):(__) 0.003 0.001 0.008 -0.002 -0.001imagenet_vit_summary$plotWarning: ggrepel: 30 unlabeled data points (too many overlaps). Consider
increasing max.overlaps
With both SayCAM VIT and ImageNet VIT we do see this interesting interaction between age and similarity, where the influence of similarity decreases with age.
comparing similarity values across our measures
library(dplyr)
library(GGally)Registered S3 method overwritten by 'GGally':
method from
+.gg ggplot2library(ggplot2)
# Join all similarity datasets with trial metadata
combined_data <- cvcl_similarities %>%
# Join with imagenetvit similarities
left_join(imagenetvit_similarities,
by = c("word1", "word2"),
suffix = c("_cvcl", "_imagenetvit")) %>%
# Join with saycamvit similarities
left_join(saycamvit_similarities,
by = c("word1", "word2")) %>%
rename(image_similarity_saycamvit = image_similarity) %>%
# Join with openclip epoch 32
left_join(openclip_similarities %>% filter(epoch == 32),
by = c("word1", "word2")) %>%
rename(image_similarity_openclip32 = image_similarity) %>%
# Join with openclip epoch 3
left_join(openclip_similarities %>% filter(epoch == 3),
by = c("word1", "word2")) %>%
rename(image_similarity_openclip3 = image_similarity) %>%
# Join with trial metadata to get saliency diff and clip_sim
left_join(trial_metadata %>%
distinct(Trials.imagePair, .keep_all = TRUE) %>%
# Create word1/word2 columns from target/distractor images
mutate(word1 = Trials.targetImage,
word2 = Trials.distractorImage) %>%
select(word1, word2, MeanSaliencyDiff, image_similarity),
by = c("word1", "word2")) %>%
rename(clip_sim = image_similarity) %>%
distinct(word1, word2, .keep_all = TRUE) |>
# Select and rename the six variables for visualization
select(
cvcl_sim = image_similarity_cvcl,
imagenetvit_sim = image_similarity_imagenetvit,
saycamvit_sim = image_similarity_saycamvit,
openclip_epoch3_sim = image_similarity_openclip3,
openclip_epoch32_sim = image_similarity_openclip32,
mean_saliency_diff = MeanSaliencyDiff,
clip_sim = clip_sim,
word1 = word1,
word2 = word2
)
ggplot(combined_data, aes(x=clip_sim, y=openclip_epoch3_sim)) +
geom_point(size=3)+
ggrepel::geom_label_repel(aes(label=paste0(word1, "-", word2))) +
ggpubr::stat_cor() +
geom_smooth(method="lm")Warning: Removed 8 rows containing non-finite outside the scale range
(`stat_cor()`).`geom_smooth()` using formula = 'y ~ x'Warning: Removed 8 rows containing non-finite outside the scale range
(`stat_smooth()`).Warning: Removed 8 rows containing missing values or values outside the scale range
(`geom_point()`).Warning: Removed 8 rows containing missing values or values outside the scale range
(`geom_label_repel()`).
Correlation matrices
# Create ggpairs plot
similarity_plot <- ggpairs(
combined_data,
columns = c("cvcl_sim", "imagenetvit_sim", "saycamvit_sim",
"openclip_epoch3_sim", "openclip_epoch32_sim",
"mean_saliency_diff", "clip_sim"),
title = "Correlations Between Different Similarity Measures")
ggsave("similarity_correlations.png", similarity_plot,
width = 16, height = 12, dpi = 300, bg = "white")Warning in ggally_statistic(data = data, mapping = mapping, na.rm = na.rm, :
Removed 8 rows containing missing values
Warning in ggally_statistic(data = data, mapping = mapping, na.rm = na.rm, :
Removed 8 rows containing missing values
Warning in ggally_statistic(data = data, mapping = mapping, na.rm = na.rm, :
Removed 8 rows containing missing values
Warning in ggally_statistic(data = data, mapping = mapping, na.rm = na.rm, :
Removed 8 rows containing missing values
Warning in ggally_statistic(data = data, mapping = mapping, na.rm = na.rm, :
Removed 8 rows containing missing values
Warning in ggally_statistic(data = data, mapping = mapping, na.rm = na.rm, :
Removed 8 rows containing missing values
Warning in ggally_statistic(data = data, mapping = mapping, na.rm = na.rm, :
Removed 8 rows containing missing values
Warning in ggally_statistic(data = data, mapping = mapping, na.rm = na.rm, :
Removed 8 rows containing missing values
Warning in ggally_statistic(data = data, mapping = mapping, na.rm = na.rm, :
Removed 8 rows containing missing values
Warning in ggally_statistic(data = data, mapping = mapping, na.rm = na.rm, :
Removed 8 rows containing missing valuesWarning: Removed 8 rows containing missing values or values outside the scale range
(`geom_point()`).
Removed 8 rows containing missing values or values outside the scale range
(`geom_point()`).
Removed 8 rows containing missing values or values outside the scale range
(`geom_point()`).
Removed 8 rows containing missing values or values outside the scale range
(`geom_point()`).
Removed 8 rows containing missing values or values outside the scale range
(`geom_point()`).Warning: Removed 8 rows containing non-finite outside the scale range
(`stat_density()`).Warning in ggally_statistic(data = data, mapping = mapping, na.rm = na.rm, :
Removed 8 rows containing missing valuesWarning: Removed 8 rows containing missing values or values outside the scale range
(`geom_point()`).
Removed 8 rows containing missing values or values outside the scale range
(`geom_point()`).
Removed 8 rows containing missing values or values outside the scale range
(`geom_point()`).
Removed 8 rows containing missing values or values outside the scale range
(`geom_point()`).
Removed 8 rows containing missing values or values outside the scale range
(`geom_point()`).
Removed 8 rows containing missing values or values outside the scale range
(`geom_point()`).Warning: Removed 8 rows containing non-finite outside the scale range
(`stat_density()`).# Display the plot
print(similarity_plot)Warning in ggally_statistic(data = data, mapping = mapping, na.rm = na.rm, :
Removed 8 rows containing missing valuesWarning in ggally_statistic(data = data, mapping = mapping, na.rm = na.rm, :
Removed 8 rows containing missing values
Warning in ggally_statistic(data = data, mapping = mapping, na.rm = na.rm, :
Removed 8 rows containing missing values
Warning in ggally_statistic(data = data, mapping = mapping, na.rm = na.rm, :
Removed 8 rows containing missing values
Warning in ggally_statistic(data = data, mapping = mapping, na.rm = na.rm, :
Removed 8 rows containing missing values
Warning in ggally_statistic(data = data, mapping = mapping, na.rm = na.rm, :
Removed 8 rows containing missing values
Warning in ggally_statistic(data = data, mapping = mapping, na.rm = na.rm, :
Removed 8 rows containing missing values
Warning in ggally_statistic(data = data, mapping = mapping, na.rm = na.rm, :
Removed 8 rows containing missing values
Warning in ggally_statistic(data = data, mapping = mapping, na.rm = na.rm, :
Removed 8 rows containing missing values
Warning in ggally_statistic(data = data, mapping = mapping, na.rm = na.rm, :
Removed 8 rows containing missing valuesWarning: Removed 8 rows containing missing values or values outside the scale range
(`geom_point()`).
Removed 8 rows containing missing values or values outside the scale range
(`geom_point()`).
Removed 8 rows containing missing values or values outside the scale range
(`geom_point()`).
Removed 8 rows containing missing values or values outside the scale range
(`geom_point()`).
Removed 8 rows containing missing values or values outside the scale range
(`geom_point()`).Warning: Removed 8 rows containing non-finite outside the scale range
(`stat_density()`).Warning in ggally_statistic(data = data, mapping = mapping, na.rm = na.rm, :
Removed 8 rows containing missing valuesWarning: Removed 8 rows containing missing values or values outside the scale range
(`geom_point()`).
Removed 8 rows containing missing values or values outside the scale range
(`geom_point()`).
Removed 8 rows containing missing values or values outside the scale range
(`geom_point()`).
Removed 8 rows containing missing values or values outside the scale range
(`geom_point()`).
Removed 8 rows containing missing values or values outside the scale range
(`geom_point()`).
Removed 8 rows containing missing values or values outside the scale range
(`geom_point()`).Warning: Removed 8 rows containing non-finite outside the scale range
(`stat_density()`).
# Print correlation matrix
cat("Correlation matrix:\n")Correlation matrix:cor_matrix <- cor(combined_data |> select(-word1, -word2), use = "complete.obs")
print(round(cor_matrix, 3)) cvcl_sim imagenetvit_sim saycamvit_sim openclip_epoch3_sim
cvcl_sim 1.000 0.775 0.791 0.599
imagenetvit_sim 0.775 1.000 0.919 0.401
saycamvit_sim 0.791 0.919 1.000 0.560
openclip_epoch3_sim 0.599 0.401 0.560 1.000
openclip_epoch32_sim 0.299 0.386 0.499 0.864
mean_saliency_diff 0.551 0.563 0.703 0.288
clip_sim 0.539 0.460 0.517 0.849
openclip_epoch32_sim mean_saliency_diff clip_sim
cvcl_sim 0.299 0.551 0.539
imagenetvit_sim 0.386 0.563 0.460
saycamvit_sim 0.499 0.703 0.517
openclip_epoch3_sim 0.864 0.288 0.849
openclip_epoch32_sim 1.000 0.050 0.858
mean_saliency_diff 0.050 1.000 0.044
clip_sim 0.858 0.044 1.000DevBench
clip_data <- read.csv("clip_data.csv")
openclip_data <- read.csv("openclip.csv")
# Assuming looking_data_summarized is already loaded
# Prepare human data for compare_lwl function
# The compare_lwl function expects human data with 'prop' and 'age_bin' columns
human_data_lwl <- trialid_level_summary %>%
arrange(Trials.targetImage, Trials.distractorImage) %>%
mutate(prop = mean_value + 0.5) %>%
mutate(trial = row_number()) %>%
transmute(prop, age_bin="14-24", trial) # Add other columns as needed
# Function to compare model with human data
compare_lwl <- function(model_data, human_data) {
model_data_correct <- model_data %>%
mutate(correct = image1 > image2)
human_data_nested <- human_data %>%
rename(image1 = prop) %>%
mutate(image2 = 1 - image1) %>%
nest(data = -age_bin) |>
mutate(opt_kl = lapply(data, function(d) get_opt_kl(d, model_data_correct)),
kl = sapply(opt_kl, function(r) r$objective),
beta = sapply(opt_kl, function(r) r$solution),
iters = sapply(opt_kl, function(r) r$iterations),
accuracy = mean(model_data_correct$correct, na.rm = TRUE)) %>%
select(-opt_kl, -data)
return(human_data_nested)
}
# Function to process model similarity data
process_model_data <- function(data, similarity_col, model_name, calc_kl=TRUE) {
# Parse comma-separated similarity values
similarity_pairs <- strsplit(data[[similarity_col]], ",")
# Convert to numeric and create data frame
res <- data.frame(
image1 = sapply(similarity_pairs, function(x) as.numeric(trimws(x[1]))),
image2 = sapply(similarity_pairs, function(x) as.numeric(trimws(x[2]))),
trial = seq_along(similarity_pairs)
)
# Calculate accuracy (assuming image1 corresponds to target, image2 to distractor)
acc <- res %>%
mutate(correct = image1 > image2) %>%
summarise(accuracy = mean(correct, na.rm = TRUE)) %>%
pull(accuracy)
if (calc_kl) {
# Compare with human data
kls <- compare_lwl(res, human_data_lwl) %>%
mutate(model = model_name,
accuracy = acc)
return(kls)
} else {
return (res)
}
}
clip_results <- process_model_data(clip_data |> arrange(target, distractor) |> mutate(trial=row_number()), "multimodal_similarity", "CLIP")
clip_results# A tibble: 1 × 6
age_bin kl beta iters accuracy model
<chr> <dbl> <dbl> <int> <dbl> <chr>
1 14-24 0.00937 0.0251 75 0.969 CLIP openclip
openclip_data <- read.csv("openclip.csv")
openclip_div_lwl <- openclip_data %>%
group_by(epoch) %>%
group_split() %>%
map_dfr(function(epoch_data) {
current_epoch <- unique(epoch_data$epoch)
# Process this epoch's data
epoch_results <- process_model_data(epoch_data |> arrange(word1, word2), "multimodal_similarity", paste0("OpenCLIP_epoch_", current_epoch))
# Add epoch information
epoch_results %>%
mutate(epoch = current_epoch)
})
lwl_oc <- ggplot(openclip_div_lwl |> rowwise() |> mutate(epoch = unique_checkpoints[[epoch]]),
aes(x = log(epoch), y = kl, col = as.factor(age_bin))) +
theme_classic() +
geom_point() +
geom_smooth(span = 1) +#, method = "lm") +
# scale_colour_continuous() +
# theme_classic() +
labs(x = "log(Epoch)",
y = TeX("Model–human dissimilarity ($D^*_{KL}$)"),
col = "Age") +
guides(colour = guide_legend(position = "inside")) +
coord_cartesian(ylim = c(0, 0.02)) +
theme(legend.position.inside = c(0.9, 0.8))
lwl_oc`geom_smooth()` using method = 'loess' and formula = 'y ~ x'
compare_lwl(human_data_lwl |> mutate(image1=prop, image2=1-prop), human_data_lwl)# A tibble: 1 × 5
age_bin kl beta iters accuracy
<chr> <dbl> <dbl> <int> <dbl>
1 14-24 0.00000474 2.03 29 0.719Quantifying multimodal accuracy?
multimodal_sim_vals <- cbind(trialid_level_summary |> arrange(Trials.targetImage, Trials.distractorImage), softmax_images(process_model_data(clip_data, "multimodal_similarity", "CLIP", calc_kl = FALSE), clip_results$beta) |> transmute(mm_acc = image1))
ggplot(multimodal_sim_vals |> filter(mm_acc > 0.5), aes(x=mm_acc, y=mean_value+0.5)) +
theme_classic() +
geom_point() +
geom_smooth(method="lm") +
ggpubr::stat_cor()`geom_smooth()` using formula = 'y ~ x'
looking_data_summarized <- looking_data_summarized |> left_join(multimodal_sim_vals |> select(Trials.targetImage, Trials.distractorImage, mm_acc))Joining with `by = join_by(Trials.targetImage, Trials.distractorImage)`Thinking more about this, this is the wrong way of going about this since the beta is optimizing KL divergence and not accuracy per se.
mm_acc_model <- lmer(
scale(corrected_target_looking+0.5) ~
scale(mm_acc) * scale(age_in_months) +
scale(AoA_Est_target) +
scale(MeanSaliencyDiff) +
(1 | SubjectInfo.subjID) +
(1 | Trials.targetImage),
data = looking_data_summarized |>
mutate(age_in_months = SubjectInfo.testAge / 30)
)
summary(mm_acc_model)Linear mixed model fit by REML. t-tests use Satterthwaite's method [
lmerModLmerTest]
Formula:
scale(corrected_target_looking + 0.5) ~ scale(mm_acc) * scale(age_in_months) +
scale(AoA_Est_target) + scale(MeanSaliencyDiff) + (1 | SubjectInfo.subjID) +
(1 | Trials.targetImage)
Data:
mutate(looking_data_summarized, age_in_months = SubjectInfo.testAge/30)
REML criterion at convergence: 7013.1
Scaled residuals:
Min 1Q Median 3Q Max
-2.85595 -0.62309 -0.01738 0.66754 2.82580
Random effects:
Groups Name Variance Std.Dev.
SubjectInfo.subjID (Intercept) 0.017056 0.13060
Trials.targetImage (Intercept) 0.009987 0.09994
Residual 0.963154 0.98140
Number of obs: 2476, groups: SubjectInfo.subjID, 91; Trials.targetImage, 24
Fixed effects:
Estimate Std. Error df t value
(Intercept) -8.531e-03 3.197e-02 2.618e+01 -0.267
scale(mm_acc) -1.052e-02 2.444e-02 8.285e+01 -0.430
scale(age_in_months) 5.779e-02 2.403e-02 9.108e+01 2.404
scale(AoA_Est_target) -9.450e-02 2.829e-02 2.145e+01 -3.340
scale(MeanSaliencyDiff) 1.616e-03 2.657e-02 3.617e+01 0.061
scale(mm_acc):scale(age_in_months) 2.229e-02 1.974e-02 2.388e+03 1.129
Pr(>|t|)
(Intercept) 0.79169
scale(mm_acc) 0.66804
scale(age_in_months) 0.01823 *
scale(AoA_Est_target) 0.00304 **
scale(MeanSaliencyDiff) 0.95182
scale(mm_acc):scale(age_in_months) 0.25889
---
Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
Correlation of Fixed Effects:
(Intr) scl(_) sc(__) s(AA_E s(MSD)
scal(mm_cc) -0.018
scl(g_n_mn) 0.003 -0.001
scl(AA_Es_) 0.008 0.130 0.008
scl(MnSlnD) 0.020 0.026 -0.009 0.030
scl(_):(__) 0.001 0.007 -0.001 0.002 0.005```