Prep:

calculate fluency score (sum of sp + ud), create new df

df_fluency_score <- cn_demog %>% 
  filter(demog_question %in% c("lang_sp", "lang_ud")) %>% 
  mutate(demog_response = as.numeric(demog_response)) %>% 
  group_by(subject) %>% 
  summarise(fluency_score = sum(demog_response))

## `summarise()` ungrouping output (override with `.groups` argument)

cn_fl_data <- left_join(cn_data, df_fluency_score, 
                        by = "subject")

RMTS

visualization

RMTS_ms <- cn_fl_data %>%
  filter(task_name == "RMTS") %>% 
  group_by(subject) %>% 
  summarise(avg_resp = mean(resp)) %>% 
  left_join(df_fluency_score, by = "subject")

## `summarise()` ungrouping output (override with `.groups` argument)

#scatter plot
ggplot(RMTS_ms, 
       aes(x = fluency_score, y = avg_resp)) + 
  geom_point() + 
  theme_classic() + 
  ggthemes::scale_color_solarized() + 
  theme(legend.position = "bottom")

## Warning: Removed 3 rows containing missing values (geom_point).

model

rmts_df <- cn_fl_data %>%
  filter(task_name == "RMTS")  %>% 
  mutate(choice = as.factor(case_when(
    resp == "1" ~ "rel",
    resp == "0" ~ "obj"))
         ) %>%
  group_by(subject) %>% 
  mutate(trial_num = as.factor(row_number())) %>% 
  select(-resp, -task_info, -trial_info, -resp_type)
# model 0: not converging 
#rmts_model <- glmer(choice ~ fluency_score + (trial_num | subject), family = binomial, data = rmts_df)

# model 1: 
rmts_model <- glmer(choice ~ fluency_score + (1 | subject), family = binomial, data = rmts_df)
summary(rmts_model)

## Generalized linear mixed model fit by maximum likelihood (Laplace
##   Approximation) [glmerMod]
##  Family: binomial  ( logit )
## Formula: choice ~ fluency_score + (1 | subject)
##    Data: rmts_df
## 
##      AIC      BIC   logLik deviance df.resid 
##    339.9    353.4   -166.9    333.9      657 
## 
## Scaled residuals: 
##      Min       1Q   Median       3Q      Max 
## -1.71092 -0.00583 -0.00509  0.08027  1.75119 
## 
## Random effects:
##  Groups  Name        Variance Std.Dev.
##  subject (Intercept) 593.5    24.36   
## Number of obs: 660, groups:  subject, 165
## 
## Fixed effects:
##                Estimate Std. Error z value Pr(>|z|)    
## (Intercept)   -10.90806    1.98309  -5.501 3.79e-08 ***
## fluency_score   0.05824    0.16225   0.359     0.72    
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## 
## Correlation of Fixed Effects:
##             (Intr)
## fluency_scr -0.890

Ravens

visualization

RV_ms <- cn_fl_data %>%
  filter(task_name == "RV")  %>%
  group_by(subject) %>%
  summarise(mean = mean(as.numeric(resp), na.rm = TRUE)) %>%
  left_join(df_fluency_score, by = "subject")

## `summarise()` ungrouping output (override with `.groups` argument)

ggplot(RV_ms, 
       aes(x = fluency_score, y = mean)) + 
  geom_point()+
  ylab("Raven % correct") + 
  xlab("Fluency Score") +
  theme_classic() +
  ggthemes::scale_color_solarized() + 
  theme(legend.position = "bottom")

## Warning: Removed 3 rows containing missing values (geom_point).

model

rv_df <- cn_fl_data %>%
  filter(task_name == "RV") %>% 
  mutate(acc = as.numeric(resp)) %>% 
  group_by(subject) %>% 
  mutate(trial = as.factor(row_number())) %>% 
  select(-resp, -task_info, -trial_info, -resp_type)

rv_model <- glmer(acc ~ fluency_score + (1 | subject) + (1 | trial), family = binomial, data = rv_df)

rv_model

## Generalized linear mixed model fit by maximum likelihood (Laplace
##   Approximation) [glmerMod]
##  Family: binomial  ( logit )
## Formula: acc ~ fluency_score + (1 | subject) + (1 | trial)
##    Data: rv_df
##      AIC      BIC   logLik deviance df.resid 
## 1373.496 1395.860 -682.748 1365.496     1976 
## Random effects:
##  Groups  Name        Std.Dev.
##  subject (Intercept) 1.205   
##  trial   (Intercept) 1.208   
## Number of obs: 1980, groups:  subject, 165; trial, 12
## Fixed Effects:
##   (Intercept)  fluency_score  
##      2.517910       0.005736

summary(rv_model)

