Hafði röðunin marktæk áhrif á frammistöðu?

aov(cbind(errors, dprime, ies, rt) ~ type, results) %>%
      summary

##  Response errors :
##              Df Sum Sq Mean Sq F value Pr(>F)
## type          1   48.1  48.050   0.838 0.3613
## Residuals   169 9690.4  57.339               
## 
##  Response dprime :
##              Df  Sum Sq   Mean Sq F value Pr(>F)
## type          1 0.00478 0.0047764   0.697  0.405
## Residuals   169 1.15807 0.0068525               
## 
##  Response ies :
##              Df Sum Sq  Mean Sq F value Pr(>F)
## type          1 0.0359 0.035927  1.8428 0.1764
## Residuals   169 3.2949 0.019496               
## 
##  Response rt :
##              Df  Sum Sq   Mean Sq F value Pr(>F)
## type          1 0.01179 0.0117873  1.6179 0.2051
## Residuals   169 1.23128 0.0072857

Meira

Umhverfið sem sést á mynd er repeated measure þ.a. við munum nota mixed factorial ANOVA með anova_ez() fallinu úr afex pakkanum. Munum skoða fjórar breytur: svartíma, fjölda villna, d’prime, og inverse efficency score. Hér fyrir neðan sést dreifing þeirra breyta milli hópa. Við sjáum að það er mikill munur milli filter hópa, en munurinn er líka þegar environment er none þ.a. þetta er líklegast úrtaksskekkja, en ekki afurð hópaskiptinganna (rétt ályktun?)

cap <- "Summary plot of measures before correction. A large difference can be seen in the first trial (none)"
results %>%
    select(-accuracy) %>%
    gather(measure, value, rt, errors:ies) %>%
    mutate(measure = factor(measure, levels = c("rt","errors", "dprime", "ies"))) %>%
    ggplot(aes(prev, value, linetype = filt)) +
    stat_summary(geom = "errorbar", 
                 fun.data = function(x) mean_se(x, mult = 1), position = "dodge") +
    stat_summary(geom = "point", 
                 fun.data = function(x) mean_se(x, mult = 0), position = position_dodge(width = 0.9)) +
    scale_linetype_manual(name = "Spatial Filter",
                          values = c(1, 2),
                          labels = c("High Pass ", " Low Pass")) +
    guides(linetype = guide_legend(title.position = "top",
                                   title.hjust = 0.5,
                                   label.position = "bottom",
                                   title.vjust = -2,
                                   label.vjust = -2)) +
    facet_wrap(~ measure, scales = "free", ncol = 4,
               labeller = labeller(measure = c(rt = "Reaction Time (MS)",
                                               dprime = "D'Prime",
                                               ies = "Inverse Efficiency Score",
                                               errors = "Errors"))) +
    theme(text = element_text(size = 12, family = "Courier New"),
          panel.border = element_rect(fill = NA, linetype = 1, size = 0.8),
          panel.grid = element_line(linetype = 1, size = 0.6), 
          strip.background = element_rect(fill = c("gray95"), linetype = 0),
          strip.text = element_text(margin = c(0, 0, 0, 0, "cm")),
          legend.position = "top") +
    labs(x = "", y = TeX("$\\bar{X} \\pm sd$"))

Summary plot of measures before correction. A large difference can be seen in the first trial (none)

Taflan fyrir neðan sýnir að filtlo hópurinn er verulega frábrugðinn filthi hópnum í fyrsta talnaverkefninu (áður en myndir eru sýndar).

Reikna mun milli hópa bara í fyrsta talnaverkefni

results %>%
    filter(prev == "none") %>%
    lm(cbind(rt, errors, dprime, ies) ~ filt, .) %>%
    tidy %>%
    mutate(lower = estimate - 1.96 * std.error,
           upper = estimate + 1.96 * std.error) %>%
    select(response, term, estimate, lower, upper, p.value) %>%
    set_names(c("Fylgibreyta", "Frumbreyta", "Munur", "Neðri", "Efri", "p")) %>%
    filter(!grepl("Intercept", Frumbreyta)) %>%
    kable(format = "html", digits = 3, caption = "Úrtaksskekkja í fylgibreytun (reiknað með línulegu líkani)") %>%
    kable_styling(full_width = TRUE, bootstrap_options = c("striped", "hover")) %>%
    add_header_above(c("", "", "", "95% Öryggisbil" = 2, ""))

