Adaptive Connectivity

m.AdaptiveConnectivity.data <- time_series_data %>% 
  filter(OutDegree > 0, State == 'tracking' | State == 'searching', NoMovementTimes < 3) %>% 
  mutate(SignalingType = factor(SignalingType, levels = c('NP', 'VP', 'FP'))) %>%
  mutate(State = factor(State, levels = c('tracking', 'searching'))) %>% 
  select(Participant, SignalingType, ResourceSpeed, State, SocInfoQualityBin, IsGoodSocialInfoAvailable, SocInfoQualityRawBest, VisPlayersDistFromResource, OutDegree)

head(m.AdaptiveConnectivity.data)

Social Information Quality Model

m.AdaptiveConnectivity.formula <- brmsformula(
  SocInfoQualityBin ~ SignalingType * ResourceSpeed * State * IsGoodSocialInfoAvailable + (1 | Participant),
  family = bernoulli(link = "logit")
  )

m.AdaptiveConnectivity.formula_comparison <- brmsformula(
  SocInfoQualityBin ~ SignalingType * ResourceSpeed * State * IsGoodSocialInfoAvailable
  )

m.AdaptiveConnectivity.priors <-
  prior(normal(0, 1), class = "Intercept") +
  prior(normal(0, 0.5), class = b) +
  prior(normal(0, 0.1), class = 'sd')

m.AdaptiveConnectivity.fit <- brm(
  formula = m.AdaptiveConnectivity.formula,
  data    = m.AdaptiveConnectivity.data,
  prior   = m.AdaptiveConnectivity.priors,
  chains = 5,
  cores = 5,
  seed = 4242,
  warmup = 500,
  iter = 2000,
  file = paste0(fits_path, 'adaptive_connectivity_1.rds'),
  backend = "cmdstanr",
  threads = threading(100),
  save_pars = save_pars(all = TRUE)
)

summary(m.AdaptiveConnectivity.fit, ask = F)

##  Family: bernoulli 
##   Links: mu = logit 
## Formula: SocInfoQualityBin ~ SignalingType * ResourceSpeed * State * IsGoodSocialInfoAvailable + (1 | Participant) 
##    Data: m.AdaptiveConnectivity.data (Number of observations: 225600) 
##   Draws: 5 chains, each with iter = 2000; warmup = 500; thin = 1;
##          total post-warmup draws = 7500
## 
## Multilevel Hyperparameters:
## ~Participant (Number of levels: 477) 
##               Estimate Est.Error l-95% CI u-95% CI Rhat Bulk_ESS Tail_ESS
## sd(Intercept)     0.31      0.01     0.29     0.34 1.00     2736     4643
## 
## Regression Coefficients:
##                                                                             Estimate Est.Error l-95% CI u-95% CI Rhat Bulk_ESS Tail_ESS
## Intercept                                                                      -6.48      0.23    -6.95    -6.05 1.00     9643     6047
## SignalingTypeVP                                                                -0.70      0.28    -1.25    -0.16 1.00     9572     5934
## SignalingTypeFP                                                                -0.48      0.28    -1.05     0.05 1.00     9103     5897
## ResourceSpeedslow                                                              -0.71      0.27    -1.26    -0.20 1.00     7093     5968
## Statesearching                                                                 -1.53      0.26    -2.04    -1.01 1.00     8241     6200
## IsGoodSocialInfoAvailable1                                                      7.08      0.23     6.65     7.54 1.00     9835     5942
## SignalingTypeVP:ResourceSpeedslow                                              -0.17      0.32    -0.80     0.45 1.00     8335     5542
## SignalingTypeFP:ResourceSpeedslow                                              -0.39      0.33    -1.03     0.24 1.00     8599     5316
## SignalingTypeVP:Statesearching                                                 -0.23      0.32    -0.86     0.38 1.00    11420     5718
## SignalingTypeFP:Statesearching                                                 -0.18      0.32    -0.83     0.44 1.00     8415     5571
## ResourceSpeedslow:Statesearching                                                0.01      0.34    -0.66     0.67 1.00     9818     5908
## SignalingTypeVP:IsGoodSocialInfoAvailable1                                      0.89      0.28     0.36     1.44 1.00     9171     5997
## SignalingTypeFP:IsGoodSocialInfoAvailable1                                      1.19      0.28     0.65     1.76 1.00     9216     5898
## ResourceSpeedslow:IsGoodSocialInfoAvailable1                                    1.04      0.27     0.54     1.58 1.00     7125     5811
## Statesearching:IsGoodSocialInfoAvailable1                                       1.18      0.26     0.66     1.69 1.00     8259     6003
## SignalingTypeVP:ResourceSpeedslow:Statesearching                               -0.05      0.35    -0.74     0.63 1.00     9922     5737
## SignalingTypeFP:ResourceSpeedslow:Statesearching                                0.08      0.35    -0.60     0.76 1.00    10723     5702
## SignalingTypeVP:ResourceSpeedslow:IsGoodSocialInfoAvailable1                    0.10      0.32    -0.53     0.72 1.00     8221     5396
## SignalingTypeFP:ResourceSpeedslow:IsGoodSocialInfoAvailable1                   -0.08      0.33    -0.72     0.55 1.00     8717     5739
## SignalingTypeVP:Statesearching:IsGoodSocialInfoAvailable1                       0.36      0.32    -0.25     0.98 1.00    11249     5669
## SignalingTypeFP:Statesearching:IsGoodSocialInfoAvailable1                       0.41      0.32    -0.22     1.06 1.00     8379     5669
## ResourceSpeedslow:Statesearching:IsGoodSocialInfoAvailable1                     0.14      0.34    -0.52     0.81 1.00     9879     5829
## SignalingTypeVP:ResourceSpeedslow:Statesearching:IsGoodSocialInfoAvailable1    -0.02      0.35    -0.69     0.67 1.00     9761     5863
## SignalingTypeFP:ResourceSpeedslow:Statesearching:IsGoodSocialInfoAvailable1     0.10      0.35    -0.59     0.79 1.00    10768     5640
## 
## Draws were sampled using sample(hmc). For each parameter, Bulk_ESS
## and Tail_ESS are effective sample size measures, and Rhat is the potential
## scale reduction factor on split chains (at convergence, Rhat = 1).