## Generalized linear mixed model fit by maximum likelihood (Laplace
##   Approximation) [glmerMod]
##  Family: binomial  ( logit )
## Formula: acc ~ fluency_score + (1 | subject) + (1 | trial)
##    Data: rv_df
## 
##      AIC      BIC   logLik deviance df.resid 
##   1373.5   1395.9   -682.7   1365.5     1976 
## 
## Scaled residuals: 
##     Min      1Q  Median      3Q     Max 
## -8.3324  0.1204  0.2138  0.3594  3.8118 
## 
## Random effects:
##  Groups  Name        Variance Std.Dev.
##  subject (Intercept) 1.453    1.205   
##  trial   (Intercept) 1.459    1.208   
## Number of obs: 1980, groups:  subject, 165; trial, 12
## 
## Fixed effects:
##               Estimate Std. Error z value Pr(>|z|)    
## (Intercept)   2.517910   0.489390   5.145 2.68e-07 ***
## fluency_score 0.005736   0.029450   0.195    0.846    
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## 
## Correlation of Fixed Effects:
##             (Intr)
## fluency_scr -0.639

Conformance preference (pens, i.e., stickers)

cp_df <-  cn_fl_data %>%
  filter(task_name == "RV")  %>% 
  mutate(choice = as.factor(case_when(
    resp == "1" ~ "uniq",
    resp == "0" ~ "non_uniq"))
         ) %>% 
  select(-resp, -task_info, -trial_info, -resp_type)

cp_model <- glm(choice ~ fluency_score, 
                   family=binomial(link="logit"),
                  data = cp_df)

cp_model

## 
## Call:  glm(formula = choice ~ fluency_score, family = binomial(link = "logit"), 
##     data = cp_df)
## 
## Coefficients:
##   (Intercept)  fluency_score  
##      1.681069       0.006562  
## 
## Degrees of Freedom: 1979 Total (i.e. Null);  1978 Residual
##   (36 observations deleted due to missingness)
## Null Deviance:       1660 
## Residual Deviance: 1660  AIC: 1664

summary(cp_model)

## 
## Call:
## glm(formula = choice ~ fluency_score, family = binomial(link = "logit"), 
##     data = cp_df)
## 
## Deviance Residuals: 
##     Min       1Q   Median       3Q      Max  
## -1.9817   0.5567   0.5652   0.5704   0.5826  
## 
## Coefficients:
##               Estimate Std. Error z value Pr(>|z|)    
## (Intercept)   1.681069   0.176514   9.524   <2e-16 ***
## fluency_score 0.006562   0.015621   0.420    0.674    
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## 
## (Dispersion parameter for binomial family taken to be 1)
## 
##     Null deviance: 1660.0  on 1979  degrees of freedom
## Residual deviance: 1659.8  on 1978  degrees of freedom
##   (36 observations deleted due to missingness)
## AIC: 1663.8
## 
## Number of Fisher Scoring iterations: 4

Symbolic Self inflation

visualization

ratio

si_ratio_ms <- cn_fl_data %>%
  filter(task_name == "SI")  %>%
  filter(resp_type == "inflation_score_ratio")

ggplot(si_ratio_ms, 
       aes(x = fluency_score, y = as.numeric(resp))) + 
  geom_point() +
  ylab("(me_radius *2) / (other_radius * 2)") + 
  xlab("fluency score") + 
  theme_classic() + 
scale_size_area(breaks = seq(0,50,5)) + 
  ggthemes::scale_color_solarized() + 
  theme(legend.position = "bottom")

## Warning: Removed 2 rows containing missing values (geom_point).

### difference

si_diff_ms <- cn_fl_data %>%
  filter(task_name == "SI")  %>%
  filter(resp_type == "inflation_score_diff")

ggplot(si_diff_ms, 
       aes(x = fluency_score, y = as.numeric(resp))) + 
  geom_point() +
  ylab("me_radius - other_radius") + 
  xlab("fluency score") + 
  theme_classic() + 
scale_size_area(breaks = seq(0,50,5)) + 
  ggthemes::scale_color_solarized() + 
  theme(legend.position = "bottom")

## Warning: Removed 2 rows containing missing values (geom_point).

## model ### ratio

si_ratio_model <- glm(as.numeric(resp) ~ fluency_score, family=gaussian, data = si_ratio_ms)

summary(si_ratio_model)

## 
## Call:
## glm(formula = as.numeric(resp) ~ fluency_score, family = gaussian, 
##     data = si_ratio_ms)
## 
## Deviance Residuals: 
##     Min       1Q   Median       3Q      Max  
## -0.7433  -0.2285  -0.0634   0.1178   4.3787  
## 
## Coefficients:
##               Estimate Std. Error t value Pr(>|t|)    
## (Intercept)    0.65619    0.11596   5.659 7.38e-08 ***
## fluency_score  0.02854    0.01036   2.756  0.00657 ** 
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## 
## (Dispersion parameter for gaussian family taken to be 0.2700607)
## 
##     Null deviance: 43.101  on 153  degrees of freedom
## Residual deviance: 41.049  on 152  degrees of freedom
##   (2 observations deleted due to missingness)
## AIC: 239.42
## 
## Number of Fisher Scoring iterations: 2