results %>%
    filter(prev == "none") %>%
    lm(cbind(rt, errors, dprime, ies) ~ type, .) %>%
    tidy %>%
    mutate(lower = estimate - 1.96 * std.error,
           upper = estimate + 1.96 * std.error) %>%
    select(response, term, estimate, lower, upper, p.value) %>%
    set_names(c("Fylgibreyta", "Frumbreyta", "Munur", "Neðri", "Efri", "p")) %>%
    filter(!grepl("Intercept", Frumbreyta)) %>%
    kable(format = "html", digits = 3, caption = "Úrtaksskekkja í fylgibreytun (reiknað með línulegu líkani)") %>%
    kable_styling(full_width = TRUE, bootstrap_options = c("striped", "hover")) %>%
    add_header_above(c("", "", "", "95% Öryggisbil" = 2, ""))

Við ákváðum þess vegna að breyta gögnunum þ.a. við drægum frammistöðu í fyrstu SART frá frammistöðum í hinum tveimur sart. Þá hverfur munurinn milli þátttakenda frá fyrsta talnaverkefni og allur munur ætti að vera eingöngu vegna hópaskiptingar. Skoðum því nýjar breytur skilgreindar sem:

• \(\Delta Breyta = Breyta - Breyta_{SART1}\)

Myndritið fyrir neðan sýnir muninn milli hópa eftir leiðréttingu. Uppi sáum við þrjár mælingar eftir: Engin mynd, Náttúru mynd, Urban mynd, en fyrir neðan bara seinni tvo hópana þar sem við notuðum fyrsta hópinn til að leiðrétta fyrr úrtaksskekkju. Við sjáum mestan mun milli myndategunda í high frequency spectruminu. Fólk sem hefur horft á náttúrumyndir gerir aðeins fleiri villur og stendur sig aðeins verr. Náttúrumyndir hafa miklu erfiðara high spatial frequency component sem gerir þær að erfiðara áreiti fyrir augun, en urban myndir eru skipulagðari og auðveldari að melta. Það gæti líka verið betra að finna hluti til að einbeita sér að í urban myndum því objects eru afmarkaðari (oftast kassar/hringir/einföld form) en objects í náttúru ekki jafn afmörkuð.

Í Low Frequency sést ekki jafn mikill munur, en rannsóknir hafa sýnt að miklir categorization eiginleikar lágtíðnispectrumsins séu einmitt í litunum (sérstaklega í náttúrulegu umhverfi) (Oliva, 2004, bls 3 síðasta efnisgrein).

cap <- "Summary plot of measures by groups after correction"
rel_results %>%
    mutate(measure = factor(measure, levels = c("rt", "errors", "dprime", "ies"))) %>%
    ggplot(aes(prev, value, linetype = filt)) +
    stat_summary(geom = "errorbar", 
                 fun.data = function(x) mean_se(x, mult = 1), position = "dodge") +
    stat_summary(geom = "point", 
                 fun.data = function(x) mean_se(x, mult = 0), position = position_dodge(width = 0.9)) +
    scale_linetype_manual(name = "Spatial Filter",
                          values = c(1, 2),
                          labels = c("High Pass ", " Low Pass")) +
    guides(linetype = guide_legend(title.position = "top",
                                   title.hjust = 0.5,
                                   label.position = "bottom",
                                   title.vjust = -2,
                                   label.vjust = -2)) +
    facet_wrap(~ measure, scales = "free", ncol = 4,
               labeller = labeller(measure = c(rt = "Reaction Time (MS)",
                                               dprime = "D'Prime",
                                               ies = "Inverse Efficiency Score",
                                               errors = "Errors"))) +
    theme(panel.border = element_rect(fill = NA, linetype = 1, size = 0.8),
          panel.grid = element_line(linetype = 1, size = 0.6), 
          strip.background = element_rect(fill = c("gray95"), linetype = 0),
          strip.text = element_text(size = 12, margin = c(0, 0, 0, 0, "cm")), 
          legend.text = element_text(size = 12), 
          legend.title = element_text(size = 14, family = "Courier New"),
          legend.position = "top") +
    labs(x = "", y = TeX("$\\bar{X} \\pm sd$"))

