1. Load Libraries & Data
library(readxl)
library(janitor)
##
## Attaching package: 'janitor'
## The following objects are masked from 'package:stats':
##
## chisq.test, fisher.test
library(tidyverse)
## ── Attaching core tidyverse packages ──────────────────────── tidyverse 2.0.0 ──
## ✔ dplyr 1.2.1 ✔ readr 2.2.0
## ✔ forcats 1.0.1 ✔ stringr 1.6.0
## ✔ ggplot2 4.0.3 ✔ tibble 3.3.1
## ✔ lubridate 1.9.5 ✔ tidyr 1.3.2
## ✔ purrr 1.2.2
## ── 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
library(lme4)
## Loading required package: Matrix
##
## Attaching package: 'Matrix'
##
## The following objects are masked from 'package:tidyr':
##
## expand, pack, unpack
library(lmerTest)
##
## Attaching package: 'lmerTest'
##
## The following object is masked from 'package:lme4':
##
## lmer
##
## The following object is masked from 'package:stats':
##
## step
library(glmmTMB)
## Warning in check_dep_version(dep_pkg = "TMB"): package version mismatch:
## glmmTMB was built with TMB package version 1.9.19
## Current TMB package version is 1.9.21
## Please re-install glmmTMB from source or restore original 'TMB' package (see '?reinstalling' for more information)
library(performance)
library(emmeans)
## Welcome to emmeans.
## Caution: You lose important information if you filter this package's results.
## See '? untidy'
df <- read_excel("~/Downloads/touch_data.xlsx", skip = 1) %>%
clean_names()
names(df)
## [1] "file" "subject_id"
## [3] "sex" "age"
## [5] "condition" "block"
## [7] "trial_ordinal" "exp"
## [9] "socinf" "item"
## [11] "trial_onset" "trial_offset"
## [13] "trial_duration_ms" "n_touches_total"
## [15] "n_touches_top" "n_touches_bottom"
## [17] "n_touches_screen_holder" "add_touch"
## [19] "ratio_top" "ratio_bottom"
## [21] "ratio_screen_holder" "first_touch_part"
## [23] "first_touch_onset" "latency_first_touch"
## [25] "first_top_touch_onset" "latency_first_top"
## [27] "total_touch_duration" "top_touch_duration"
head(df)
## # A tibble: 6 × 28
## file subject_id sex age condition block trial_ordinal exp socinf item
## <chr> <dbl> <chr> <chr> <chr> <dbl> <dbl> <chr> <chr> <chr>
## 1 D3_01… 15 fema… 16m … neutral 2 1 s a kn
## 2 D3_01… 15 fema… 16m … neutral 2 2 s a sn
## 3 D3_01… 15 fema… 16m … neutral 2 3 s a ge
## 4 D3_01… 15 fema… 16m … neutral 2 4 s a sa
## 5 D3_01… 15 fema… 16m … neutral 2 5 s a oa
## 6 D3_01… 15 fema… 16m … neutral 2 6 s a ba
## # ℹ 18 more variables: trial_onset <dbl>, trial_offset <dbl>,
## # trial_duration_ms <dbl>, n_touches_total <dbl>, n_touches_top <dbl>,
## # n_touches_bottom <dbl>, n_touches_screen_holder <dbl>, add_touch <dbl>,
## # ratio_top <dbl>, ratio_bottom <dbl>, ratio_screen_holder <dbl>,
## # first_touch_part <chr>, first_touch_onset <dbl>, latency_first_touch <dbl>,
## # first_top_touch_onset <dbl>, latency_first_top <dbl>,
## # total_touch_duration <dbl>, top_touch_duration <dbl>
2. Clean & Recode Variables
df_clean <- df %>%
mutate(
subject_id = as.factor(subject_id),
sex = as.factor(sex),
condition = as.factor(condition),
block = as.factor(block),
item = as.factor(item),
socinf = as.factor(socinf),
exp = as.factor(exp),
object_type = case_when(
str_detect(file, "D2") ~ "2D",
str_detect(file, "D3") ~ "3D",
TRUE ~ NA_character_
),
object_type = as.factor(object_type),
age_months = as.numeric(str_extract(age, "\\d+(?=m)")),
age_days = as.numeric(str_extract(age, "\\d+(?=d)")),
age_days = ifelse(is.na(age_days), 0, age_days),
age_numeric = age_months + age_days / 30.44,
n_top_touch = as.numeric(n_touches_top),
top_touch_duration = as.numeric(top_touch_duration),
top_touch_latency = as.numeric(latency_first_top),
log_top_duration = log(top_touch_duration + 1),
log_top_latency = log(top_touch_latency + 1)
)
names(df_clean)
## [1] "file" "subject_id"
## [3] "sex" "age"
## [5] "condition" "block"
## [7] "trial_ordinal" "exp"
## [9] "socinf" "item"
## [11] "trial_onset" "trial_offset"
## [13] "trial_duration_ms" "n_touches_total"
## [15] "n_touches_top" "n_touches_bottom"
## [17] "n_touches_screen_holder" "add_touch"
## [19] "ratio_top" "ratio_bottom"
## [21] "ratio_screen_holder" "first_touch_part"
## [23] "first_touch_onset" "latency_first_touch"
## [25] "first_top_touch_onset" "latency_first_top"
## [27] "total_touch_duration" "top_touch_duration"
## [29] "object_type" "age_months"
## [31] "age_days" "age_numeric"
## [33] "n_top_touch" "top_touch_latency"
## [35] "log_top_duration" "log_top_latency"
summary(df_clean)
## file subject_id sex age
## Length:805 41 : 17 female:409 Length:805
## Class :character 59 : 17 male :396 Class :character
## Mode :character 63 : 17 Mode :character
## 2 : 16
## 4 : 16
## 5 : 16
## (Other):706
## condition block trial_ordinal exp socinf item
## negative:356 2:404 Min. :1.000 k:378 a:434 bc : 52
## neutral :434 3:401 1st Qu.:2.000 s:427 p:371 ge : 52
## NA's : 15 Median :4.000 sc : 52
## Mean :4.453 gp : 51
## 3rd Qu.:6.000 oa : 51
## Max. :9.000 ro : 51
## (Other):496
## trial_onset trial_offset trial_duration_ms n_touches_total
## Min. : 11968 Min. : 17750 Min. : 4184 Min. : 0.00
## 1st Qu.: 75718 1st Qu.: 93706 1st Qu.: 5986 1st Qu.: 1.00
## Median :150212 Median :163644 Median :11290 Median : 3.00
## Mean :155201 Mean :171668 Mean :16467 Mean : 4.19
## 3rd Qu.:220524 3rd Qu.:237662 3rd Qu.:30000 3rd Qu.: 6.00
## Max. :439314 Max. :459828 Max. :42580 Max. :28.00
##
## n_touches_top n_touches_bottom n_touches_screen_holder add_touch
## Min. :0.00 Min. : 0.0000 Min. : 0.000 Min. :1.000
## 1st Qu.:0.00 1st Qu.: 0.0000 1st Qu.: 0.000 1st Qu.:1.000
## Median :1.00 Median : 0.0000 Median : 0.000 Median :1.000
## Mean :1.27 Mean : 0.8211 Mean : 2.099 Mean :1.147
## 3rd Qu.:2.00 3rd Qu.: 1.0000 3rd Qu.: 4.000 3rd Qu.:1.000
## Max. :9.00 Max. :11.0000 Max. :21.000 Max. :2.000
##
## ratio_top ratio_bottom ratio_screen_holder first_touch_part
## Min. :0.0000 Min. :0.0000 Min. :0.0000 Length:805
## 1st Qu.:0.1111 1st Qu.:0.0000 1st Qu.:0.0000 Class :character
## Median :0.3750 Median :0.0000 Median :0.0000 Mode :character
## Mean :0.4557 Mean :0.2094 Mean :0.3348
## 3rd Qu.:1.0000 3rd Qu.:0.3875 3rd Qu.:0.7143
## Max. :1.0000 Max. :1.0000 Max. :1.0000
## NA's :118 NA's :118 NA's :118
## first_touch_onset latency_first_touch first_top_touch_onset latency_first_top
## Min. : 12660 Min. : 0 Min. : 12750 Min. : 0
## 1st Qu.: 80739 1st Qu.: 476 1st Qu.: 85340 1st Qu.: 680
## Median :152388 Median : 987 Median :152388 Median : 1972
## Mean :157582 Mean : 3328 Mean :157727 Mean : 4964
## 3rd Qu.:221081 3rd Qu.: 2822 3rd Qu.:222156 3rd Qu.: 6360
## Max. :440164 Max. :31180 Max. :440164 Max. :37580
## NA's :118 NA's :118 NA's :268 NA's :268
## total_touch_duration top_touch_duration object_type age_months
## Min. :-203320 Min. : 0 3D:805 Min. : 1.00
## 1st Qu.: 2076 1st Qu.: 0 1st Qu.:14.00
## Median : 6052 Median : 816 Median :15.00
## Mean : 8987 Mean : 2456 Mean :14.65
## 3rd Qu.: 13090 3rd Qu.: 3332 3rd Qu.:15.00
## Max. : 88774 Max. :30702 Max. :16.00
##
## age_days age_numeric n_top_touch top_touch_latency
## Min. : 0.00 Min. : 1.394 Min. :0.00 Min. : 0
## 1st Qu.:10.00 1st Qu.:14.821 1st Qu.:0.00 1st Qu.: 680
## Median :20.00 Median :15.624 Median :1.00 Median : 1972
## Mean :17.36 Mean :15.216 Mean :1.27 Mean : 4964
## 3rd Qu.:25.00 3rd Qu.:15.986 3rd Qu.:2.00 3rd Qu.: 6360
## Max. :30.00 Max. :16.460 Max. :9.00 Max. :37580
## NA's :268
## log_top_duration log_top_latency
## Min. : 0.000 Min. : 0.000
## 1st Qu.: 0.000 1st Qu.: 6.524
## Median : 6.706 Median : 7.587
## Mean : 5.022 Mean : 7.379
## 3rd Qu.: 8.112 3rd Qu.: 8.758
## Max. :10.332 Max. :10.534
## NA's :268
df_clean <- df_clean %>%
mutate(
object_type = case_when(
block == 2 ~ "2D",
block == 3 ~ "3D",
block == "2" ~ "2D",
block == "3" ~ "3D",
TRUE ~ NA_character_
),
object_type = as.factor(object_type)
)
table(df_clean$block, df_clean$object_type, useNA = "ifany")
##
## 2D 3D
## 2 404 0
## 3 0 401
3. Linear Mixed Models
3a. Touch Duration Model
duration_model <- lmer(
log_top_duration ~ object_type * condition + object_type * age_numeric +
sex + trial_ordinal +
(1 | subject_id) + (1 | item),
data = df_clean,
na.action = na.omit
)
3b. Touch Latency Model
latency_model <- lmer(
log_top_latency ~ object_type * condition + object_type * age_numeric +
sex + trial_ordinal +
(1 | subject_id) + (1 | item),
data = df_clean,
na.action = na.omit
)
3c. Touch Frequency Model (Negative Binomial)
frequency_model_nb <- glmmTMB(
n_top_touch ~ object_type * condition + object_type * age_numeric +
sex + trial_ordinal +
(1 | subject_id) + (1 | item),
data = df_clean,
family = nbinom2,
na.action = na.omit
)
3d. Full Model Summaries
# Duration
summary(duration_model)
## Linear mixed model fit by REML. t-tests use Satterthwaite's method [
## lmerModLmerTest]
## Formula:
## log_top_duration ~ object_type * condition + object_type * age_numeric +
## sex + trial_ordinal + (1 | subject_id) + (1 | item)
## Data: df_clean
##
## REML criterion at convergence: 4001.7
##
## Scaled residuals:
## Min 1Q Median 3Q Max
## -2.6363 -0.7025 0.1783 0.6669 2.4125
##
## Random effects:
## Groups Name Variance Std.Dev.
## subject_id (Intercept) 2.631 1.622
## item (Intercept) 1.038 1.019
## Residual 7.916 2.813
## Number of obs: 790, groups: subject_id, 51; item, 16
##
## Fixed effects:
## Estimate Std. Error df t value Pr(>|t|)
## (Intercept) 0.36008 2.04042 64.14977 0.176 0.86048
## object_type3D 6.75831 1.49436 720.90875 4.523 7.14e-06
## conditionneutral 0.10359 0.54247 62.69265 0.191 0.84917
## age_numeric 0.14758 0.13382 60.72320 1.103 0.27449
## sexmale 0.40998 0.50469 46.20402 0.812 0.42076
## trial_ordinal 0.13884 0.04381 721.67919 3.169 0.00159
## object_type3D:conditionneutral 1.15344 0.41039 728.55230 2.811 0.00508
## object_type3D:age_numeric -0.28659 0.09811 721.19630 -2.921 0.00360
##
## (Intercept)
## object_type3D ***
## conditionneutral
## age_numeric
## sexmale
## trial_ordinal **
## object_type3D:conditionneutral **
## object_type3D:age_numeric **
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## Correlation of Fixed Effects:
## (Intr) obj_3D cndtnn ag_nmr sexmal trl_rd ob_3D:
## objct_typ3D -0.366
## conditnntrl -0.022 0.011
## age_numeric -0.961 0.359 -0.126
## sexmale 0.030 -0.002 0.039 -0.158
## trial_ordnl -0.096 -0.002 -0.003 0.000 0.008
## objct_ty3D: 0.011 -0.024 -0.377 0.048 -0.014 -0.008
## objct_t3D:_ 0.358 -0.979 0.048 -0.366 0.006 0.004 -0.130
anova(duration_model)
## Type III Analysis of Variance Table with Satterthwaite's method
## Sum Sq Mean Sq NumDF DenDF F value Pr(>F)
## object_type 188.410 188.410 1 721.11 23.8020 1.315e-06 ***
## condition 14.515 14.515 1 46.30 1.8337 0.182263
## age_numeric 0.009 0.009 1 45.57 0.0012 0.972721
## sex 5.224 5.224 1 46.20 0.6599 0.420765
## trial_ordinal 79.492 79.492 1 721.68 10.0423 0.001594 **
## object_type:condition 62.530 62.530 1 728.55 7.8995 0.005078 **
## object_type:age_numeric 67.550 67.550 1 721.20 8.5336 0.003595 **
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
# Latency
summary(latency_model)
## Linear mixed model fit by REML. t-tests use Satterthwaite's method [
## lmerModLmerTest]
## Formula:
## log_top_latency ~ object_type * condition + object_type * age_numeric +
## sex + trial_ordinal + (1 | subject_id) + (1 | item)
## Data: df_clean
##
## REML criterion at convergence: 2162.4
##
## Scaled residuals:
## Min 1Q Median 3Q Max
## -3.9425 -0.3877 0.0790 0.5679 2.2863
##
## Random effects:
## Groups Name Variance Std.Dev.
## subject_id (Intercept) 1.200 1.0955
## item (Intercept) 0.238 0.4879
## Residual 2.988 1.7285
## Number of obs: 523, groups: subject_id, 51; item, 16
##
## Fixed effects:
## Estimate Std. Error df t value
## (Intercept) 10.989016 2.075739 212.415314 5.294
## object_type3D -4.137927 1.837938 463.498309 -2.251
## conditionneutral -0.016047 0.406134 68.917991 -0.040
## age_numeric -0.171963 0.134580 196.380186 -1.278
## sexmale -0.211370 0.354255 39.985716 -0.597
## trial_ordinal -0.056990 0.033733 461.028586 -1.689
## object_type3D:conditionneutral 0.008664 0.329197 477.008433 0.026
## object_type3D:age_numeric 0.218743 0.119255 464.993404 1.834
## Pr(>|t|)
## (Intercept) 2.98e-07 ***
## object_type3D 0.0248 *
## conditionneutral 0.9686
## age_numeric 0.2028
## sexmale 0.5541
## trial_ordinal 0.0918 .
## object_type3D:conditionneutral 0.9790
## object_type3D:age_numeric 0.0673 .
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## Correlation of Fixed Effects:
## (Intr) obj_3D cndtnn ag_nmr sexmal trl_rd ob_3D:
## objct_typ3D -0.763
## conditnntrl -0.042 0.038
## age_numeric -0.980 0.752 -0.072
## sexmale 0.022 -0.006 0.065 -0.116
## trial_ordnl -0.113 0.048 -0.001 0.036 0.018
## objct_ty3D: 0.033 -0.041 -0.490 0.024 -0.053 -0.008
## objct_t3D:_ 0.756 -0.991 0.010 -0.755 0.013 -0.045 -0.061
anova(latency_model)
## Type III Analysis of Variance Table with Satterthwaite's method
## Sum Sq Mean Sq NumDF DenDF F value Pr(>F)
## object_type 15.1025 15.1025 1 464.49 5.0551 0.02502 *
## condition 0.0032 0.0032 1 41.35 0.0011 0.97388
## age_numeric 1.2250 1.2250 1 63.66 0.4100 0.52425
## sex 1.0636 1.0636 1 39.99 0.3560 0.55410
## trial_ordinal 8.5270 8.5270 1 461.03 2.8542 0.09181 .
## object_type:condition 0.0021 0.0021 1 477.01 0.0007 0.97901
## object_type:age_numeric 10.0515 10.0515 1 464.99 3.3644 0.06726 .
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
# Frequency
summary(frequency_model_nb)
## Family: nbinom2 ( log )
## Formula:
## n_top_touch ~ object_type * condition + object_type * age_numeric +
## sex + trial_ordinal + (1 | subject_id) + (1 | item)
## Data: df_clean
##
## AIC BIC logLik -2*log(L) df.resid
## 2304.5 2355.9 -1141.3 2282.5 779
##
## Random effects:
##
## Conditional model:
## Groups Name Variance Std.Dev.
## subject_id (Intercept) 0.23875 0.4886
## item (Intercept) 0.05074 0.2252
## Number of obs: 790, groups: subject_id, 51; item, 16
##
## Dispersion parameter for nbinom2 family (): 7.24
##
## Conditional model:
## Estimate Std. Error z value Pr(>|z|)
## (Intercept) -1.799748 0.929133 -1.937 0.0527 .
## object_type3D 2.013127 0.841160 2.393 0.0167 *
## conditionneutral -0.008747 0.176957 -0.049 0.9606
## age_numeric 0.104467 0.060322 1.732 0.0833 .
## sexmale 0.084965 0.158249 0.537 0.5913
## trial_ordinal 0.021147 0.015508 1.364 0.1727
## object_type3D:conditionneutral 0.153916 0.143623 1.072 0.2839
## object_type3D:age_numeric -0.117476 0.054490 -2.156 0.0311 *
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
drop1(frequency_model_nb, test = "Chisq")
## Single term deletions
##
## Model:
## n_top_touch ~ object_type * condition + object_type * age_numeric +
## sex + trial_ordinal + (1 | subject_id) + (1 | item)
## Df AIC LRT Pr(>Chi)
## <none> 2304.5
## sex 1 2302.8 0.2874 0.59187
## trial_ordinal 1 2304.4 1.8632 0.17226
## object_type:condition 1 2303.7 1.1507 0.28341
## object_type:age_numeric 1 2308.4 5.9347 0.01485 *
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
4. Does 2D vs 3D Significantly Affect Top Touch Outcomes?
# ── Touch Duration ────────────────────────────────────────────────────────────
cat("=== TOUCH DURATION: Effect of 2D vs 3D ===\n")
## === TOUCH DURATION: Effect of 2D vs 3D ===
anova(duration_model) # F-test for object_type and object_type:condition
## Type III Analysis of Variance Table with Satterthwaite's method
## Sum Sq Mean Sq NumDF DenDF F value Pr(>F)
## object_type 188.410 188.410 1 721.11 23.8020 1.315e-06 ***
## condition 14.515 14.515 1 46.30 1.8337 0.182263
## age_numeric 0.009 0.009 1 45.57 0.0012 0.972721
## sex 5.224 5.224 1 46.20 0.6599 0.420765
## trial_ordinal 79.492 79.492 1 721.68 10.0423 0.001594 **
## object_type:condition 62.530 62.530 1 728.55 7.8995 0.005078 **
## object_type:age_numeric 67.550 67.550 1 721.20 8.5336 0.003595 **
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
# Estimated marginal means for 2D vs 3D (collapsing over condition)
emm_dur <- emmeans(duration_model, ~ object_type)
## NOTE: Results may be misleading due to involvement in interactions
print(emm_dur)
## object_type emmean SE df lower.CL upper.CL
## 2D 3.48 0.371 41.4 2.73 4.23
## 3D 6.46 0.371 41.4 5.71 7.21
##
## Results are averaged over the levels of: condition, sex
## Degrees-of-freedom method: kenward-roger
## Confidence level used: 0.95
pairs(emm_dur) # pairwise contrast: 2D vs 3D
## contrast estimate SE df t.ratio p.value
## 2D - 3D -2.98 0.205 732 -14.492 <0.0001
##
## Results are averaged over the levels of: condition, sex
## Degrees-of-freedom method: kenward-roger
# ── Touch Latency ─────────────────────────────────────────────────────────────
cat("\n=== TOUCH LATENCY: Effect of 2D vs 3D ===\n")
##
## === TOUCH LATENCY: Effect of 2D vs 3D ===
anova(latency_model)
## Type III Analysis of Variance Table with Satterthwaite's method
## Sum Sq Mean Sq NumDF DenDF F value Pr(>F)
## object_type 15.1025 15.1025 1 464.49 5.0551 0.02502 *
## condition 0.0032 0.0032 1 41.35 0.0011 0.97388
## age_numeric 1.2250 1.2250 1 63.66 0.4100 0.52425
## sex 1.0636 1.0636 1 39.99 0.3560 0.55410
## trial_ordinal 8.5270 8.5270 1 461.03 2.8542 0.09181 .
## object_type:condition 0.0021 0.0021 1 477.01 0.0007 0.97901
## object_type:age_numeric 10.0515 10.0515 1 464.99 3.3644 0.06726 .
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
emm_lat <- emmeans(latency_model, ~ object_type)
## NOTE: Results may be misleading due to involvement in interactions
print(emm_lat)
## object_type emmean SE df lower.CL upper.CL
## 2D 7.99 0.237 62.3 7.52 8.47
## 3D 7.19 0.224 49.9 6.74 7.64
##
## Results are averaged over the levels of: condition, sex
## Degrees-of-freedom method: kenward-roger
## Confidence level used: 0.95
pairs(emm_lat)
## contrast estimate SE df t.ratio p.value
## 2D - 3D 0.796 0.166 483 4.805 <0.0001
##
## Results are averaged over the levels of: condition, sex
## Degrees-of-freedom method: kenward-roger
# ── Touch Frequency ───────────────────────────────────────────────────────────
cat("\n=== TOUCH FREQUENCY: Effect of 2D vs 3D ===\n")
##
## === TOUCH FREQUENCY: Effect of 2D vs 3D ===
drop1(frequency_model_nb, test = "Chisq") # likelihood-ratio test for each term
## Single term deletions
##
## Model:
## n_top_touch ~ object_type * condition + object_type * age_numeric +
## sex + trial_ordinal + (1 | subject_id) + (1 | item)
## Df AIC LRT Pr(>Chi)
## <none> 2304.5
## sex 1 2302.8 0.2874 0.59187
## trial_ordinal 1 2304.4 1.8632 0.17226
## object_type:condition 1 2303.7 1.1507 0.28341
## object_type:age_numeric 1 2308.4 5.9347 0.01485 *
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
emm_freq <- emmeans(frequency_model_nb, ~ object_type, type = "response")
## NOTE: Results may be misleading due to involvement in interactions
print(emm_freq)
## object_type response SE df asymp.LCL asymp.UCL
## 2D 0.924 0.0982 Inf 0.75 1.14
## 3D 1.252 0.1290 Inf 1.02 1.53
##
## Results are averaged over the levels of: condition, sex
## Confidence level used: 0.95
## Intervals are back-transformed from the log scale
pairs(emm_freq)
## contrast ratio SE df null z.ratio p.value
## 2D / 3D 0.738 0.0541 Inf 1 -4.146 <0.0001
##
## Results are averaged over the levels of: condition, sex
## Tests are performed on the log scale
5. Prepare Plot Dataset
df_plot <- df_clean %>%
mutate(
object_type = factor(object_type, levels = c("2D", "3D")),
condition = factor(condition, levels = c("negative", "neutral")),
socinf = factor(socinf)
)
# Object category mapping (4 categories based on item codes)
df_plot <- df_plot %>%
mutate(
object_category = case_when(
item %in% c("ro", "da", "ba", "ge") ~ "Plants",
item %in% c("gp", "bc", "sa", "oa") ~ "Novel Artifacts",
item %in% c("ra", "ha", "ke", "kn") ~ "Familiar Artifacts",
item %in% c("ur", "sc", "sn", "st") ~ "Natural Objects",
TRUE ~ NA_character_
),
object_category = factor(object_category,
levels = c("Plants",
"Novel Artifacts",
"Familiar Artifacts",
"Natural Objects"))
)
6. Graphs 1–3: Top Touch Outcomes by Trial Number (1–8)
Graph 1 — Touch Latency by Trial Number
g1_data <- df_plot %>%
group_by(trial_ordinal) %>%
summarise(
mean_val = mean(top_touch_latency, na.rm = TRUE),
sd_val = sd(top_touch_latency, na.rm = TRUE),
n = sum(!is.na(top_touch_latency)),
.groups = "drop"
) %>%
mutate(se = sd_val / sqrt(n))
ggplot(g1_data, aes(x = trial_ordinal, y = mean_val)) +
geom_line(linewidth = 0.8, colour = "#4472C4") +
geom_point(size = 3, colour = "#4472C4") +
geom_errorbar(
aes(ymin = mean_val - sd_val, ymax = mean_val + sd_val),
width = 0.2, colour = "#4472C4"
) +
scale_x_continuous(breaks = 1:8) +
labs(
title = "Graph 1: Top Touch Latency by Trial Number",
x = "Trial Number",
y = "Mean Latency to First Top Touch (ms) ± SD"
) +
theme_classic(base_size = 14)
Graph 2 — Touch Duration by Trial Number
g2_data <- df_plot %>%
group_by(trial_ordinal) %>%
summarise(
mean_val = mean(top_touch_duration, na.rm = TRUE),
sd_val = sd(top_touch_duration, na.rm = TRUE),
n = sum(!is.na(top_touch_duration)),
.groups = "drop"
) %>%
mutate(se = sd_val / sqrt(n))
ggplot(g2_data, aes(x = trial_ordinal, y = mean_val)) +
geom_line(linewidth = 0.8, colour = "#ED7D31") +
geom_point(size = 3, colour = "#ED7D31") +
geom_errorbar(
aes(ymin = mean_val - sd_val, ymax = mean_val + sd_val),
width = 0.2, colour = "#ED7D31"
) +
scale_x_continuous(breaks = 1:8) +
labs(
title = "Graph 2: Top Touch Duration by Trial Number",
x = "Trial Number",
y = "Mean Top Touch Duration (ms) ± SD"
) +
theme_classic(base_size = 14)
Graph 3 — Touch Frequency by Trial Number
g3_data <- df_plot %>%
group_by(trial_ordinal) %>%
summarise(
mean_val = mean(n_top_touch, na.rm = TRUE),
sd_val = sd(n_top_touch, na.rm = TRUE),
n = sum(!is.na(n_top_touch)),
.groups = "drop"
) %>%
mutate(se = sd_val / sqrt(n))
ggplot(g3_data, aes(x = trial_ordinal, y = mean_val)) +
geom_line(linewidth = 0.8, colour = "#70AD47") +
geom_point(size = 3, colour = "#70AD47") +
geom_errorbar(
aes(ymin = mean_val - sd_val, ymax = mean_val + sd_val),
width = 0.2, colour = "#70AD47"
) +
scale_x_continuous(breaks = 1:8) +
labs(
title = "Graph 3: Top Touch Frequency by Trial Number",
x = "Trial Number",
y = "Mean Number of Top Touches ± SD"
) +
theme_classic(base_size = 14)
7. Graphs 4–6: Top Touch Outcomes by 2D/3D × Social Info
Condition
Graph 4 — Touch Latency by 2D/3D and Social Info
g4_data <- df_plot %>%
group_by(condition, object_type) %>%
summarise(
mean_val = mean(top_touch_latency, na.rm = TRUE),
sd_val = sd(top_touch_latency, na.rm = TRUE),
n = sum(!is.na(top_touch_latency)),
.groups = "drop"
) %>%
mutate(se = sd_val / sqrt(n))
ggplot(g4_data, aes(x = condition, y = mean_val, fill = object_type)) +
geom_col(position = position_dodge(width = 0.8), width = 0.7) +
geom_errorbar(
aes(ymin = mean_val - sd_val, ymax = mean_val + sd_val),
position = position_dodge(width = 0.8),
width = 0.2
) +
scale_fill_manual(values = c("2D" = "#4472C4", "3D" = "#ED7D31")) +
labs(
title = "Graph 4: Top Touch Latency by Condition and Object Type",
x = "Condition",
y = "Mean Latency to First Top Touch (ms) ± SD",
fill = "Object Type"
) +
theme_classic(base_size = 14)
Graph 5 — Touch Duration by 2D/3D and Social Info
g5_data <- df_plot %>%
group_by(condition, object_type) %>%
summarise(
mean_val = mean(top_touch_duration, na.rm = TRUE),
sd_val = sd(top_touch_duration, na.rm = TRUE),
n = sum(!is.na(top_touch_duration)),
.groups = "drop"
) %>%
mutate(se = sd_val / sqrt(n))
ggplot(g5_data, aes(x = condition, y = mean_val, fill = object_type)) +
geom_col(position = position_dodge(width = 0.8), width = 0.7) +
geom_errorbar(
aes(ymin = mean_val - sd_val, ymax = mean_val + sd_val),
position = position_dodge(width = 0.8),
width = 0.2
) +
scale_fill_manual(values = c("2D" = "#4472C4", "3D" = "#ED7D31")) +
labs(
title = "Graph 5: Top Touch Duration by Condition and Object Type",
x = "Condition",
y = "Mean Top Touch Duration (ms) ± SD",
fill = "Object Type"
) +
theme_classic(base_size = 14)
Graph 6 — Touch Frequency by 2D/3D and Social Info
g6_data <- df_plot %>%
group_by(condition, object_type) %>%
summarise(
mean_val = mean(n_top_touch, na.rm = TRUE),
sd_val = sd(n_top_touch, na.rm = TRUE),
n = sum(!is.na(n_top_touch)),
.groups = "drop"
) %>%
mutate(se = sd_val / sqrt(n))
ggplot(g6_data, aes(x = condition, y = mean_val, fill = object_type)) +
geom_col(position = position_dodge(width = 0.8), width = 0.7) +
geom_errorbar(
aes(ymin = mean_val - sd_val, ymax = mean_val + sd_val),
position = position_dodge(width = 0.8),
width = 0.2
) +
scale_fill_manual(values = c("2D" = "#4472C4", "3D" = "#ED7D31")) +
labs(
title = "Graph 6: Top Touch Frequency by Condition and Object Type",
x = "Condition",
y = "Mean Number of Top Touches ± SD",
fill = "Object Type"
) +
theme_classic(base_size = 14)
8. Graphs 7–9: Top Touch Outcomes by Object Category × 2D/3D, Split
by Social Info
Graph 7 — Touch Latency by Object Category × 2D/3D (split by Social
Info)
g7_data <- df_plot %>%
group_by(condition, object_category, object_type) %>%
summarise(
mean_val = mean(top_touch_latency, na.rm = TRUE),
sd_val = sd(top_touch_latency, na.rm = TRUE),
n = sum(!is.na(top_touch_latency)),
.groups = "drop"
) %>%
mutate(se = sd_val / sqrt(n))
ggplot(g7_data, aes(x = object_category, y = mean_val, fill = object_type)) +
geom_col(position = position_dodge(width = 0.8), width = 0.7) +
geom_errorbar(
aes(ymin = mean_val - sd_val, ymax = mean_val + sd_val),
position = position_dodge(width = 0.8),
width = 0.2
) +
facet_wrap(~ condition, labeller = labeller(condition = c(
negative = "Condition: Negative",
neutral = "Condition: Neutral"
))) +
scale_fill_manual(values = c("2D" = "#4472C4", "3D" = "#ED7D31")) +
labs(
title = "Graph 7: Top Touch Latency by Object Category and Object Type",
x = "Object Category",
y = "Mean Latency to First Top Touch (ms) ± SD",
fill = "Object Type"
) +
theme_classic(base_size = 13) +
theme(axis.text.x = element_text(angle = 30, hjust = 1))
Graph 8 — Touch Duration by Object Category × 2D/3D (split by Social
Info)
g8_data <- df_plot %>%
group_by(condition, object_category, object_type) %>%
summarise(
mean_val = mean(top_touch_duration, na.rm = TRUE),
sd_val = sd(top_touch_duration, na.rm = TRUE),
n = sum(!is.na(top_touch_duration)),
.groups = "drop"
) %>%
mutate(se = sd_val / sqrt(n))
ggplot(g8_data, aes(x = object_category, y = mean_val, fill = object_type)) +
geom_col(position = position_dodge(width = 0.8), width = 0.7) +
geom_errorbar(
aes(ymin = mean_val - sd_val, ymax = mean_val + sd_val),
position = position_dodge(width = 0.8),
width = 0.2
) +
facet_wrap(~ condition, labeller = labeller(condition = c(
negative = "Condition: Negative",
neutral = "Condition: Neutral"
))) +
scale_fill_manual(values = c("2D" = "#4472C4", "3D" = "#ED7D31")) +
labs(
title = "Graph 8: Top Touch Duration by Object Category and Object Type",
x = "Object Category",
y = "Mean Top Touch Duration (ms) ± SD",
fill = "Object Type"
) +
theme_classic(base_size = 13) +
theme(axis.text.x = element_text(angle = 30, hjust = 1))
Graph 9 — Touch Frequency by Object Category × 2D/3D (split by
Social Info)
g9_data <- df_plot %>%
group_by(condition, object_category, object_type) %>%
summarise(
mean_val = mean(n_top_touch, na.rm = TRUE),
sd_val = sd(n_top_touch, na.rm = TRUE),
n = sum(!is.na(n_top_touch)),
.groups = "drop"
) %>%
mutate(se = sd_val / sqrt(n))
ggplot(g9_data, aes(x = object_category, y = mean_val, fill = object_type)) +
geom_col(position = position_dodge(width = 0.8), width = 0.7) +
geom_errorbar(
aes(ymin = mean_val - sd_val, ymax = mean_val + sd_val),
position = position_dodge(width = 0.8),
width = 0.2
) +
facet_wrap(~ condition, labeller = labeller(condition = c(
negative = "Condition: Negative",
neutral = "Condition: Neutral"
))) +
scale_fill_manual(values = c("2D" = "#4472C4", "3D" = "#ED7D31")) +
labs(
title = "Graph 9: Top Touch Frequency by Object Category and Object Type",
x = "Object Category",
y = "Mean Number of Top Touches ± SD",
fill = "Object Type"
) +
theme_classic(base_size = 13) +
theme(axis.text.x = element_text(angle = 30, hjust = 1))
9. Original Graphs: Outcomes by Condition × 2D/3D (from v1)
Touch Duration by Condition and Object Type
duration_bar <- df_plot %>%
group_by(condition, object_type) %>%
summarise(
mean_duration = mean(top_touch_duration, na.rm = TRUE),
se_duration = sd(top_touch_duration, na.rm = TRUE) / sqrt(sum(!is.na(top_touch_duration))),
.groups = "drop"
)
ggplot(duration_bar, aes(x = condition, y = mean_duration, fill = object_type)) +
geom_col(position = position_dodge(width = 0.8), width = 0.7) +
geom_errorbar(
aes(ymin = mean_duration - se_duration, ymax = mean_duration + se_duration),
position = position_dodge(width = 0.8),
width = 0.2
) +
scale_fill_manual(values = c("2D" = "#4472C4", "3D" = "#ED7D31")) +
labs(
title = "Top Touch Duration by Condition and Object Type",
x = "Condition",
y = "Mean Top Touch Duration (ms) ± SE",
fill = "Object Type"
) +
theme_classic(base_size = 14)
Touch Latency by Condition and Object Type
latency_bar <- df_plot %>%
group_by(condition, object_type) %>%
summarise(
mean_latency = mean(top_touch_latency, na.rm = TRUE),
se_latency = sd(top_touch_latency, na.rm = TRUE) / sqrt(sum(!is.na(top_touch_latency))),
.groups = "drop"
)
ggplot(latency_bar, aes(x = condition, y = mean_latency, fill = object_type)) +
geom_col(position = position_dodge(width = 0.8), width = 0.7) +
geom_errorbar(
aes(ymin = mean_latency - se_latency, ymax = mean_latency + se_latency),
position = position_dodge(width = 0.8),
width = 0.2
) +
scale_fill_manual(values = c("2D" = "#4472C4", "3D" = "#ED7D31")) +
labs(
title = "Top Touch Latency by Condition and Object Type",
x = "Condition",
y = "Mean Latency to First Top Touch (ms) ± SE",
fill = "Object Type"
) +
theme_classic(base_size = 14)
Touch Frequency by Condition and Object Type
frequency_bar <- df_plot %>%
group_by(condition, object_type) %>%
summarise(
mean_touch = mean(n_top_touch, na.rm = TRUE),
se_touch = sd(n_top_touch, na.rm = TRUE) / sqrt(sum(!is.na(n_top_touch))),
.groups = "drop"
)
ggplot(frequency_bar, aes(x = condition, y = mean_touch, fill = object_type)) +
geom_col(position = position_dodge(width = 0.8), width = 0.7) +
geom_errorbar(
aes(ymin = mean_touch - se_touch, ymax = mean_touch + se_touch),
position = position_dodge(width = 0.8),
width = 0.2
) +
scale_fill_manual(values = c("2D" = "#4472C4", "3D" = "#ED7D31")) +
labs(
title = "Top Touch Frequency by Condition and Object Type",
x = "Condition",
y = "Mean Number of Top Touches ± SE",
fill = "Object Type"
) +
theme_classic(base_size = 14)
10. Graphs 10–12: Top Touch Outcomes for Each of the 16 Objects
Graph 10 — Touch Latency by Object Item
g10_data <- df_plot %>%
group_by(item) %>%
summarise(
mean_val = mean(top_touch_latency, na.rm = TRUE),
sd_val = sd(top_touch_latency, na.rm = TRUE),
n = sum(!is.na(top_touch_latency)),
.groups = "drop"
) %>%
mutate(
se = sd_val / sqrt(n),
item = fct_reorder(item, mean_val)
)
ggplot(g10_data, aes(x = item, y = mean_val)) +
geom_col(fill = "#4472C4", width = 0.7) +
geom_errorbar(
aes(ymin = mean_val - sd_val, ymax = mean_val + sd_val),
width = 0.3
) +
labs(
title = "Graph 10: Top Touch Latency for Each of the 16 Objects",
x = "Object (Item)",
y = "Mean Latency to First Top Touch (ms) ± SD"
) +
theme_classic(base_size = 13) +
theme(axis.text.x = element_text(angle = 45, hjust = 1))
Graph 11 — Touch Duration by Object Item
g11_data <- df_plot %>%
group_by(item) %>%
summarise(
mean_val = mean(top_touch_duration, na.rm = TRUE),
sd_val = sd(top_touch_duration, na.rm = TRUE),
n = sum(!is.na(top_touch_duration)),
.groups = "drop"
) %>%
mutate(
se = sd_val / sqrt(n),
item = fct_reorder(item, mean_val)
)
ggplot(g11_data, aes(x = item, y = mean_val)) +
geom_col(fill = "#ED7D31", width = 0.7) +
geom_errorbar(
aes(ymin = mean_val - sd_val, ymax = mean_val + sd_val),
width = 0.3
) +
labs(
title = "Graph 11: Top Touch Duration for Each of the 16 Objects",
x = "Object (Item)",
y = "Mean Top Touch Duration (ms) ± SD"
) +
theme_classic(base_size = 13) +
theme(axis.text.x = element_text(angle = 45, hjust = 1))
Graph 12 — Touch Frequency by Object Item
g12_data <- df_plot %>%
group_by(item) %>%
summarise(
mean_val = mean(n_top_touch, na.rm = TRUE),
sd_val = sd(n_top_touch, na.rm = TRUE),
n = sum(!is.na(n_top_touch)),
.groups = "drop"
) %>%
mutate(
se = sd_val / sqrt(n),
item = fct_reorder(item, mean_val)
)
ggplot(g12_data, aes(x = item, y = mean_val)) +
geom_col(fill = "#70AD47", width = 0.7) +
geom_errorbar(
aes(ymin = mean_val - sd_val, ymax = mean_val + sd_val),
width = 0.3
) +
labs(
title = "Graph 12: Top Touch Frequency for Each of the 16 Objects",
x = "Object (Item)",
y = "Mean Number of Top Touches ± SD"
) +
theme_classic(base_size = 13) +
theme(axis.text.x = element_text(angle = 45, hjust = 1))