diff

si_diff_model <- glm(as.numeric(resp) ~ fluency_score, family=gaussian, data = si_diff_ms)
summary(si_diff_model)

## 
## Call:
## glm(formula = as.numeric(resp) ~ fluency_score, family = gaussian, 
##     data = si_diff_ms)
## 
## Deviance Residuals: 
##      Min        1Q    Median        3Q       Max  
## -253.153   -15.811     5.145    16.957   122.646  
## 
## Coefficients:
##               Estimate Std. Error t value Pr(>|t|)   
## (Intercept)   -29.8493     9.4111  -3.172  0.00183 **
## fluency_score   1.6679     0.8405   1.984  0.04901 * 
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## 
## (Dispersion parameter for gaussian family taken to be 1778.759)
## 
##     Null deviance: 277376  on 153  degrees of freedom
## Residual deviance: 270371  on 152  degrees of freedom
##   (2 observations deleted due to missingness)
## AIC: 1593.5
## 
## Number of Fisher Scoring iterations: 2

Causal attribution

visualization

CA_ms <- cn_fl_data %>%
  filter(task_name == "CA") %>% 
  group_by(resp_type, subject) %>%
  summarise(subject_mean = mean(resp)) %>% 
  left_join(df_fluency_score, by = "subject")

## `summarise()` regrouping output by 'resp_type' (override with `.groups` argument)

#plot means and CIs
ggplot(CA_ms, 
       aes(x = fluency_score, y = subject_mean)) + 
  geom_point()+ 
  facet_wrap(~resp_type)+
  ylab("Average number of attributions per trial") + 
  xlab("Fluency Score") + 
  ylim(c(0,1)) + 
  theme_classic() + 
  ggthemes::scale_color_solarized() + 
  theme(legend.position = "bottom")

## Warning: Removed 37 rows containing missing values (geom_point).

model

ca_df <- cn_fl_data %>%
  filter(task_name == "CA") %>% 
  mutate(
    subject = as.factor(subject),
    attrib_num = as.numeric(resp),
         attrib_binary = replace(attrib_num, attrib_num > 1, 1),
         attrib_type = factor(resp_type)) %>% 
  group_by(subject, resp_type) %>% 
  mutate(trial = as.character(row_number())) %>% 
  select(-resp, -task_info)

#ca_model <- glmer(attrib_num ~ attrib_type * fluency_score + (attrib_type | subject) + (fluency_score | trial), family=poisson, data = ca_df, control=glmerControl(optimizer="bobyqa"))
#boundary (singular) fit: see ?isSingular

#ca_model_binary <- glmer(attrib_binary ~ attrib_type * culture + (attrib_type | subject) + (culture | trial), family=binomial, data = ca_df, control=glmerControl(optimizer="bobyqa"))
#boundary (singular) fit: see ?isSingular

#ca_model1 <- glmer(attrib_num ~ attrib_type * culture + (attrib_type | subject) + (1 | trial), family=poisson, data = ca_df, control=glmerControl(optimizer="bobyqa"))
#boundary (singular) fit: see ?isSingular

#ca_model2 <- glmer(attrib_num ~ attrib_type * culture + (1 | subject) + (1 | trial), family=poisson, data = ca_df, control=glmerControl(optimizer="bobyqa"))
#boundary (singular) fit: see ?isSingular

#ca_model3 <- glmer(attrib_num ~ attrib_type * culture + (1 | subject), family=poisson, data = ca_df, control=glmerControl(optimizer="bobyqa"))
#boundary (singular) fit: see ?isSingular

ca_model4 <- glm(attrib_num ~ attrib_type * fluency_score, family=poisson, data = ca_df)

ca_model4

## 
## Call:  glm(formula = attrib_num ~ attrib_type * fluency_score, family = poisson, 
##     data = ca_df)
## 
## Coefficients:
##                                    (Intercept)  
##                                      -0.380372  
##               attrib_typesituation_attribution  
##                                       0.171958  
##                                  fluency_score  
##                                       0.009022  
## attrib_typesituation_attribution:fluency_score  
##                                      -0.025471  
## 
## Degrees of Freedom: 655 Total (i.e. Null);  652 Residual
##   (12 observations deleted due to missingness)
## Null Deviance:       469.4 
## Residual Deviance: 467   AIC: 1340

summary(ca_model4)