Summary plot of measures by groups after correction

D-Prime

aovs[[1]] %>%
      lsmeans("prev", "filt") %>%
      pairs %>%
      update(by = NULL, adjust = "holm")

##  contrast       filt     estimate          SE df t.ratio p.value
##  urban - nature lo   -0.007942849 0.009352198 55  -0.849  0.3994
##  urban - nature hi    0.018566610 0.009189539 55   2.020  0.0964
## 
## P value adjustment: holm method for 2 tests

Errors

aovs[[2]] %>%
      lsmeans("prev", "filt") %>%
      pairs %>%
      update(by = NULL, adjust = "holm")

##  contrast       filt   estimate        SE df t.ratio p.value
##  urban - nature lo    0.6428571 0.8354874 55   0.769  0.4449
##  urban - nature hi   -1.6551724 0.8209561 55  -2.016  0.0974
## 
## P value adjustment: holm method for 2 tests

IES

aovs[[3]] %>%
      lsmeans("prev", "filt") %>%
      pairs %>%
      update(by = NULL, adjust = "holm")

##  contrast       filt     estimate         SE df t.ratio p.value
##  urban - nature lo   -0.003310092 0.01368408 55  -0.242  0.8098
##  urban - nature hi    0.024812407 0.01344608 55   1.845  0.1408
## 
## P value adjustment: holm method for 2 tests

RT

aovs[[4]] %>%
      lsmeans("prev", "filt") %>%
      pairs %>%
      update(by = NULL, adjust = "holm")

##  contrast       filt    estimate          SE df t.ratio p.value
##  urban - nature lo   0.001096646 0.009025567 55   0.122  0.9037
##  urban - nature hi   0.008791500 0.008868589 55   0.991  0.6518
## 
## P value adjustment: holm method for 2 tests

cap <- "Predicted values for dependent variables by mixed ANOVA models"
aovs[[1]] %>%
    emmeans::lsmeans(c("prev", "filt")) %>%
    summary %>%
    as.tibble %>%
    mutate(variable = "dprime") %>%
    select(-lower.CL, upper.CL, df) %>%
    rbind(
        aovs[[2]] %>%
            emmeans::lsmeans(c("prev", "filt")) %>%
            summary %>%
            as.tibble %>%
            mutate(variable = "ies") %>%
            select(-lower.CL, upper.CL, df)
    ) %>%
    rbind(
        aovs[[3]] %>%
            emmeans::lsmeans(c("prev", "filt")) %>%
            summary %>%
            as.tibble %>%
            mutate(variable = "errors") %>%
            select(-lower.CL, upper.CL, df)
    ) %>%
    rbind(
        aovs[[4]] %>%
            emmeans::lsmeans(c("prev", "filt")) %>%
            summary %>%
            as.tibble %>%
            mutate(variable = "rt") %>%
            select(-lower.CL, upper.CL, df)
    ) %>%
    ggplot(aes(prev, lsmean, 
               ymin = lsmean -  SE,
               ymax = lsmean + SE,
               linetype = filt, group = filt)) +
    geom_errorbar(alpha = 0.3) +
    geom_point() +
    geom_line() +
    scale_linetype_manual(name = "Spatial Filter",
                          values = c(1, 2),
                          labels = c("High Pass ", " Low Pass")) +
    guides(linetype = guide_legend(title.position = "top",
                                   title.hjust = 0.5,
                                   label.position = "bottom",
                                   title.vjust = -2,
                                   label.vjust = -2)) +
    facet_wrap(~ variable, scales = "free", ncol = 2,
               labeller = labeller(variable = c(rt = "Reaction Time (MS)",
                                                dprime = "D'Prime",
                                                ies = "Inverse Efficiency Score",
                                                errors = "Errors"))) +
    theme(panel.border = element_rect(fill = NA, linetype = 1, size = 0.8),
          panel.grid = element_blank(), 
          strip.background = element_rect(fill = c("gray95"), linetype = 0),
          strip.text = element_text(size = 12, margin = c(0, 0, 0, 0, "cm")), 
          legend.text = element_text(size = 12), 
          legend.title = element_text(size = 14, family = "Courier New"),
          legend.position = "top") +
    labs(x = "", y = TeX("\\bar{Y}_{AOV} $\\pm sd$"))