Model diagnostics

Model predictions

plot(conditional_effects(m.AdaptiveConnectivity.fit, 
                         re_formula = m.AdaptiveConnectivity.formula_comparison),
     points = F, ask = F)

Condition comparisons

m.AdaptiveConnectivity.emmeans_contrast_draws <- m.AdaptiveConnectivity.fit %>%
  emmeans(~ SignalingType * ResourceSpeed * State * IsGoodSocialInfoAvailable, 
          epred = TRUE, 
          re_formula = m.AdaptiveConnectivity.formula_comparison,
          type = "response",
          ) %>%
  contrast(method = "revpairwise", simple = "each", combine = TRUE) %>% 
  gather_emmeans_draws()

ResourceSpeed	State	IsGoodSocialInfoAvailable	SignalingType	contrast	.value	.lower	.upper	.width	.point	.interval
.	searching	1	FP	slow - fast	0.03	0.01	0.05	0.9	mean	hdci
.	searching	1	NP	slow - fast	0.11	0.09	0.14	0.9	mean	hdci
.	searching	1	VP	slow - fast	0.08	0.05	0.10	0.9	mean	hdci
.	tracking	1	FP	slow - fast	-0.02	-0.04	-0.01	0.9	mean	hdci
.	tracking	1	NP	slow - fast	0.07	0.05	0.09	0.9	mean	hdci
.	tracking	1	VP	slow - fast	0.05	0.03	0.07	0.9	mean	hdci
fast	.	1	FP	searching - tracking	-0.02	-0.03	-0.01	0.9	mean	hdci
fast	.	1	NP	searching - tracking	-0.08	-0.10	-0.07	0.9	mean	hdci
fast	.	1	VP	searching - tracking	-0.05	-0.06	-0.04	0.9	mean	hdci
fast	searching	1	.	FP - NP	0.20	0.18	0.23	0.9	mean	hdci
fast	searching	1	.	FP - VP	0.13	0.11	0.15	0.9	mean	hdci
fast	searching	1	.	VP - NP	0.08	0.06	0.10	0.9	mean	hdci
fast	tracking	1	.	FP - NP	0.14	0.12	0.16	0.9	mean	hdci
fast	tracking	1	.	FP - VP	0.10	0.08	0.12	0.9	mean	hdci
fast	tracking	1	.	VP - NP	0.04	0.02	0.07	0.9	mean	hdci
slow	.	1	FP	searching - tracking	0.03	0.02	0.05	0.9	mean	hdci
slow	.	1	NP	searching - tracking	-0.04	-0.06	-0.03	0.9	mean	hdci
slow	.	1	VP	searching - tracking	-0.03	-0.04	-0.01	0.9	mean	hdci
slow	searching	1	.	FP - NP	0.12	0.10	0.15	0.9	mean	hdci
slow	searching	1	.	FP - VP	0.08	0.06	0.11	0.9	mean	hdci
slow	searching	1	.	VP - NP	0.04	0.02	0.06	0.9	mean	hdci
slow	tracking	1	.	FP - NP	0.05	0.03	0.06	0.9	mean	hdci
slow	tracking	1	.	FP - VP	0.02	0.01	0.04	0.9	mean	hdci
slow	tracking	1	.	VP - NP	0.02	0.01	0.04	0.9	mean	hdci