## 
## Call:
## glm(formula = attrib_num ~ attrib_type * fluency_score, family = poisson, 
##     data = ca_df)
## 
## Deviance Residuals: 
##     Min       1Q   Median       3Q      Max  
## -1.2797  -1.1737   0.2686   0.3365   2.6617  
## 
## Coefficients:
##                                                 Estimate Std. Error z value
## (Intercept)                                    -0.380372   0.181074  -2.101
## attrib_typesituation_attribution                0.171958   0.258063   0.666
## fluency_score                                   0.009022   0.015700   0.575
## attrib_typesituation_attribution:fluency_score -0.025471   0.022779  -1.118
##                                                Pr(>|z|)  
## (Intercept)                                      0.0357 *
## attrib_typesituation_attribution                 0.5052  
## fluency_score                                    0.5655  
## attrib_typesituation_attribution:fluency_score   0.2635  
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## 
## (Dispersion parameter for poisson family taken to be 1)
## 
##     Null deviance: 469.45  on 655  degrees of freedom
## Residual deviance: 467.00  on 652  degrees of freedom
##   (12 observations deleted due to missingness)
## AIC: 1339.7
## 
## Number of Fisher Scoring iterations: 5

Horizon

Visualization

height

# current calculation:  hz_height = CANVAS_HEIGHT - y

hz_height_ms <- cn_fl_data %>%
  filter(task_name == "HZ") %>% 
  filter(resp_type == "hz_height")
 

ggplot(hz_height_ms, 
       aes(x = fluency_score, y = as.numeric(resp))) + 
  geom_point() +
  ylab("hz height") + 
  xlab("fluency score") + 
  theme_classic() + 
scale_size_area(breaks = seq(0,50,5)) + 
  ggthemes::scale_color_solarized() + 
  theme(legend.position = "bottom")

## Warning: Removed 3 rows containing missing values (geom_point).

### count

hz_stkr_count_ms <- cn_fl_data %>%
  filter(task_name == "HZ") %>% 
  filter(resp_type == "stkr_count")
 

ggplot(hz_stkr_count_ms, 
       aes(x = fluency_score, y = as.numeric(resp))) + 
  geom_point() +
  ylab("stkr_count") + 
  xlab("fluency score") + 
  theme_classic() + 
scale_size_area(breaks = seq(0,50,5)) + 
  ggthemes::scale_color_solarized() + 
  theme(legend.position = "bottom")

## Warning: Removed 3 rows containing missing values (geom_point).

### area

hz_stkr_area_ms <- cn_fl_data %>%
  filter(task_name == "HZ") %>% 
  filter(resp_type == "stkr_area")
 

ggplot(hz_stkr_area_ms, 
       aes(x = fluency_score, y = as.numeric(resp))) + 
  geom_point() +
  ylab("stkr_area") + 
  xlab("fluency score") + 
  theme_classic() + 
scale_size_area(breaks = seq(0,50,5)) + 
  ggthemes::scale_color_solarized() + 
  theme(legend.position = "bottom")

## Warning: Removed 3 rows containing missing values (geom_point).

## Model ### height

HZ_height_df <- cn_fl_data %>% 
  filter(task_name == "HZ", resp_type == "hz_height") %>% 
  mutate(
    height = resp
         ) %>% 
  select(-resp, -task_info, -trial_info)

HZ_height_model <- lm(height ~ fluency_score, 
                      data = HZ_height_df)

summary(HZ_height_model)

## 
## Call:
## lm(formula = height ~ fluency_score, data = HZ_height_df)
## 
## Residuals:
##      Min       1Q   Median       3Q      Max 
## -175.097  -44.197   -9.418   42.223  151.223 
## 
## Coefficients:
##               Estimate Std. Error t value Pr(>|t|)    
## (Intercept)   186.8782    14.4282  12.952   <2e-16 ***
## fluency_score  -0.5801     1.2688  -0.457    0.648    
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## 
## Residual standard error: 66.06 on 163 degrees of freedom
##   (3 observations deleted due to missingness)
## Multiple R-squared:  0.001281,   Adjusted R-squared:  -0.004846 
## F-statistic: 0.209 on 1 and 163 DF,  p-value: 0.6481

count

HZ_stkr_n_df <- cn_fl_data %>% 
  filter(task_name == "HZ", resp_type == "stkr_count") %>% 
  mutate(
    stkr_count = resp
         ) %>% 
  select(-resp, -task_info, -trial_info)

HZ_stkr_n_model <- lm(stkr_count ~ fluency_score, 
                      data = HZ_stkr_n_df)

summary(HZ_stkr_n_model)