Predicted values for dependent variables by mixed ANOVA models

Ég smíðaði líka linear mixed effects models með lme4 pakkanum. Þar sem frumbreyturnar taka bara tvö gildi skilar það því sama og post-hoc ANOVA próf. Helsti munurinn er að þá getum við séð effects plot fyrir hvern þátttakanda.

dprime_lmer <- lmer(dprime ~ filt * prev + (1 | id) + (prev || type), 
                    data = lmer_results) 

errors_lmer <- lmer(errors ~ filt * prev + (1 | id) + (prev || type), 
                    data = lmer_results) 

ies_lmer <- lmer(ies ~  filt * prev + (1 | id) + (prev || type), 
                 data = lmer_results) 

rt_lmer <- lmer(rt ~  filt * prev + (1 | id) + (prev || type), 
                 data = lmer_results) 

• (1 | id) þýðir að hver þátttakandi má hafa ólíkt slembidreifðan skurðpunkt.
• (prev || type) þýðir að hvor röðunarhópur fær að hafa eigin slembidreifða hallatölu en ekki ólíkan skurðpunkt þar sem við dílum nú þegar við það með hinni breytunni.

Úr þessu verður líkan sem metur samvirkniáhrf síunnar og umhverfis sem birtist fyrir SART próf, en leiðréttir fyrir endurteknar mælingar.

dprime_lmer %>%
      tidy("fixed") %>%
      set_names(c("term", "estimate", "std.error", "df", "statistic", "p.value")) %>%
      mutate(variable = "dprime") %>%
      rbind(
            errors_lmer %>%
                  tidy("fixed") %>%
                  set_names(c("term", "estimate", "std.error", "df", "statistic", "p.value")) %>%
                  mutate(variable = "errors")
      ) %>%
      rbind(
            ies_lmer %>%
                  tidy("fixed") %>%
                  set_names(c("term", "estimate", "std.error", "df", "statistic", "p.value")) %>%
                  mutate(variable = "ies")
      ) %>%
      select(-df, -statistic, -std.error) %>%
      unite(nums, estimate, p.value) %>%
      spread(variable, nums) %>%
      separate(dprime, paste0("dprime_", c("estimate", "p.value")), sep = "_") %>%
      separate(errors, paste0("errors_", c("estimate", "p.value")), sep = "_") %>%
      separate(ies, paste0("ies_", c("estimate", "p.value")), sep = "_") %>%
      mutate_at(2:7, as.numeric) %>%
      set_names(c("term", rep(c("estimate", "p"), 3))) %>%
      kable(format = "html", digits = 3) %>%
      kable_styling(full_width = TRUE, bootstrap_options = c("striped", "hover"), font_size = 10) %>%
      add_header_above(c("", "D-Prime" = 2, "Errors" = 2, "IES" = 2))

dprime_lmer %>%
      anova %>%
      tidy %>%
      mutate(variable = "dprime") %>%
      rbind(
            errors_lmer %>%
                  anova %>%
                  tidy %>%
                  mutate(variable = "errors")
      ) %>%
      rbind(
            ies_lmer %>%
                  anova %>%
                  tidy %>%
                  mutate(variable = "ies")
      ) %>%
      select(-sumsq, -meansq, -NumDF, -DenDF, -statistic) %>%
      spread(variable, p.value) %>%
      kable(format = "html", digits = 3) %>%
      kable_styling(bootstrap_options = c("striped")) %>%
      add_header_above(c("", "P-Gildi" = 3))