m.AdaptiveConnectivity.comparison.combined_table <- m.AdaptiveConnectivity.comparison %>%
  select(ResourceSpeed, SignalingType, State, IsGoodSocialInfoAvailable, contrast, .value, .lower, .upper) %>%
  mutate(
    ResourceSpeed = ifelse(is.na(ResourceSpeed), ".", as.character(ResourceSpeed)),
    SignalingType = ifelse(is.na(SignalingType), ".", as.character(SignalingType)),
    sig = (.lower * .upper) > 0,
    Estimate = sprintf("%.2f", .value),
    Estimate = ifelse(sig, paste0("\\textbf{", Estimate, "}"), Estimate),
    hpdi = sprintf("[%.2f, %.2f]", .lower, .upper),
    hpdi = ifelse(sig, paste0("\\textbf{", hpdi, "}"), hpdi)
  ) %>%
  select(ResourceSpeed, SignalingType, State, contrast, Estimate, hpdi)  # , IsGoodSocialInfoAvailable

colnames(m.AdaptiveConnectivity.comparison.combined_table) <- c(
  "Resource Speed", "Payoff Condition", "State", "Contrast", "Mean", "90\\% HPDI" # , "Adaptive Social Info Available"
)

kbl <- kable(
  m.AdaptiveConnectivity.comparison.combined_table,
  format = "latex",
  booktabs = TRUE,
  align = c("l", "l", "l", "l", "r", "r"),
  caption = "Posterior Estimates Adaptive Connectivity",
  escape = FALSE
  ) %>% 
    kable_styling(latex_options = "hold_position") %>%
    row_spec(0, bold = TRUE)

unique_speeds <- unique(m.AdaptiveConnectivity.comparison.combined_table$`Resource Speed`)
start <- 1
for (speed in unique_speeds) {
  n_rows <- sum(m.AdaptiveConnectivity.comparison.combined_table$`Resource Speed` == speed)
  if (speed != ".") { 
    kbl <- group_rows(kbl, speed, start, start + n_rows - 1)
  }
  start <- start + n_rows
}

writeLines(kbl, paste0(comparisons, "adaptive_connectiveity_comparison.tex"))

Figure

fig_adaptive_connectivity <- m.AdaptiveConnectivity.draws %>%
  filter(IsGoodSocialInfoAvailable == 1) %>% 
  mutate(State = factor(State, levels = c("searching", "tracking"))) %>%
  ggplot(aes(x     = SignalingType, 
             y     = .epred, 
             color = SignalingType, 
             fill  = SignalingType,
             shape = ResourceSpeed)) +
  ggdist::stat_pointinterval(
    position = position_dodge(width = .55),
    point_interval = "mean_hdci",
    .width = 0.9,
    point_size = 3.6,
    ) + 
  theme_nice(legend.pos = "right") +
  scale_color_manual(breaks = c('A', 'NP', 'VP', 'FP'),
                     aesthetics = c("colour", "fill"),
                     values = c("#000000", "#DF536B", "#61D04F", "#2297E6"), 
                     guide = guide_legend(title = "Signaling"),
                     # alpha = 1 override.aes = list(alpha = 1)
                     ) +
  scale_y_continuous(
    limits  = c(0.5, 0.85),
    expand  = expansion(mult = c(0, 0.04))
  ) +
  theme_clean() +
  theme(legend.position = "none") +
  panel_border() +
  facet_wrap(vars(State), ncol = 2) +
  labs(x = " ", y = "P(Adaptive Social Info)")

fig_adaptive_connectivity