## 
## Call:
## lm(formula = stkr_count ~ fluency_score, data = HZ_stkr_n_df)
## 
## Residuals:
##    Min     1Q Median     3Q    Max 
## -8.359 -4.359 -1.441  3.049 19.130 
## 
## Coefficients:
##               Estimate Std. Error t value Pr(>|t|)    
## (Intercept)   12.84850    1.22585  10.481   <2e-16 ***
## fluency_score -0.08158    0.10780  -0.757     0.45    
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## 
## Residual standard error: 5.613 on 163 degrees of freedom
##   (3 observations deleted due to missingness)
## Multiple R-squared:  0.003501,   Adjusted R-squared:  -0.002613 
## F-statistic: 0.5726 on 1 and 163 DF,  p-value: 0.4503

area

HZ_stkr_area_df <- cn_fl_data %>% 
  filter(task_name == "HZ", resp_type == "stkr_area") %>% 
  mutate(
    stkr_area = resp
         ) %>% 
  select(-resp, -task_info, -trial_info)

HZ_stkr_area_model <- lm(stkr_area ~ fluency_score, 
                      data = HZ_stkr_area_df)

summary(HZ_stkr_area_model)

## 
## Call:
## lm(formula = stkr_area ~ fluency_score, data = HZ_stkr_area_df)
## 
## Residuals:
##     Min      1Q  Median      3Q     Max 
## -800755 -278953  -62875  221480  989809 
## 
## Coefficients:
##               Estimate Std. Error t value Pr(>|t|)    
## (Intercept)   897066.8    78703.9  11.398   <2e-16 ***
## fluency_score   -216.8     6921.4  -0.031    0.975    
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## 
## Residual standard error: 360400 on 163 degrees of freedom
##   (3 observations deleted due to missingness)
## Multiple R-squared:  6.02e-06,   Adjusted R-squared:  -0.006129 
## F-statistic: 0.0009813 on 1 and 163 DF,  p-value: 0.975

Ebbinghaus

ebb_df <- cn_fl_data %>% 
  filter(task_name == "EBB", task_info != "HELPFUL") %>% 
  mutate(correct = as.factor(case_when(
    resp == "1" ~ "correct",
    resp == "0" ~ "incorrect")), 
         context = task_info, 
         size_diff = as.numeric(trial_info), 
         ) %>% 
  select(-resp, -task_info, -trial_info)
  
#full model
#ebb_model <- glmer(correct ~ culture * context * size_diff + (size_diff * context | subject), family = binomial, data = ebb_df, control=glmerControl(optimizer="bobyqa"))
#convergence code 1 from bobyqa: bobyqa -- maximum number of function evaluations exceeded
#boundary (singular) fit: see ?isSingular

#model 2 (if full does not converge)
#ebb_model <- glmer(correct ~ fluency_score * context * size_diff + (context | subject), family = binomial, data = ebb_df, control=glmerControl(optimizer="bobyqa"))
#Model failed to converge with max|grad| = 0.0265787 (tol = 0.001, component 1)
#Model is nearly unidentifiable: very large eigenvalue
# - Rescale variables?
#Model is nearly unidentifiable: large eigenvalue ratio
# - Rescale variables?



#model 3
ebb_model <- glmer(correct ~ fluency_score * context * size_diff + ( 1 | subject), family = binomial, data = ebb_df, control=glmerControl(optimizer="bobyqa"))

## Warning in optwrap(optimizer, devfun, start, rho$lower, control = control, :
## convergence code 1 from bobyqa: bobyqa -- maximum number of function evaluations
## exceeded

## Warning in checkConv(attr(opt, "derivs"), opt$par, ctrl = control$checkConv, :
## Model failed to converge with max|grad| = 0.0644532 (tol = 0.001, component 1)

## Warning in checkConv(attr(opt, "derivs"), opt$par, ctrl = control$checkConv, : Model is nearly unidentifiable: very large eigenvalue
##  - Rescale variables?;Model is nearly unidentifiable: large eigenvalue ratio
##  - Rescale variables?

##convergence code 1 from bobyqa: bobyqa -- maximum number of function evaluations exceededModel failed to converge with max|grad| = 0.0644532 (tol = 0.001, component 1)Model is nearly unidentifiable: very large eigenvalue
 #- Rescale variables?;Model is nearly unidentifiable: large eigenvalue ratio
 #- Rescale variables?
ebb_model

## Generalized linear mixed model fit by maximum likelihood (Laplace
##   Approximation) [glmerMod]
##  Family: binomial  ( logit )
## Formula: correct ~ fluency_score * context * size_diff + (1 | subject)
##    Data: ebb_df
##       AIC       BIC    logLik  deviance  df.resid 
##  3360.388  3418.952 -1671.194  3342.388      4941 
## Random effects:
##  Groups  Name        Std.Dev.
##  subject (Intercept) 1.345   
## Number of obs: 4950, groups:  subject, 165
## Fixed Effects:
##                       (Intercept)                      fluency_score  
##                          3.886161                           0.032816  
##                         contextNC                          size_diff  
##                         -5.107697                          -0.277232  
##           fluency_score:contextNC            fluency_score:size_diff  
##                          0.099298                          -0.003572  
##               contextNC:size_diff  fluency_score:contextNC:size_diff  
##                         -0.040994                          -0.032278  
## convergence code 1; 3 optimizer warnings; 0 lme4 warnings

summary(ebb_model)

## Generalized linear mixed model fit by maximum likelihood (Laplace
##   Approximation) [glmerMod]
##  Family: binomial  ( logit )
## Formula: correct ~ fluency_score * context * size_diff + (1 | subject)
##    Data: ebb_df
## Control: glmerControl(optimizer = "bobyqa")
## 
##      AIC      BIC   logLik deviance df.resid 
##   3360.4   3419.0  -1671.2   3342.4     4941 
## 
## Scaled residuals: 
##      Min       1Q   Median       3Q      Max 
## -10.6173  -0.2901  -0.0029   0.3142  20.5996 
## 
## Random effects:
##  Groups  Name        Variance Std.Dev.
##  subject (Intercept) 1.808    1.345   
## Number of obs: 4950, groups:  subject, 165
## 
## Fixed effects:
##                                    Estimate Std. Error z value Pr(>|z|)    
## (Intercept)                        3.886161   0.489560   7.938 2.05e-15 ***
## fluency_score                      0.032816   0.043117   0.761   0.4466    
## contextNC                         -5.107697   0.735411  -6.945 3.77e-12 ***
## size_diff                         -0.277232   0.030977  -8.950  < 2e-16 ***
## fluency_score:contextNC            0.099298   0.066657   1.490   0.1363    
## fluency_score:size_diff           -0.003572   0.002743  -1.302   0.1928    
## contextNC:size_diff               -0.040994   0.160120  -0.256   0.7979    
## fluency_score:contextNC:size_diff -0.032278   0.016587  -1.946   0.0516 .  
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## 
## Correlation of Fixed Effects:
##             (Intr) flncy_ cntxNC sz_dff fl_:NC fln_:_ cnNC:_
## fluency_scr -0.927                                          
## contextNC   -0.450  0.413                                   
## size_diff   -0.748  0.693  0.531                            
## flncy_sc:NC  0.403 -0.432 -0.922 -0.477                     
## flncy_scr:_  0.689 -0.749 -0.486 -0.925  0.510              
## cntxtNC:sz_  0.118 -0.111 -0.736 -0.170  0.724  0.159       
## flncy_:NC:_ -0.095  0.101  0.631  0.136 -0.750 -0.144 -0.904
## convergence code: 1
## Model failed to converge with max|grad| = 0.0644532 (tol = 0.001, component 1)
## Model is nearly unidentifiable: very large eigenvalue
##  - Rescale variables?
## Model is nearly unidentifiable: large eigenvalue ratio
##  - Rescale variables?

Free description

visualization

fd_ms <- cn_fl_data %>%
  filter(task_name == "FD") %>% 
  group_by(resp_type, subject) %>%
  summarise(subject_mean = mean(resp)) %>% 
  left_join(df_fluency_score, by = "subject")

## `summarise()` regrouping output by 'resp_type' (override with `.groups` argument)

first mention

fd_ms %>% 
  filter(resp_type == "first_mention_focal") %>% 
 ggplot( 
       aes(x = fluency_score, y = subject_mean)) + 
  geom_point()+ 
  ylab("Average number of focal first mention per subject") + 
  xlab("Fluency Score") + 
  theme_classic() + 
  ggthemes::scale_color_solarized() + 
  theme(legend.position = "bottom")

## Warning: Removed 3 rows containing missing values (geom_point).

### imada focal

fd_ms %>% 
  filter(resp_type == "imada_focal_description") %>% 
 ggplot( 
       aes(x = fluency_score, y = subject_mean)) + 
  geom_point()+ 
  ylab("Average number of imada focal description per participant") + 
  xlab("Fluency Score") + 
  theme_classic() + 
  ggthemes::scale_color_solarized() + 
  theme(legend.position = "bottom")

## Warning: Removed 3 rows containing missing values (geom_point).

imada background

fd_ms %>% 
  filter(resp_type == "imada_bckgrd_description") %>% 
 ggplot( 
       aes(x = fluency_score, y = subject_mean)) + 
  geom_point()+ 
  ylab("Average number of imada focal description per participant") + 
  xlab("Fluency Score") + 
  theme_classic() + 
  ggthemes::scale_color_solarized() + 
  theme(legend.position = "bottom")

## Warning: Removed 3 rows containing missing values (geom_point).

imada together

fd_ms %>% 
  filter(grepl("imada", resp_type)) %>% 
 ggplot( 
       aes(x = fluency_score, y = subject_mean, color = resp_type)) + 
  geom_point()+ 
  geom_smooth(method = "lm")+
  ylab("Average number of imada focal description per participant") + 
  xlab("Fluency Score") + 
  theme_classic() + 
  ggthemes::scale_color_solarized() + 
  theme(legend.position = "bottom")

## `geom_smooth()` using formula 'y ~ x'

## Warning: Removed 6 rows containing non-finite values (stat_smooth).

## Warning: Removed 6 rows containing missing values (geom_point).

full focal

fd_ms %>% 
  filter(resp_type == "full_focal_description") %>% 
 ggplot( 
       aes(x = fluency_score, y = subject_mean)) + 
  geom_point()+ 
  ylab("Average number of full focal description per participant") + 
  xlab("Fluency Score") + 
  theme_classic() + 
  ggthemes::scale_color_solarized() + 
  theme(legend.position = "bottom")

## Warning: Removed 3 rows containing missing values (geom_point).

full background

fd_ms %>% 
  filter(resp_type == "full_bckgrd_description") %>% 
 ggplot( 
       aes(x = fluency_score, y = subject_mean)) + 
  geom_point()+ 
  ylab("Average number of full background description per participant") + 
  xlab("Fluency Score") + 
  theme_classic() + 
  ggthemes::scale_color_solarized() + 
  theme(legend.position = "bottom")

## Warning: Removed 3 rows containing missing values (geom_point).

full together

fd_ms %>% 
  filter(grepl("full", resp_type)) %>% 
 ggplot( 
       aes(x = fluency_score, y = subject_mean, color = resp_type)) + 
  geom_point()+ 
  geom_smooth(method = "lm")+
  ylab("Average number of descriptions per participant") + 
  xlab("Fluency Score") + 
  theme_classic() + 
  ggthemes::scale_color_solarized() + 
  theme(legend.position = "bottom")

## `geom_smooth()` using formula 'y ~ x'

## Warning: Removed 6 rows containing non-finite values (stat_smooth).

## Warning: Removed 6 rows containing missing values (geom_point).

model

first mention

mention_df <- cn_fl_data %>% 
  filter(task_name == "FD", resp_type == "first_mention_focal") %>% 
    mutate(first_mention = as.factor(case_when(
    resp == "1" ~ "focal",
    resp == "0" ~ "background")), 
    scene = trial_info) %>% 
  select(-resp, -task_info, -resp_type, -trial_info)

#mention_model <- glmer(first_mention ~ fluency_score + (scene | subject), family = binomial, data = mention_df)
#Error: number of observations (=1146) < number of random effects (=1148) for term (scene | subject); the random-effects parameters are probably unidentifiable
#Error: Invalid grouping factor specification, subject

mention_model <- glmer(first_mention ~ fluency_score + (1 | subject), 
                   family = binomial, data = mention_df)

mention_model

## Generalized linear mixed model fit by maximum likelihood (Laplace
##   Approximation) [glmerMod]
##  Family: binomial  ( logit )
## Formula: first_mention ~ fluency_score + (1 | subject)
##    Data: mention_df
##       AIC       BIC    logLik  deviance  df.resid 
## 1448.5583 1463.7138 -721.2791 1442.5583      1152 
## Random effects:
##  Groups  Name        Std.Dev.
##  subject (Intercept) 1.332   
## Number of obs: 1155, groups:  subject, 165
## Fixed Effects:
##   (Intercept)  fluency_score  
##      -0.02258        0.03404

summary(mention_model)

## Generalized linear mixed model fit by maximum likelihood (Laplace
##   Approximation) [glmerMod]
##  Family: binomial  ( logit )
## Formula: first_mention ~ fluency_score + (1 | subject)
##    Data: mention_df
## 
##      AIC      BIC   logLik deviance df.resid 
##   1448.6   1463.7   -721.3   1442.6     1152 
## 
## Scaled residuals: 
##     Min      1Q  Median      3Q     Max 
## -1.9939 -0.7488  0.3868  0.6744  1.7725 
## 
## Random effects:
##  Groups  Name        Variance Std.Dev.
##  subject (Intercept) 1.774    1.332   
## Number of obs: 1155, groups:  subject, 165
## 
## Fixed effects:
##               Estimate Std. Error z value Pr(>|z|)
## (Intercept)   -0.02258    0.35043  -0.064    0.949
## fluency_score  0.03404    0.03091   1.101    0.271
## 
## Correlation of Fixed Effects:
##             (Intr)
## fluency_scr -0.934

descriptive account (imada)

fd_df <- cn_fl_data %>% 
  filter(task_name == "FD") %>% 
  filter(grepl("imada", resp_type)) %>% 
  mutate(description_num = as.numeric(resp),
         description_type = factor(resp_type)) %>% 
  group_by(subject, resp_type) %>% 
  mutate(scene = as.character(row_number())) %>% 
  select(-resp, -task_info, -resp_type, -trial_info)

## Adding missing grouping variables: `resp_type`

#model 0
#fd_model <- lmer(description_num ~ description_type * fluency_score + (description_type | subject) + (fluency_score | scene), data = fd_df)
#boundary (singular) fit: see ?isSingular

#model 1 
fd_model <- lmer(description_num ~ description_type * fluency_score + (description_type | subject) + (1 | scene), data = fd_df)



#fd_model
summary(fd_model)

## Linear mixed model fit by REML ['lmerMod']
## Formula: 
## description_num ~ description_type * fluency_score + (description_type |  
##     subject) + (1 | scene)
##    Data: fd_df
## 
## REML criterion at convergence: 6357.7
## 
## Scaled residuals: 
##     Min      1Q  Median      3Q     Max 
## -2.8454 -0.7289 -0.1250  0.4267  4.8508 
## 
## Random effects:
##  Groups   Name                                    Variance Std.Dev. Corr 
##  subject  (Intercept)                             0.42001  0.6481        
##           description_typeimada_focal_description 0.24814  0.4981   -0.94
##  scene    (Intercept)                             0.01534  0.1238        
##  Residual                                         0.79405  0.8911        
## Number of obs: 2310, groups:  subject, 165; scene, 7
## 
## Fixed effects:
##                                                        Estimate Std. Error
## (Intercept)                                            0.657521   0.166242
## description_typeimada_focal_description               -0.105789   0.150527
## fluency_score                                          0.025227   0.014028
## description_typeimada_focal_description:fluency_score  0.004253   0.013238
##                                                       t value
## (Intercept)                                             3.955
## description_typeimada_focal_description                -0.703
## fluency_score                                           1.798
## description_typeimada_focal_description:fluency_score   0.321
## 
## Correlation of Fixed Effects:
##             (Intr) dsc___ flncy_
## dscrptn_t__ -0.792              
## fluency_scr -0.897  0.771       
## dscrpt___:_  0.740 -0.934 -0.825

descriptive account (full)

fd_df <- cn_fl_data %>% 
  filter(task_name == "FD") %>% 
  filter(grepl("full", resp_type)) %>% 
  mutate(description_num = as.numeric(resp),
         description_type = factor(resp_type)) %>% 
  group_by(subject, resp_type) %>% 
  mutate(scene = as.character(row_number())) %>% 
  select(-resp, -task_info, -resp_type, -trial_info)

## Adding missing grouping variables: `resp_type`

#model 0
#fd_model <- lmer(description_num ~ description_type * fluency_score + (description_type | subject) + (fluency_score | scene), data = fd_df)
#boundary (singular) fit: see ?isSingular

#model 1 
fd_model <- lmer(description_num ~ description_type * fluency_score + (description_type | subject) + (1 | scene), data = fd_df)



#fd_model
summary(fd_model)

## Linear mixed model fit by REML ['lmerMod']
## Formula: 
## description_num ~ description_type * fluency_score + (description_type |  
##     subject) + (1 | scene)
##    Data: fd_df
## 
## REML criterion at convergence: 10311.7
## 
## Scaled residuals: 
##     Min      1Q  Median      3Q     Max 
## -3.7625 -0.6252 -0.1684  0.5205  5.9432 
## 
## Random effects:
##  Groups   Name                                   Variance Std.Dev. Corr 
##  subject  (Intercept)                            3.29721  1.8158        
##           description_typefull_focal_description 2.69183  1.6407   -0.97
##  scene    (Intercept)                            0.04989  0.2234        
##  Residual                                        4.33319  2.0816        
## Number of obs: 2310, groups:  subject, 165; scene, 7
## 
## Fixed effects:
##                                                      Estimate Std. Error
## (Intercept)                                           3.65458    0.44038
## description_typefull_focal_description               -0.88728    0.43297
## fluency_score                                         0.04449    0.03801
## description_typefull_focal_description:fluency_score  0.02060    0.03808
##                                                      t value
## (Intercept)                                            8.299
## description_typefull_focal_description                -2.049
## fluency_score                                          1.171
## description_typefull_focal_description:fluency_score   0.541
## 
## Correlation of Fixed Effects:
##             (Intr) dsc___ flncy_
## dscrptn_t__ -0.876              
## fluency_scr -0.917  0.833       
## dscrpt___:_  0.818 -0.934 -0.892

Explore Demog CN

anjie

1/14/2021

Prep:

RMTS

visualization

model

Ravens

visualization

model

Conformance preference (pens, i.e., stickers)

Symbolic Self inflation

visualization

ratio

diff

Causal attribution

visualization

model

Horizon

Visualization

height

count

area

Ebbinghaus

Free description

visualization

first mention

imada background

imada together

full focal

full background

full together

model

first mention

descriptive account (imada)

descriptive account (full)