Chapter 4 Compile Results

Once all the models are run, we are ready to compile all their results. By saving the fixed and study-level effects results previously, we are able to simply load those results and ignore the models. However, because we also saved the models, we can also recall and extract information from them if and when needed.

I cannot share the models because the data are stored inside them. Instead, I share posterior samples and will share models with the data slot removed upon request (please email Emorie Beck). We mostly don’t need the models here. The only thing I’ll pull from them are exact sample sizes.

loadRData <- function(fileName, cov, obj, folder){
#loads an RData file, and returns it
    path <- sprintf("%s/results/%s/%s/%s", local_path, folder, cov, fileName)
    load(path)
    get(ls()[grepl(obj, ls())])
}


n_fun <- function(fileName, type){
  m <- loadRData(fileName, type, "^m", "models")
  d <- m$data
  n <- d %>% group_by(study) %>% tally() %>% ungroup()
  return(n)
}

## load in "fixed" effects
## first get file names
nested_mega <- tibble(Covariate = c("fully", "shared", "standard", "butOne", "unadjusted", "standarddx", "shareddx", "sharedint")) %>%
  mutate(file = map(Covariate, ~list.files(sprintf("%s/results/summary/%s", local_path, .)))) %>%
  unnest(file) %>%
  separate(file, c("Outcome", "Trait", "Moderator"), sep = "_", remove = F) %>% 
  filter(!(Outcome == "dementia" & Moderator == "dementia.RData")) %>%
  ## read in the files
  mutate(Moderator = str_remove(Moderator, ".RData")
         , fx = map2(file, Covariate, ~loadRData(.x, .y, "fx", "summary"))
         , rx = map2(file, Covariate, possibly(~loadRData(.x, .y, "rx", "summary"), NA_real_))
         , n = map2(file, Covariate, n_fun)
         ) %>%
  select(-file) %>%
  filter(!is.na(rx))

4.0.1 Tables

Next, we want to format the study results in APA table format. In this case, we are interested in the fixed and study-specific effects of personality predicting cognitive ability when there were no moderators, and the personality x moderator interaction when there was a moderator. We’ll anticipate a need to present both just fixed effects as well as fixed and study-specific effects by creating tables for each.

First, let’s format the data.

tmp <- 
  ### fixed effects 
  nested_mega %>%
  select(-one_of("rx", "n")) %>%
  unnest(fx) %>% # unnesting 
  # keep key terms
  filter((Moderator == "none" & term == "p_value") |
         (Moderator != "none" & grepl("p_value:", term)) & 
          !grepl("cor", term) & !grepl("sd", term)) %>%
  mutate(study = "Overall") %>%
  ### study specific effects 
  full_join(
    nested_mega %>%
      select(-one_of("fx", "n")) %>%
      unnest(rx) %>% # unnesting 
      rename(term = names) %>%
      filter((Moderator == "none" & term == "p_value") |
             (Moderator != "none" & grepl("p_value:", term)))
  ) %>%
  left_join(
    outcomes %>% select(Outcome = short_name, link)
  ) %>%
  # reformatting: mark significance, prettify Trait, covariate, and moderator names
  mutate(sig = ifelse(sign(conf.low) == sign(conf.high), "sig", "ns"),
         Trait = factor(Trait, traits$short_name),
         Outcome = factor(Outcome, outcomes$short_name, outcomes$long_name),
         Moderator = factor(Moderator, moders$short_name, moders$long_name),
         Covariate = factor(Covariate, covars$short_name, str_wrap(covars$long_name, 15)),
         term = str_remove_all(term, "p_value:"),
         term = factor(term, moders$short_term, moders$long_term)) %>%
  mutate_at(vars(estimate, conf.low, conf.high), ~ifelse(link == "factor", exp(.), .))
  # prettify the number format
nested_mega_tab <- tmp %>%
  mutate_at(vars(estimate, conf.low, conf.high), 
            ~ifelse(abs(.) < .0014, sprintf("%.3f", .), sprintf("%.2f", .))) %>%
  # combine the effects, bold significance, factor and label study-specfic effects 
  mutate(est = sprintf("%s<br>[%s, %s]", estimate, conf.low, conf.high),
         est = ifelse(sig == "sig", sprintf("<strong>%s</strong>", est), est),
         study = mapvalues(study, c("RADC-MAP", "ADRC"), c("Rush-MAP", "WUSM-MAP")),
         study = factor(study, levels = c(studies_long, "Overall"),
                        labels = c(studies_long, "Overall"))) %>%
  # reshaping: remove extra columns, arrange by key variables, and make wide
  select(Outcome, Trait, Moderator, Covariate, study, term, est) %>%
  arrange(Outcome, Trait, Moderator, Covariate, study, term, est) %>%
  pivot_wider(names_from = "Outcome", values_from = "est") 
nested_mega_tab

## # A tibble: 1,855 × 16
##    Trait Moderator Covariate      study term  Incident Dementia Di…¹ `Braak Stage` CERAD `Lewy Body Disease`
##    <fct> <fct>     <fct>          <fct> <fct> <chr>                  <chr>         <chr> <chr>              
##  1 E     None      Unadjusted     ROS   Pers… 0.95<br>[0.89, 1.01]   0.04<br>[-0.… -0.0… 1.04<br>[0.96, 1.1…
##  2 E     None      Unadjusted     Rush… Pers… 0.95<br>[0.90, 1.00]   0.02<br>[-0.… <str… 0.99<br>[0.91, 1.0…
##  3 E     None      Unadjusted     EAS   Pers… 0.93<br>[0.85, 1.04]   0.001<br>[-0… <NA>  0.99<br>[0.84, 1.1…
##  4 E     None      Unadjusted     WUSM… Pers… <strong>0.93<br>[0.88… <strong>-0.1… -0.0… 1.04<br>[0.94, 1.1…
##  5 E     None      Unadjusted     SATSA Pers… 0.93<br>[0.84, 1.05]   <NA>          <NA>  <NA>               
##  6 E     None      Unadjusted     HRS   Pers… <strong>0.95<br>[0.92… <NA>          <NA>  <NA>               
##  7 E     None      Unadjusted     LISS  Pers… 0.91<br>[0.78, 1.12]   <NA>          <NA>  <NA>               
##  8 E     None      Unadjusted     GSOEP Pers… <strong>0.84<br>[0.77… <NA>          <NA>  <NA>               
##  9 E     None      Unadjusted     Over… Pers… 0.93<br>[0.87, 1.00]   -0.01<br>[-0… -0.0… 1.02<br>[0.90, 1.1…
## 10 E     None      Fully Adjusted EAS   Pers… 0.83<br>[0.59, 1.10]   <NA>          <NA>  <NA>               
## # ℹ 1,845 more rows
## # ℹ abbreviated name: ¹​`Incident Dementia Diagnosis`
## # ℹ 7 more variables: `Gross Cerebral Infarcts` <chr>, `Gross Cerebral Microinfarcts` <chr>,
## #   `Cerebral Atherosclerosis` <chr>, `Cerebral Amyloid Angiopathy` <chr>, Arteriolosclerosis <chr>,
## #   `Hippocampal Sclerosis` <chr>, `TDP-43` <chr>

Now that we’ve formatted the values, we can group by moderators and save results as separate tables. Even though additional information could be included given that we have one outcome, we’ll stick with this split because it will make it easier for those using this tutorial who multiple traits, outcomes, covariates, and moderators.

4.0.1.1 Fixed Effects

First, here’s the overall estimates and credible intervals, split by moderators. These show the estimates across all different covariate sets.

## table function 
ipd_tab_fun <- function(d, moder){
  md <- mapvalues(moder, moders$long_name, moders$short_name, warn_missing = F)
  rs <- d %>% 
    mutate(Trait = factor(Trait, traits$short_name, traits$long_name)) %>%
    group_by(Trait) %>% tally() %>% 
    mutate(end = cumsum(n), start = lag(end) + 1, start = ifelse(is.na(start), 1, start))
  cs <- rep(1,12)
  names(cs) <- c(" ", paste0("<strong>", outcomes$long_name, "</strong>"))
  cln <- mapvalues(colnames(d)[colnames(d) %in% outcomes$long_name], outcomes$long_name, outcomes$colnm, warn_missing = F)
  cln <- c("Covariates", cln)
  # cln <- if(length(unique(d$term)) == 1) c("Covariates", rep("<em>b</em> [CI]", 9)) else c("Covariates", "Term", rep("<em>b</em> [CI]", 9))
  al <- c("r", rep("c", 11)) 
  d <- d %>% select(-term)
  fn <- paste(covars$desc, collapse = " ")
  cap <- if(md == "none") "<strong>Table X</strong><br><em>Overall Effects of Personality-Dementia Diagnosis and Neuropathology Associations</em>" else sprintf("<strong>Table X</strong><br><em>Overall %s Moderation of Personality-Dementia Diagnosis and Neuropathology Associations</em>", md)
  tab <- d %>%
    arrange(Trait) %>%
    select(-Trait) %>%
    kable(., "html"
    # kable(., "latex"
          , booktabs = T
          , escape = F
          , col.names = cln
          , align = al
          , caption = cap
    ) %>% 
    kable_classic(full_width = F, html_font = "Times New Roman") %>%
    add_header_above(cs, escape = F) %>%
    footnote(fn)
  for (i in 1:nrow(rs)) {
    tab <- tab %>% kableExtra::group_rows(rs$Trait[i], rs$start[i], rs$end[i])
  }
  save_kable(tab, file = sprintf("%s/results/tables/overall/%s.html"
                                 , local_path, md))
  return(tab)
}

ipd_fx_tab <- nested_mega_tab %>%
  filter(study == "Overall") %>%
  select(-study) %>%
  group_by(Moderator) %>%
  nest() %>%
  ungroup() %>%
  mutate(tab = pmap(list(data, Moderator), ipd_tab_fun))

# save(ipd2b_reg_tab, ipd2b_res, file = sprintf("%s/manuscript/results/ipd2b_fx_tab.RData", res_path))

(ipd_fx_tab %>% filter(Moderator == "None"))$tab[[1]]

Table 4.1: Table X
Overall Effects of Personality-Dementia Diagnosis and Neuropathology Associations

	Incident Dementia Diagnosis	Braak Stage	CERAD	Lewy Body Disease	Gross Cerebral Infarcts	Gross Cerebral Microinfarcts	Cerebral Atherosclerosis	Cerebral Amyloid Angiopathy	Arteriolosclerosis	Hippocampal Sclerosis	TDP-43
Covariates	OR [CI]	b [CI]	b [CI]	OR [CI]	OR [CI]	OR [CI]	b [CI]	b [CI]	b [CI]	OR [CI]	OR [CI]
Extraversion
Unadjusted	0.93 [0.87, 1.00]	-0.01 [-0.14, 0.13]	-0.03 [-0.11, 0.05]	1.02 [0.90, 1.15]	0.95 [0.79, 1.26]	0.96 [0.84, 1.14]	-0.01 [-0.08, 0.05]	0.02 [-0.05, 0.15]	-0.01 [-0.08, 0.05]	0.97 [0.83, 1.11]	1.00 [0.82, 1.17]
Fully Adjusted	1.00 [0.58, 1.86]
Shared Covariates Adjusted	0.97 [0.93, 1.02]	-0.000 [-0.13, 0.14]	-0.04 [-0.10, 0.05]	1.01 [0.88, 1.12]	0.95 [0.76, 1.34]	0.97 [0.83, 1.13]	0.00 [-0.06, 0.08]	0.02 [-0.04, 0.07]	-0.01 [-0.08, 0.07]	0.97 [0.83, 1.10]	1.01 [0.80, 1.18]
Standard Covariates Adjusted	0.97 [0.93, 1.02]				1.05 [0.68, 2.07]	0.98 [0.80, 1.20]
All But One Covariate Adjusted	0.99 [0.93, 1.05]	-0.01 [-0.16, 0.13]	-0.03 [-0.14, 0.05]	1.00 [0.82, 1.12]	0.97 [0.72, 1.33]	0.97 [0.82, 1.22]	0.00 [-0.05, 0.06]	0.02 [-0.07, 0.12]	-0.01 [-0.06, 0.03]	0.96 [0.74, 1.14]	1.02 [0.85, 1.22]
Shared Covariates Adjusted (With Prediction Interval)	0.95 [0.92, 0.99]	-0.01 [-0.28, 0.15]	-0.03 [-0.10, 0.03]	1.01 [0.91, 1.14]	1.03 [0.70, 1.99]	0.96 [0.83, 1.08]	0.01 [-0.06, 0.09]	0.02 [-0.04, 0.07]	-0.01 [-0.07, 0.09]	0.96 [0.82, 1.16]	1.00 [0.79, 1.22]
Shared Covariates Adjusted (With Dementia Diagnosis)		-0.10 [-1.08, 0.78]		1.02 [0.18, 7.57]						1.24 [0.35, 7.66]
Standard Covariates Adjusted (With Dementia Diagnosis)		-0.13 [-1.13, 1.39]		1.00 [0.19, 6.68]						1.42 [0.33, 6.43]
Agreeableness
Unadjusted	1.00 [0.92, 1.11]	0.000 [-0.15, 0.21]	-0.01 [-0.20, 0.21]	1.04 [0.75, 1.75]	0.91 [0.32, 2.14]	1.03 [0.73, 1.46]	-0.02 [-0.36, 0.33]	0.01 [-0.16, 0.19]	0.000 [-0.17, 0.19]	1.00 [0.68, 1.48]	0.97 [0.68, 1.36]
Fully Adjusted	1.04 [0.73, 1.55]
Shared Covariates Adjusted	0.97 [0.92, 1.03]	-0.02 [-0.15, 0.10]	-0.02 [-0.30, 0.15]	0.99 [0.83, 1.23]	1.08 [0.40, 2.48]	1.07 [0.77, 1.52]	-0.02 [-0.19, 0.16]	0.02 [-0.21, 0.25]	0.02 [-0.19, 0.30]	1.02 [0.66, 1.75]	0.99 [0.74, 1.44]
Standard Covariates Adjusted	0.97 [0.92, 1.03]				1.03 [0.42, 3.44]	1.13 [0.72, 1.80]
All But One Covariate Adjusted	0.99 [0.90, 1.10]	-0.02 [-0.16, 0.10]	-0.06 [-0.32, 0.18]	0.98 [0.82, 1.23]	1.03 [0.42, 2.55]	1.07 [0.65, 1.58]	-0.01 [-0.23, 0.24]	-0.01 [-0.26, 0.21]	0.04 [-0.16, 0.32]	1.01 [0.63, 1.78]	0.98 [0.65, 1.33]
Shared Covariates Adjusted (With Prediction Interval)	0.96 [0.92, 1.01]	-0.02 [-0.13, 0.09]	-0.02 [-0.29, 0.22]	0.99 [0.76, 1.37]	1.15 [0.42, 3.24]	1.09 [0.61, 1.74]	-0.01 [-0.19, 0.16]	0.00 [-0.32, 0.20]	-0.00 [-0.38, 0.17]	1.00 [0.61, 1.62]	0.98 [0.68, 1.50]
Shared Covariates Adjusted (With Dementia Diagnosis)		0.00 [-1.00, 1.11]		7.29 [0.84, 168.03]						1.20 [0.32, 6.05]
Standard Covariates Adjusted (With Dementia Diagnosis)		-0.01 [-1.02, 1.02]		7.65 [0.88, 250.91]						1.43 [0.39, 7.70]
Conscientiousness
Unadjusted	0.87 [0.83, 0.93]	-0.04 [-0.11, 0.02]	0.03 [-0.07, 0.12]	0.97 [0.82, 1.14]	1.01 [0.81, 1.45]	1.03 [0.84, 1.29]	-0.01 [-0.06, 0.04]	-0.01 [-0.08, 0.06]	-0.02 [-0.09, 0.05]	1.04 [0.86, 1.27]	1.00 [0.76, 1.16]
Fully Adjusted	0.96 [0.65, 1.47]
Shared Covariates Adjusted	0.88 [0.85, 0.92]	-0.04 [-0.11, 0.02]	0.03 [-0.06, 0.12]	0.95 [0.67, 1.22]	1.02 [0.83, 1.28]	1.06 [0.84, 1.37]	-0.01 [-0.12, 0.05]	-0.03 [-0.16, 0.07]	-0.02 [-0.11, 0.07]	1.06 [0.88, 1.30]	1.02 [0.85, 1.19]
Standard Covariates Adjusted	0.88 [0.84, 0.91]				1.12 [0.75, 2.12]	1.08 [0.86, 1.42]
All But One Covariate Adjusted	0.91 [0.86, 0.95]	-0.05 [-0.12, 0.01]	0.03 [-0.09, 0.12]	0.97 [0.84, 1.11]	1.07 [0.76, 1.46]	1.04 [0.79, 1.38]	-0.001 [-0.06, 0.07]	0.01 [-0.06, 0.12]	-0.04 [-0.10, 0.04]	1.06 [0.85, 1.30]	1.01 [0.84, 1.18]
Shared Covariates Adjusted (With Prediction Interval)	0.86 [0.83, 0.90]	-0.05 [-0.14, 0.02]	0.03 [-0.07, 0.14]	0.99 [0.81, 1.32]	1.01 [0.64, 1.92]	1.05 [0.83, 1.35]	0.00 [-0.05, 0.07]	0.02 [-0.06, 0.13]	-0.02 [-0.09, 0.04]	1.05 [0.85, 1.35]	1.01 [0.87, 1.21]
Shared Covariates Adjusted (With Dementia Diagnosis)		-0.20 [-1.37, 0.95]		2.14 [0.42, 22.67]						2.79 [0.46, 58.48]
Standard Covariates Adjusted (With Dementia Diagnosis)		-0.14 [-1.09, 0.98]		2.43 [0.44, 21.69]						2.09 [0.46, 13.45]
Neuroticism
Unadjusted	1.11 [1.05, 1.17]	0.02 [-0.10, 0.11]	-0.001 [-0.09, 0.10]	1.00 [0.86, 1.16]	0.98 [0.81, 1.26]	0.99 [0.86, 1.13]	0.01 [-0.04, 0.06]	0.02 [-0.06, 0.10]	0.01 [-0.08, 0.10]	1.01 [0.85, 1.16]	1.03 [0.88, 1.20]
Fully Adjusted	1.60 [0.67, 5.76]
Shared Covariates Adjusted	1.10 [1.06, 1.14]	0.04 [-0.09, 0.21]	-0.03 [-0.18, 0.07]	1.01 [0.86, 1.16]	0.96 [0.52, 1.35]	0.98 [0.86, 1.13]	0.01 [-0.05, 0.06]	-0.00 [-0.10, 0.07]	0.01 [-0.07, 0.09]	1.02 [0.87, 1.20]	1.03 [0.88, 1.19]
Standard Covariates Adjusted	1.10 [1.05, 1.13]				1.04 [0.61, 2.24]	0.97 [0.81, 1.11]
All But One Covariate Adjusted	1.08 [1.03, 1.13]	-0.18 [-0.79, 0.11]	-0.01 [-0.12, 0.09]	1.00 [0.86, 1.15]	0.97 [0.70, 1.32]	0.99 [0.85, 1.21]	0.01 [-0.06, 0.08]	0.001 [-0.07, 0.07]	0.00 [-0.07, 0.08]	1.01 [0.84, 1.17]	1.02 [0.88, 1.18]
Shared Covariates Adjusted (With Prediction Interval)	1.12 [1.07, 1.16]	0.04 [-0.11, 0.31]	-0.01 [-0.11, 0.09]	1.00 [0.77, 1.16]	1.13 [0.67, 2.31]	0.99 [0.85, 1.13]	0.02 [-0.05, 0.09]	0.01 [-0.07, 0.08]	0.01 [-0.07, 0.10]	1.03 [0.87, 1.21]	1.03 [0.88, 1.20]
Shared Covariates Adjusted (With Dementia Diagnosis)		-0.12 [-1.07, 0.80]		0.77 [0.05, 10.83]						1.74 [0.33, 34.37]
Standard Covariates Adjusted (With Dementia Diagnosis)		-0.14 [-1.37, 0.77]		0.84 [0.09, 10.61]						1.10 [0.34, 4.99]
Openness to Experience
Unadjusted	0.87 [0.78, 0.97]	-0.04 [-0.24, 0.06]	-0.03 [-0.20, 0.13]	1.02 [0.86, 1.20]	0.94 [0.47, 2.04]	0.90 [0.52, 1.34]	-0.03 [-0.32, 0.25]	-0.02 [-0.21, 0.12]	-0.07 [-0.40, 0.18]	0.98 [0.77, 1.22]	1.00 [0.74, 1.35]
Fully Adjusted	0.96 [0.50, 2.02]
Shared Covariates Adjusted	0.95 [0.90, 1.02]	-0.01 [-0.10, 0.10]	-0.08 [-0.41, 0.15]	1.03 [0.83, 1.32]	0.90 [0.42, 2.13]	0.95 [0.69, 1.53]	-0.05 [-0.21, 0.16]	-0.03 [-0.36, 0.20]	-0.05 [-0.40, 0.26]	1.02 [0.78, 1.30]	1.02 [0.78, 1.32]
Standard Covariates Adjusted	0.95 [0.90, 1.02]				1.05 [0.35, 3.13]	0.94 [0.63, 1.48]
All But One Covariate Adjusted	0.97 [0.86, 1.06]	0.000 [-0.09, 0.08]	-0.03 [-0.23, 0.19]	1.03 [0.86, 1.32]	1.03 [0.46, 2.68]	0.96 [0.68, 1.34]	-0.02 [-0.18, 0.15]	-0.02 [-0.18, 0.18]	-0.03 [-0.29, 0.27]	1.02 [0.77, 1.32]	1.03 [0.73, 1.67]
Shared Covariates Adjusted (With Prediction Interval)	0.95 [0.90, 1.00]	-0.02 [-0.13, 0.08]	-0.03 [-0.21, 0.15]	1.03 [0.77, 1.32]	1.09 [0.37, 3.15]	0.94 [0.69, 1.43]	-0.03 [-0.26, 0.12]	-0.06 [-0.19, 0.15]	-0.05 [-0.42, 0.25]	1.03 [0.75, 1.50]	1.02 [0.76, 1.39]
Shared Covariates Adjusted (With Dementia Diagnosis)		-0.11 [-1.23, 0.79]		7.28 [0.98, 238.12]						0.94 [0.17, 5.92]
Standard Covariates Adjusted (With Dementia Diagnosis)		-0.22 [-1.77, 0.81]		7.22 [1.00, 196.99]						0.98 [0.19, 7.35]
Positive Affect
Unadjusted	0.92 [0.81, 1.05]	0.00 [-0.17, 0.25]	0.00 [-0.22, 0.21]	0.97 [0.70, 1.28]	0.97 [0.68, 1.35]	1.01 [0.73, 1.37]	0.01 [-0.19, 0.15]	0.03 [-0.17, 0.26]	-0.01 [-0.21, 0.24]	1.11 [0.77, 1.76]	1.19 [0.78, 2.30]
Fully Adjusted	1.10 [0.51, 2.83]
Shared Covariates Adjusted	0.93 [0.88, 1.00]	-0.03 [-0.31, 0.17]	0.01 [-0.16, 0.16]	0.89 [0.61, 1.37]	1.03 [0.80, 1.33]	1.04 [0.76, 1.35]	-0.03 [-0.29, 0.09]	0.01 [-0.24, 0.20]	0.07 [-0.15, 0.33]	1.08 [0.74, 1.64]	1.04 [0.66, 1.53]
Standard Covariates Adjusted	0.93 [0.87, 0.99]					0.98 [0.63, 1.44]
All But One Covariate Adjusted	0.94 [0.75, 1.12]	-0.000 [-0.23, 0.33]	0.00 [-0.24, 0.19]	0.98 [0.74, 1.34]	1.06 [0.81, 1.47]	1.01 [0.75, 1.29]	0.01 [-0.21, 0.27]	0.02 [-0.17, 0.20]	-0.03 [-0.28, 0.15]	1.10 [0.76, 1.68]	1.02 [0.69, 1.42]
Shared Covariates Adjusted (With Prediction Interval)	0.93 [0.87, 0.99]	-0.05 [-0.36, 0.18]	0.00 [-0.26, 0.17]	1.01 [0.67, 1.45]	1.07 [0.80, 1.83]	1.02 [0.74, 1.45]	0.01 [-0.15, 0.15]	0.03 [-0.12, 0.19]	-0.01 [-0.18, 0.18]	1.09 [0.72, 1.70]	1.05 [0.71, 1.54]
Negative Affect
Unadjusted	1.10 [1.00, 1.20]	-0.05 [-1.49, 0.99]	-0.06 [-1.13, 0.97]	0.98 [0.26, 3.32]	0.94 [0.26, 3.05]	1.05 [0.29, 3.92]	0.00 [-1.09, 1.19]	-0.09 [-0.91, 0.82]	0.05 [-0.95, 0.97]	0.94 [0.22, 3.84]	1.11 [0.29, 4.16]
Fully Adjusted	1.09 [0.36, 4.11]
Shared Covariates Adjusted	1.14 [1.02, 1.26]	-0.03 [-1.23, 1.15]	-0.14 [-1.42, 1.29]	0.98 [0.21, 4.67]	1.07 [0.27, 4.56]	1.03 [0.17, 4.73]	-0.03 [-1.26, 1.08]	0.19 [-1.35, 1.71]	-0.02 [-1.30, 1.04]	0.96 [0.21, 3.79]	0.95 [0.27, 4.88]
Standard Covariates Adjusted	1.14 [1.01, 1.28]					1.01 [0.28, 3.19]
All But One Covariate Adjusted	1.05 [0.73, 1.24]	-0.10 [-1.51, 1.03]	-0.10 [-1.31, 0.95]	1.05 [0.28, 6.00]	0.81 [0.14, 3.93]	1.12 [0.31, 15.58]	0.04 [-1.31, 1.10]	-0.72 [-3.13, 1.06]	-0.04 [-1.55, 1.33]	1.02 [0.30, 4.10]	0.95 [0.26, 5.63]
Shared Covariates Adjusted (With Prediction Interval)	1.14 [1.00, 1.27]	-0.11 [-1.65, 1.09]	-0.09 [-1.26, 1.01]	1.04 [0.33, 3.79]	1.02 [0.26, 4.16]	1.14 [0.24, 4.75]	0.00 [-1.30, 1.12]	-0.01 [-1.28, 1.19]	-0.08 [-1.32, 1.09]	1.16 [0.26, 8.64]	1.03 [0.26, 4.26]
Satisfaction with Life
Unadjusted	0.92 [0.80, 1.05]	-0.01 [-0.22, 0.18]	-0.07 [-0.29, 0.18]	1.04 [0.77, 1.41]	0.99 [0.72, 1.31]	1.06 [0.72, 1.67]	0.01 [-0.13, 0.13]	0.02 [-0.14, 0.19]	0.000 [-0.24, 0.24]	0.87 [0.38, 1.71]	1.07 [0.83, 1.47]
Fully Adjusted	1.05 [0.37, 2.25]
Shared Covariates Adjusted	0.93 [0.84, 1.03]	0.000 [-0.33, 0.26]	0.01 [-0.40, 0.53]	1.07 [0.79, 1.49]	0.98 [0.72, 1.36]	1.08 [0.73, 1.71]	-0.01 [-0.23, 0.18]	0.01 [-0.17, 0.23]	-0.02 [-0.20, 0.17]	0.91 [0.34, 2.26]	1.10 [0.78, 1.53]
Standard Covariates Adjusted	0.92 [0.83, 1.01]					1.05 [0.64, 1.60]
All But One Covariate Adjusted	0.94 [0.75, 1.13]	0.00 [-0.21, 0.23]	0.00 [-0.27, 0.27]	1.06 [0.68, 1.64]	0.99 [0.69, 1.52]	1.09 [0.76, 1.59]	0.09 [-0.08, 0.29]	0.00 [-0.22, 0.23]	-0.00 [-0.20, 0.20]	0.89 [0.36, 2.31]	1.11 [0.85, 1.50]
Shared Covariates Adjusted (With Prediction Interval)	0.93 [0.85, 1.01]	0.01 [-0.29, 0.31]	-0.00 [-0.26, 0.23]	1.05 [0.78, 1.47]	1.15 [0.69, 2.22]	1.10 [0.74, 2.08]	0.02 [-0.20, 0.20]	0.001 [-0.35, 0.35]	0.00 [-0.28, 0.28]	0.79 [0.40, 2.17]	1.22 [0.85, 1.90]
Note:
Unadjusted indicates no covariates were included. Fully adjusted models include age, gender, education, smoking status, alcohol use, cognitive ability, race, chronic conditions, BMI, and self-rated health. Shared covariates adjusted models Include age, gender, education, smoking status, alcohol use. Standard covariates adjusted models include age, gender, and education. All but one covariate adjusted models include age, gender, education, cognitive ability, and chronic conditions. Shared covariates with dementia adjusted models Include age, gender, education, smoking status, alcohol use, and dementia diagnosis. Standard covariates with dementia adjusted models include age, gender, education, and incident dementia diagnosis. Shared covariates with prediction interval adjusted models Include age, gender, education, smoking status, alcohol use, and prediction interval.

(ipd_fx_tab %>% filter(Moderator == "Dementia Diagnosis"))$tab[[1]]

Table 4.1: Table X
Overall dementia Moderation of Personality-Dementia Diagnosis and Neuropathology Associations

	Incident Dementia Diagnosis	Braak Stage	CERAD	Lewy Body Disease	Gross Cerebral Infarcts	Gross Cerebral Microinfarcts	Cerebral Atherosclerosis	Cerebral Amyloid Angiopathy	Arteriolosclerosis	Hippocampal Sclerosis	TDP-43
Covariates	OR [CI]	b [CI]	b [CI]	OR [CI]	OR [CI]	OR [CI]	b [CI]	b [CI]	b [CI]	OR [CI]	OR [CI]
Extraversion
Unadjusted		0.06 [-0.05, 0.17]	-0.10 [-0.57, 0.30]	1.03 [0.87, 1.22]	1.05 [0.65, 2.05]	1.10 [0.90, 1.38]	0.02 [-0.04, 0.09]	0.01 [-0.09, 0.11]	0.01 [-0.10, 0.11]	0.96 [0.71, 1.32]	1.02 [0.75, 1.38]
Shared Covariates Adjusted		0.06 [-0.08, 0.19]	0.04 [-0.27, 0.35]	1.02 [0.86, 1.22]	1.07 [0.59, 2.17]	1.16 [0.93, 1.79]	0.02 [-0.04, 0.08]	0.03 [-0.05, 0.12]	0.03 [-0.07, 0.26]	1.03 [0.73, 1.57]	1.01 [0.72, 1.33]
Standard Covariates Adjusted		0.07 [-0.09, 0.26]	0.04 [-0.28, 0.37]	1.04 [0.86, 1.24]	1.04 [0.61, 2.09]	1.12 [0.84, 1.44]	0.02 [-0.07, 0.15]	0.02 [-0.08, 0.12]	0.01 [-0.10, 0.13]	0.94 [0.70, 1.28]	1.02 [0.83, 1.32]
All But One Covariate Adjusted		0.06 [-0.07, 0.18]	0.04 [-0.26, 0.36]	1.02 [0.86, 1.23]	1.10 [0.67, 2.35]	1.15 [0.92, 1.49]	0.03 [-0.05, 0.10]	0.03 [-0.06, 0.13]	-0.00 [-0.30, 0.19]	1.01 [0.73, 1.41]	1.01 [0.76, 1.36]
Shared Covariates Adjusted (With Prediction Interval)		0.04 [-0.09, 0.18]	0.04 [-0.37, 0.61]	1.01 [0.84, 1.23]	1.07 [0.62, 2.65]	1.13 [0.90, 1.40]	0.03 [-0.07, 0.15]	0.04 [-0.06, 0.20]	0.02 [-0.07, 0.12]	1.02 [0.73, 1.41]	1.01 [0.74, 1.44]
Agreeableness
Unadjusted		0.01 [-0.28, 0.20]	-0.01 [-0.59, 0.55]	1.09 [0.70, 1.83]	1.07 [0.31, 4.83]	0.95 [0.47, 2.11]	-0.03 [-0.80, 0.49]	0.00 [-0.33, 0.31]	-0.02 [-0.40, 0.35]	1.09 [0.59, 2.56]	1.23 [0.56, 2.82]
Shared Covariates Adjusted		0.06 [-0.18, 0.27]	-0.03 [-0.65, 0.63]	1.13 [0.76, 1.79]	1.09 [0.34, 4.27]	0.96 [0.59, 2.10]	0.01 [-0.29, 0.36]	0.01 [-0.39, 0.51]	-0.02 [-0.44, 0.40]	1.01 [0.51, 2.05]	1.30 [0.57, 6.23]
Standard Covariates Adjusted		0.04 [-0.18, 0.26]	-0.00 [-0.59, 0.59]	1.15 [0.82, 1.72]	1.14 [0.28, 5.30]	0.98 [0.43, 2.19]	0.03 [-0.45, 0.42]	0.001 [-0.44, 0.39]	-0.09 [-0.69, 0.32]	1.03 [0.52, 2.20]	1.16 [0.53, 2.58]
All But One Covariate Adjusted		0.06 [-0.14, 0.26]	-0.04 [-0.69, 0.58]	1.15 [0.83, 1.67]	1.06 [0.22, 5.10]	0.96 [0.39, 2.14]	0.001 [-0.38, 0.26]	-0.01 [-0.37, 0.38]	-0.01 [-0.43, 0.47]	0.99 [0.50, 1.94]	1.17 [0.56, 2.58]
Shared Covariates Adjusted (With Prediction Interval)		0.05 [-0.15, 0.25]	-0.03 [-0.63, 0.56]	1.11 [0.75, 1.65]	1.08 [0.30, 4.40]	1.01 [0.43, 4.15]	0.05 [-0.37, 0.34]	-0.01 [-0.50, 0.36]	-0.02 [-0.49, 0.43]	0.99 [0.53, 2.01]	1.18 [0.59, 2.54]
Conscientiousness
Unadjusted		0.09 [-0.04, 0.24]	-0.04 [-0.28, 0.19]	1.02 [0.82, 1.26]	1.10 [0.66, 2.22]	1.14 [0.90, 1.46]	0.04 [-0.03, 0.12]	0.01 [-0.08, 0.11]	0.02 [-0.09, 0.14]	0.90 [0.63, 1.30]	1.08 [0.87, 1.37]
Shared Covariates Adjusted		0.11 [-0.08, 0.30]	-0.06 [-0.28, 0.15]	1.05 [0.84, 1.31]	1.10 [0.66, 2.06]	1.17 [0.93, 1.52]	0.04 [-0.06, 0.11]	0.03 [-0.07, 0.19]	0.001 [-0.12, 0.10]	0.88 [0.58, 1.32]	1.04 [0.82, 1.31]
Standard Covariates Adjusted		0.10 [-0.08, 0.28]	-0.04 [-0.31, 0.24]	1.02 [0.81, 1.29]	1.08 [0.62, 2.22]	1.12 [0.87, 1.46]	0.03 [-0.07, 0.14]	0.03 [-0.06, 0.12]	0.02 [-0.10, 0.13]	0.91 [0.63, 1.63]	1.05 [0.82, 1.36]
All But One Covariate Adjusted		0.12 [-0.03, 0.26]	-0.09 [-0.29, 0.14]	1.06 [0.84, 1.30]	1.10 [0.63, 2.26]	1.16 [0.82, 1.49]	0.03 [-0.06, 0.14]	0.02 [-0.14, 0.12]	0.00 [-0.11, 0.11]	0.88 [0.56, 1.33]	1.03 [0.82, 1.32]
Shared Covariates Adjusted (With Prediction Interval)		0.10 [-0.07, 0.26]	-0.05 [-0.29, 0.22]	1.06 [0.84, 1.32]	1.09 [0.65, 2.19]	1.15 [0.89, 1.49]	0.03 [-0.07, 0.15]	0.03 [-0.06, 0.14]	0.00 [-0.12, 0.12]	0.86 [0.57, 1.28]	1.00 [0.78, 1.31]
Neuroticism
Unadjusted		-0.05 [-0.20, 0.08]	0.02 [-0.21, 0.26]	1.08 [0.81, 1.39]	1.02 [0.62, 1.99]	0.92 [0.73, 1.22]	-0.04 [-0.13, 0.04]	0.01 [-0.10, 0.14]	0.01 [-0.12, 0.14]	0.92 [0.66, 1.28]	0.99 [0.72, 1.35]
Shared Covariates Adjusted		-0.08 [-0.24, 0.05]	0.07 [-0.13, 0.25]	1.08 [0.82, 1.38]	1.04 [0.63, 2.18]	0.97 [0.65, 1.45]	-0.03 [-0.15, 0.08]	-0.04 [-0.19, 0.09]	0.000 [-0.16, 0.17]	0.86 [0.58, 1.24]	1.01 [0.73, 1.35]
Standard Covariates Adjusted		-0.05 [-0.18, 0.08]	0.02 [-0.25, 0.25]	1.07 [0.85, 1.34]	1.02 [0.62, 2.18]	0.97 [0.69, 1.56]	-0.03 [-0.16, 0.09]	-0.00 [-0.13, 0.16]	-0.01 [-0.19, 0.14]	0.92 [0.67, 1.28]	1.00 [0.76, 1.34]
All But One Covariate Adjusted		-0.09 [-0.21, 0.04]	0.07 [-0.12, 0.25]	1.10 [0.85, 1.44]	1.06 [0.64, 2.13]	0.91 [0.55, 1.54]	-0.02 [-0.11, 0.09]	-0.04 [-0.16, 0.10]	0.01 [-0.13, 0.14]	0.86 [0.60, 1.23]	1.00 [0.72, 1.56]
Shared Covariates Adjusted (With Prediction Interval)		-0.07 [-0.21, 0.07]	0.07 [-0.16, 0.32]	1.10 [0.84, 1.40]	1.03 [0.57, 1.89]	0.92 [0.63, 1.45]	-0.03 [-0.14, 0.09]	-0.03 [-0.17, 0.12]	0.001 [-0.13, 0.12]	0.87 [0.62, 1.24]	1.02 [0.78, 1.36]
Openness to Experience
Unadjusted		-0.01 [-0.20, 0.16]	0.02 [-0.69, 0.60]	1.14 [0.78, 1.72]	1.03 [0.24, 4.02]	1.03 [0.53, 2.10]	-0.01 [-0.52, 0.41]	-0.01 [-0.37, 0.30]	0.05 [-0.38, 0.61]	1.22 [0.72, 2.12]	0.97 [0.54, 1.86]
Shared Covariates Adjusted		0.03 [-0.19, 0.41]	0.05 [-0.52, 0.63]	1.15 [0.78, 1.67]	1.07 [0.32, 3.40]	1.04 [0.53, 2.04]	-0.06 [-0.36, 0.36]	-0.01 [-0.46, 0.41]	0.02 [-0.39, 0.54]	1.23 [0.74, 2.12]	0.98 [0.47, 1.69]
Standard Covariates Adjusted		0.03 [-0.19, 0.36]	0.04 [-0.55, 0.51]	1.29 [0.82, 2.02]	1.10 [0.28, 4.38]	1.08 [0.57, 2.23]	-0.04 [-0.46, 0.42]	-0.01 [-0.40, 0.39]	0.000 [-0.40, 0.39]	1.15 [0.46, 2.09]	0.96 [0.50, 1.84]
All But One Covariate Adjusted		0.01 [-0.16, 0.17]	-0.16 [-1.60, 0.57]	1.16 [0.78, 1.71]	0.99 [0.20, 4.63]	1.04 [0.51, 2.11]	-0.05 [-0.39, 0.24]	-0.01 [-0.49, 0.47]	0.02 [-0.30, 0.48]	1.30 [0.75, 2.33]	0.95 [0.49, 1.89]
Shared Covariates Adjusted (With Prediction Interval)		0.01 [-0.19, 0.25]	0.03 [-0.79, 0.74]	1.13 [0.85, 1.57]	1.01 [0.26, 3.79]	1.09 [0.58, 2.53]	-0.06 [-0.46, 0.29]	-0.00 [-0.41, 0.48]	0.03 [-0.42, 0.57]	1.24 [0.76, 2.26]	0.93 [0.44, 2.19]
Positive Affect
Unadjusted		-0.00 [-0.52, 0.43]	-0.02 [-0.44, 0.35]	0.96 [0.40, 1.72]	1.28 [0.56, 3.50]	0.97 [0.49, 1.85]	-0.01 [-0.42, 0.46]	-0.01 [-0.37, 0.34]	-0.01 [-0.35, 0.34]	1.10 [0.50, 2.73]	1.18 [0.61, 2.77]
Shared Covariates Adjusted		0.01 [-0.49, 0.39]	-0.04 [-0.46, 0.33]	0.95 [0.17, 1.93]	0.95 [0.57, 1.79]	1.02 [0.49, 2.09]	0.01 [-0.37, 0.48]	-0.05 [-0.53, 0.41]	0.02 [-0.32, 0.38]	1.16 [0.51, 3.07]	1.15 [0.61, 2.04]
Standard Covariates Adjusted		-0.00 [-0.54, 0.47]	-0.02 [-0.52, 0.45]	0.96 [0.47, 1.69]	0.96 [0.56, 2.13]	0.94 [0.45, 1.72]	0.08 [-0.50, 0.74]	-0.02 [-0.36, 0.34]	-0.001 [-0.38, 0.45]	1.13 [0.53, 2.92]	1.14 [0.55, 2.08]
All But One Covariate Adjusted		-0.01 [-0.50, 0.35]	-0.01 [-0.49, 0.56]	0.99 [0.36, 1.82]	0.94 [0.58, 1.71]	1.58 [0.54, 6.35]	-0.00 [-0.41, 0.37]	-0.05 [-0.52, 0.34]	0.02 [-0.44, 0.43]	1.13 [0.53, 2.95]	1.17 [0.60, 2.31]
Shared Covariates Adjusted (With Prediction Interval)		-0.02 [-0.88, 0.46]	-0.03 [-0.57, 0.48]	1.12 [0.67, 2.48]	0.93 [0.56, 1.73]	0.85 [0.44, 2.01]	-0.02 [-0.48, 0.39]	-0.05 [-0.34, 0.27]	0.02 [-0.48, 0.57]	1.12 [0.61, 2.85]	1.10 [0.68, 1.85]
Negative Affect
Unadjusted		-0.09 [-1.99, 1.66]	-0.10 [-1.73, 1.40]	1.02 [0.08, 7.76]	1.16 [0.22, 8.57]	1.07 [0.15, 6.53]	-0.01 [-1.72, 1.63]	-0.01 [-1.75, 1.53]	0.13 [-1.77, 2.22]	1.02 [0.16, 10.27]	0.96 [0.13, 5.85]
Shared Covariates Adjusted		-0.11 [-2.19, 1.63]	-0.05 [-1.74, 1.66]	1.28 [0.16, 10.72]	1.05 [0.14, 7.19]	1.02 [0.15, 6.20]	0.02 [-1.61, 1.57]	-0.01 [-2.01, 1.67]	0.04 [-1.67, 1.68]	0.97 [0.16, 9.02]	0.90 [0.16, 7.26]
Standard Covariates Adjusted		-0.12 [-1.97, 1.63]	0.02 [-1.76, 1.75]	0.97 [0.11, 7.80]	1.09 [0.16, 7.28]	1.08 [0.17, 8.13]	0.00 [-1.49, 1.71]	-0.01 [-1.61, 1.56]	0.00 [-1.69, 1.64]	1.00 [0.18, 6.32]	0.89 [0.08, 5.81]
All But One Covariate Adjusted		-0.11 [-2.25, 1.67]	-0.06 [-2.04, 1.47]	1.12 [0.13, 6.43]	1.13 [0.21, 6.11]	1.08 [0.19, 6.18]	-0.13 [-2.32, 1.46]	-0.04 [-1.79, 1.62]	0.04 [-1.85, 1.89]	0.90 [0.14, 5.95]	0.96 [0.16, 5.10]
Shared Covariates Adjusted (With Prediction Interval)		-0.12 [-2.01, 1.59]	-0.31 [-1.64, 1.31]	1.21 [0.22, 10.72]	1.05 [0.19, 6.33]	1.11 [0.14, 8.85]	-0.60 [-2.31, 1.44]	-0.02 [-1.64, 1.57]	-0.02 [-1.88, 1.47]	0.89 [0.15, 6.47]	0.98 [0.16, 5.75]
Satisfaction with Life
Unadjusted		-0.04 [-0.52, 0.39]	-0.01 [-0.52, 0.39]	1.11 [0.67, 1.92]	0.83 [0.42, 1.81]	0.87 [0.47, 1.74]	-0.01 [-0.39, 0.41]	-0.04 [-0.48, 0.37]	-0.04 [-0.49, 0.36]	1.24 [0.40, 3.58]	1.17 [0.63, 1.95]
Shared Covariates Adjusted		-0.05 [-0.71, 0.34]	-0.02 [-0.58, 0.47]	1.14 [0.56, 2.09]	0.85 [0.44, 1.67]	0.93 [0.52, 1.91]	-0.00 [-0.32, 0.34]	-0.03 [-0.45, 0.52]	0.02 [-0.44, 0.47]	1.64 [0.41, 4.14]	1.13 [0.56, 2.19]
Standard Covariates Adjusted		-0.03 [-0.54, 0.40]	-0.00 [-0.51, 0.39]	1.12 [0.56, 2.61]	0.82 [0.40, 1.56]	0.86 [0.45, 1.58]	0.02 [-0.33, 0.34]	-0.03 [-0.55, 0.55]	-0.03 [-0.52, 0.42]	1.02 [0.10, 4.23]	1.15 [0.60, 2.02]
All But One Covariate Adjusted		-0.02 [-0.46, 0.47]	-0.01 [-0.65, 0.49]	1.14 [0.55, 2.05]	0.83 [0.41, 1.52]	0.91 [0.43, 1.76]	-0.00 [-0.42, 0.35]	-0.06 [-0.52, 0.39]	-0.03 [-0.51, 0.35]	1.27 [0.30, 4.58]	1.14 [0.62, 2.10]
Shared Covariates Adjusted (With Prediction Interval)		-0.12 [-1.39, 0.57]	-0.03 [-0.56, 0.39]	1.13 [0.58, 2.08]	0.83 [0.36, 1.73]	0.93 [0.44, 2.52]	-0.01 [-0.44, 0.41]	-0.05 [-0.54, 0.45]	-0.01 [-0.44, 0.39]	1.26 [0.25, 7.53]	1.15 [0.66, 1.94]
Note:
Unadjusted indicates no covariates were included. Fully adjusted models include age, gender, education, smoking status, alcohol use, cognitive ability, race, chronic conditions, BMI, and self-rated health. Shared covariates adjusted models Include age, gender, education, smoking status, alcohol use. Standard covariates adjusted models include age, gender, and education. All but one covariate adjusted models include age, gender, education, cognitive ability, and chronic conditions. Shared covariates with dementia adjusted models Include age, gender, education, smoking status, alcohol use, and dementia diagnosis. Standard covariates with dementia adjusted models include age, gender, education, and incident dementia diagnosis. Shared covariates with prediction interval adjusted models Include age, gender, education, smoking status, alcohol use, and prediction interval.

These show the estimates, split by covariate sets across moderators, traits, and outcomes.

ipd_tab_fun2 <- function(d, cov){
  # long outcome name
  covar <- mapvalues(cov, str_wrap(covars$long_name, 15), covars$short_name, warn_missing = F)
  # getting row numbers for later grouping
  rs <- d %>% group_by(Moderator) %>% tally() %>% 
    mutate(end = cumsum(n), start = lag(end) + 1, start = ifelse(is.na(start), 1, start))
  # number and name of columns for span columns 
  cs <- rep(1,12)
  names(cs) <- c(" ", outcomes$long_name)
  cln <- mapvalues(colnames(d)[colnames(d) %in% outcomes$long_name], outcomes$long_name, outcomes$colnm, warn_missing = F)
  cln <- c("Trait", cln)
  al <- c("r", rep("c", 11))
  # caption 
  cap <- sprintf("<strong>Table X</strong><br><em>Fixed Effect Estimates of %s Personality-Dementia Diagnosis and Neuropathology Associations</em>", cov)
  fn <- mapvalues(cov, str_wrap(covars$long_name, 15), covars$desc, warn_missing = F)
  # kable the table
  tab <- d %>%
    mutate(Trait = factor(Trait, traits$short_name, traits$long_name)) %>%
    select(-Moderator, -term) %>%
    kable(., "html"
    # kable(., "latex"
          , booktabs = T
          , escape = F
          , col.names = cln
          , align = al
          , caption = cap
    ) %>% 
    kable_classic(full_width = F, html_font = "Times New Roman") %>%
    # kable_styling(full_width = F, font_size = 7) %>%
    add_header_above(cs) %>%
    footnote(fn)
  # for loop to add grouped sections 
  for (i in 1:nrow(rs)){
    tab <- tab %>% 
      kableExtra::group_rows(rs$Moderator[i], rs$start[i], rs$end[i]) 
  }
  # save the resulting html table
  save_kable(tab, file = sprintf("%s/results/tables/key-terms/%s.html"
                                 , local_path, covar))
  return(tab) # return the html table
}

ipd_fx_tab2 <- nested_mega_tab %>%
  filter(study == "Overall") %>%
  select(-study) %>%
  arrange(Moderator, term) %>%
  # filter(Covariate %in% c("unadjusted", "shared")) %>%
  group_by(Covariate) %>% 
  nest() %>%
  ungroup() %>%
  mutate(tab = pmap(list(data, Covariate), ipd_tab_fun2))

## Frequentist, no moderator
(ipd_fx_tab2 %>% filter(Covariate == "Shared\nCovariates\nAdjusted (With\nPrediction\nInterval)"))$tab[[1]]

Table 4.2: Table X
Fixed Effect Estimates of Shared Covariates Adjusted (With Prediction Interval) Personality-Dementia Diagnosis and Neuropathology Associations

	Incident Dementia Diagnosis	Braak Stage	CERAD	Lewy Body Disease	Gross Cerebral Infarcts	Gross Cerebral Microinfarcts	Cerebral Atherosclerosis	Cerebral Amyloid Angiopathy	Arteriolosclerosis	Hippocampal Sclerosis	TDP-43
Trait	OR [CI]	b [CI]	b [CI]	OR [CI]	OR [CI]	OR [CI]	b [CI]	b [CI]	b [CI]	OR [CI]	OR [CI]
None
Extraversion	0.95 [0.92, 0.99]	-0.01 [-0.28, 0.15]	-0.03 [-0.10, 0.03]	1.01 [0.91, 1.14]	1.03 [0.70, 1.99]	0.96 [0.83, 1.08]	0.01 [-0.06, 0.09]	0.02 [-0.04, 0.07]	-0.01 [-0.07, 0.09]	0.96 [0.82, 1.16]	1.00 [0.79, 1.22]
Agreeableness	0.96 [0.92, 1.01]	-0.02 [-0.13, 0.09]	-0.02 [-0.29, 0.22]	0.99 [0.76, 1.37]	1.15 [0.42, 3.24]	1.09 [0.61, 1.74]	-0.01 [-0.19, 0.16]	0.00 [-0.32, 0.20]	-0.00 [-0.38, 0.17]	1.00 [0.61, 1.62]	0.98 [0.68, 1.50]
Conscientiousness	0.86 [0.83, 0.90]	-0.05 [-0.14, 0.02]	0.03 [-0.07, 0.14]	0.99 [0.81, 1.32]	1.01 [0.64, 1.92]	1.05 [0.83, 1.35]	0.00 [-0.05, 0.07]	0.02 [-0.06, 0.13]	-0.02 [-0.09, 0.04]	1.05 [0.85, 1.35]	1.01 [0.87, 1.21]
Neuroticism	1.12 [1.07, 1.16]	0.04 [-0.11, 0.31]	-0.01 [-0.11, 0.09]	1.00 [0.77, 1.16]	1.13 [0.67, 2.31]	0.99 [0.85, 1.13]	0.02 [-0.05, 0.09]	0.01 [-0.07, 0.08]	0.01 [-0.07, 0.10]	1.03 [0.87, 1.21]	1.03 [0.88, 1.20]
Openness to Experience	0.95 [0.90, 1.00]	-0.02 [-0.13, 0.08]	-0.03 [-0.21, 0.15]	1.03 [0.77, 1.32]	1.09 [0.37, 3.15]	0.94 [0.69, 1.43]	-0.03 [-0.26, 0.12]	-0.06 [-0.19, 0.15]	-0.05 [-0.42, 0.25]	1.03 [0.75, 1.50]	1.02 [0.76, 1.39]
Positive Affect	0.93 [0.87, 0.99]	-0.05 [-0.36, 0.18]	0.00 [-0.26, 0.17]	1.01 [0.67, 1.45]	1.07 [0.80, 1.83]	1.02 [0.74, 1.45]	0.01 [-0.15, 0.15]	0.03 [-0.12, 0.19]	-0.01 [-0.18, 0.18]	1.09 [0.72, 1.70]	1.05 [0.71, 1.54]
Negative Affect	1.14 [1.00, 1.27]	-0.11 [-1.65, 1.09]	-0.09 [-1.26, 1.01]	1.04 [0.33, 3.79]	1.02 [0.26, 4.16]	1.14 [0.24, 4.75]	0.00 [-1.30, 1.12]	-0.01 [-1.28, 1.19]	-0.08 [-1.32, 1.09]	1.16 [0.26, 8.64]	1.03 [0.26, 4.26]
Satisfaction with Life	0.93 [0.85, 1.01]	0.01 [-0.29, 0.31]	-0.00 [-0.26, 0.23]	1.05 [0.78, 1.47]	1.15 [0.69, 2.22]	1.10 [0.74, 2.08]	0.02 [-0.20, 0.20]	0.001 [-0.35, 0.35]	0.00 [-0.28, 0.28]	0.79 [0.40, 2.17]	1.22 [0.85, 1.90]
Age
Extraversion	1.00 [1.00, 1.01]	0.001 [-0.01, 0.01]	-0.000 [-0.01, 0.01]	1.00 [0.99, 1.01]	1.01 [0.93, 1.09]	1.00 [0.99, 1.02]	-0.000 [-0.00, 0.00]	-0.000 [-0.01, 0.01]	0.000 [-0.01, 0.01]	1.01 [0.99, 1.02]	0.99 [0.98, 1.01]
Agreeableness	1.00 [1.00, 1.01]	-0.00 [-0.02, 0.01]	-0.01 [-0.06, 0.03]	1.00 [0.95, 1.04]	0.95 [0.79, 1.29]	1.00 [0.94, 1.07]	-0.00 [-0.06, 0.03]	-0.01 [-0.04, 0.04]	-0.00 [-0.05, 0.04]	0.97 [0.93, 1.01]	1.00 [0.92, 1.07]
Conscientiousness	1.01 [1.00, 1.01]	-0.001 [-0.01, 0.01]	0.001 [-0.01, 0.01]	1.00 [0.99, 1.02]	1.01 [0.94, 1.08]	1.00 [0.99, 1.02]	0.001 [-0.00, 0.01]	-0.00 [-0.01, 0.00]	0.000 [-0.01, 0.01]	1.01 [0.99, 1.03]	1.00 [0.99, 1.01]
Neuroticism	1.00 [0.99, 1.00]	0.00 [-0.01, 0.01]	-0.00 [-0.01, 0.01]	1.00 [0.99, 1.01]	1.02 [0.95, 1.08]	1.00 [0.99, 1.01]	0.001 [-0.01, 0.01]	0.00 [-0.00, 0.01]	0.00 [-0.02, 0.01]	1.00 [0.98, 1.02]	1.00 [0.98, 1.02]
Openness to Experience	1.00 [1.00, 1.01]	0.01 [-0.02, 0.06]	-0.01 [-0.06, 0.02]	0.99 [0.97, 1.02]	0.98 [0.68, 1.23]	1.00 [0.95, 1.06]	0.00 [-0.03, 0.03]	-0.00 [-0.04, 0.02]	-0.00 [-0.04, 0.02]	1.02 [0.98, 1.06]	0.99 [0.93, 1.06]
Positive Affect	1.00 [0.99, 1.01]	-0.01 [-0.05, 0.03]	-0.00 [-0.07, 0.04]	0.99 [0.92, 1.06]	1.01 [0.96, 1.08]	0.99 [0.92, 1.06]	0.00 [-0.03, 0.04]	-0.00 [-0.04, 0.03]	-0.00 [-0.04, 0.03]	1.01 [0.92, 1.12]	1.05 [0.94, 1.16]
Negative Affect	1.00 [0.99, 1.00]	-0.01 [-0.68, 0.64]	0.11 [-0.32, 0.41]	1.07 [0.76, 1.74]	1.00 [0.55, 1.69]	1.01 [0.63, 1.73]	-0.03 [-0.38, 0.35]	-0.02 [-0.50, 0.35]	-0.02 [-0.38, 0.24]	1.07 [0.70, 2.04]	0.95 [0.63, 1.75]
Satisfaction with Life	1.00 [1.00, 1.01]	-0.00 [-0.04, 0.03]	-0.00 [-0.04, 0.04]	1.00 [0.94, 1.05]	1.02 [0.98, 1.06]	0.99 [0.93, 1.06]	0.00 [-0.02, 0.03]	-0.00 [-0.04, 0.05]	0.001 [-0.03, 0.04]	1.04 [0.92, 1.13]	0.99 [0.94, 1.06]
Gender
Extraversion	0.95 [0.89, 1.01]	0.01 [-0.10, 0.11]	-0.15 [-0.56, 0.18]	1.08 [0.75, 1.58]	1.04 [0.60, 2.25]	0.95 [0.70, 1.32]	-0.04 [-0.14, 0.05]	-0.01 [-0.17, 0.13]	-0.07 [-0.21, 0.09]	0.94 [0.71, 1.24]	0.95 [0.73, 1.23]
Agreeableness	0.99 [0.92, 1.08]	0.09 [-0.16, 0.26]	-0.04 [-0.63, 0.54]	1.12 [0.68, 1.99]	1.09 [0.21, 5.54]	0.92 [0.40, 2.36]	-0.05 [-0.59, 0.38]	-0.02 [-0.52, 0.43]	0.01 [-0.48, 0.94]	0.85 [0.49, 1.65]	0.89 [0.49, 1.79]
Conscientiousness	0.99 [0.93, 1.07]	-0.05 [-0.23, 0.06]	-0.02 [-0.16, 0.19]	0.96 [0.51, 1.24]	1.23 [0.65, 2.85]	0.98 [0.71, 1.31]	0.01 [-0.11, 0.13]	-0.000 [-0.14, 0.13]	-0.01 [-0.19, 0.18]	1.12 [0.77, 1.64]	0.91 [0.71, 1.17]
Neuroticism	1.01 [0.94, 1.07]	-0.01 [-0.13, 0.10]	-0.01 [-0.21, 0.23]	0.92 [0.65, 1.30]	0.96 [0.53, 2.03]	0.95 [0.73, 1.25]	-0.01 [-0.17, 0.14]	0.00 [-0.21, 0.15]	-0.24 [-0.85, 0.12]	1.03 [0.75, 1.41]	0.97 [0.76, 1.23]
Openness to Experience	1.00 [0.92, 1.11]	-0.03 [-0.21, 0.19]	-0.01 [-0.55, 0.45]	1.18 [0.73, 2.29]	1.07 [0.31, 5.22]	0.91 [0.37, 1.88]	-0.03 [-0.32, 0.31]	0.001 [-0.34, 0.40]	-0.04 [-0.48, 0.54]	0.75 [0.43, 1.58]	1.07 [0.57, 2.04]
Positive Affect	1.03 [0.94, 1.13]	-0.01 [-0.54, 0.51]	-0.001 [-0.70, 0.53]	0.85 [0.21, 2.65]	0.67 [0.11, 3.03]	1.52 [0.44, 7.49]	-0.05 [-0.55, 0.38]	-0.02 [-0.67, 0.53]	-0.01 [-0.48, 0.59]	0.81 [0.23, 2.59]	0.67 [0.19, 1.90]
Negative Affect	0.92 [0.73, 1.06]	-0.03 [-2.04, 2.54]	-0.04 [-2.10, 1.95]	0.94 [0.12, 8.11]	0.90 [0.18, 5.48]	0.75 [0.08, 5.91]	0.18 [-1.91, 2.35]	-0.05 [-2.08, 1.87]	0.06 [-1.93, 1.64]	1.36 [0.12, 10.75]	1.21 [0.15, 9.81]
Satisfaction with Life	0.98 [0.91, 1.08]	0.05 [-0.77, 0.68]	-0.17 [-1.12, 0.76]	0.94 [0.26, 2.57]	0.80 [0.13, 3.06]	1.49 [0.38, 7.58]	0.02 [-0.61, 0.52]	0.04 [-0.52, 0.51]	0.06 [-0.42, 0.57]	1.19 [0.25, 5.23]	0.82 [0.17, 2.59]
Education
Extraversion	1.00 [0.99, 1.01]	-0.01 [-0.02, 0.01]	0.01 [-0.01, 0.03]	0.98 [0.90, 1.04]	1.01 [0.91, 1.15]	1.01 [0.96, 1.07]	-0.001 [-0.02, 0.02]	-0.001 [-0.02, 0.02]	0.00 [-0.02, 0.02]	1.00 [0.96, 1.05]	0.99 [0.96, 1.03]
Agreeableness	1.00 [0.99, 1.01]	-0.01 [-0.05, 0.02]	0.01 [-0.07, 0.11]	1.00 [0.94, 1.06]	0.97 [0.65, 1.39]	1.02 [0.84, 1.24]	0.00 [-0.06, 0.05]	-0.01 [-0.09, 0.06]	-0.02 [-0.08, 0.06]	0.96 [0.83, 1.09]	1.01 [0.90, 1.13]
Conscientiousness	0.99 [0.98, 1.00]	0.00 [-0.01, 0.02]	0.01 [-0.02, 0.03]	0.98 [0.91, 1.05]	1.04 [0.93, 1.29]	1.00 [0.96, 1.03]	-0.000 [-0.02, 0.01]	0.000 [-0.02, 0.02]	0.00 [-0.01, 0.02]	0.98 [0.93, 1.04]	0.99 [0.94, 1.02]
Neuroticism	1.00 [0.99, 1.01]	-0.01 [-0.02, 0.01]	-0.000 [-0.02, 0.02]	1.00 [0.96, 1.04]	0.99 [0.88, 1.16]	0.98 [0.88, 1.05]	-0.00 [-0.02, 0.01]	-0.00 [-0.02, 0.02]	-0.01 [-0.03, 0.01]	1.02 [0.96, 1.09]	1.00 [0.96, 1.04]
Openness to Experience	1.00 [0.99, 1.02]	-0.01 [-0.04, 0.02]	0.001 [-0.09, 0.08]	1.00 [0.95, 1.08]	0.96 [0.64, 1.29]	0.93 [0.66, 1.18]	-0.01 [-0.06, 0.05]	0.000 [-0.07, 0.08]	-0.001 [-0.07, 0.07]	0.97 [0.87, 1.12]	0.97 [0.89, 1.07]
Positive Affect	1.00 [0.99, 1.01]	-0.01 [-0.10, 0.06]	0.001 [-0.12, 0.10]	0.89 [0.57, 1.30]	1.01 [0.86, 1.20]	1.01 [0.89, 1.20]	0.00 [-0.08, 0.10]	0.01 [-0.07, 0.11]	0.04 [-0.08, 0.15]	1.00 [0.83, 1.29]	1.03 [0.84, 1.20]
Negative Affect	1.00 [0.98, 1.03]	-0.09 [-1.43, 1.05]	-0.17 [-1.48, 0.98]	1.12 [0.33, 10.09]	0.98 [0.30, 2.95]	1.08 [0.34, 3.63]	-0.02 [-1.10, 0.94]	-0.04 [-1.07, 0.99]	0.03 [-1.08, 1.31]	1.11 [0.36, 4.38]	1.01 [0.37, 2.95]
Satisfaction with Life	1.00 [0.99, 1.01]	-0.00 [-0.09, 0.10]	-0.01 [-0.14, 0.09]	0.97 [0.79, 1.24]	1.00 [0.84, 1.20]	1.03 [0.83, 1.37]	-0.000 [-0.13, 0.12]	0.00 [-0.16, 0.16]	0.00 [-0.09, 0.09]	0.99 [0.48, 1.67]	0.99 [0.84, 1.17]
Cognition
Extraversion	1.00 [0.98, 1.03]	0.00 [-0.04, 0.04]	0.01 [-0.04, 0.05]	0.95 [0.90, 1.00]	1.01 [0.82, 1.26]	0.97 [0.90, 1.03]	-0.01 [-0.03, 0.01]	-0.01 [-0.05, 0.02]	0.00 [-0.03, 0.03]	1.04 [0.95, 1.13]	1.02 [0.95, 1.10]
Agreeableness	1.00 [0.97, 1.05]	0.01 [-0.09, 0.09]	0.02 [-0.08, 0.19]	0.96 [0.86, 1.08]	0.94 [0.59, 1.55]	0.94 [0.81, 1.09]	-0.01 [-0.12, 0.07]	-0.00 [-0.10, 0.11]	-0.01 [-0.12, 0.13]	1.11 [0.93, 1.36]	1.06 [0.84, 1.28]
Conscientiousness	0.99 [0.93, 1.05]	-0.01 [-0.04, 0.02]	0.01 [-0.04, 0.05]	0.95 [0.90, 1.01]	0.97 [0.80, 1.18]	1.00 [0.90, 1.09]	-0.01 [-0.05, 0.03]	0.001 [-0.03, 0.03]	-0.000 [-0.03, 0.03]	1.04 [0.93, 1.17]	0.97 [0.88, 1.04]
Neuroticism	1.01 [0.99, 1.03]	-0.01 [-0.05, 0.03]	0.00 [-0.05, 0.05]	1.01 [0.94, 1.08]	1.01 [0.84, 1.27]	0.98 [0.92, 1.06]	0.02 [-0.01, 0.05]	-0.000 [-0.05, 0.04]	0.02 [-0.03, 0.08]	0.95 [0.86, 1.05]	0.97 [0.91, 1.05]
Openness to Experience	0.99 [0.96, 1.04]	0.000 [-0.06, 0.06]	-0.05 [-0.18, 0.14]	0.97 [0.82, 1.08]	0.99 [0.68, 1.45]	0.97 [0.83, 1.19]	-0.04 [-0.26, 0.05]	0.01 [-0.11, 0.08]	-0.01 [-0.09, 0.06]	0.96 [0.81, 1.15]	1.07 [0.88, 1.43]
Positive Affect	0.99 [0.96, 1.02]	-0.02 [-0.16, 0.08]	-0.01 [-0.10, 0.07]	1.05 [0.91, 1.22]	1.05 [0.93, 1.21]	1.02 [0.89, 1.15]	0.01 [-0.08, 0.11]	0.02 [-0.08, 0.11]	0.001 [-0.12, 0.10]	1.10 [0.88, 1.38]	1.03 [0.80, 1.34]
Negative Affect	1.01 [0.91, 1.17]	-0.03 [-0.74, 0.59]	-0.11 [-0.88, 0.53]	1.09 [0.42, 2.28]	0.99 [0.41, 2.32]	1.01 [0.39, 2.15]	0.03 [-0.65, 0.78]	-0.07 [-0.86, 0.65]	-0.05 [-0.89, 0.72]	1.34 [0.52, 5.63]	0.88 [0.44, 2.31]
Satisfaction with Life	1.00 [0.97, 1.04]	-0.03 [-0.18, 0.09]	0.02 [-0.10, 0.16]	1.06 [0.88, 1.33]	1.04 [0.88, 1.24]	1.02 [0.84, 1.30]	-0.000 [-0.11, 0.12]	0.02 [-0.09, 0.13]	0.02 [-0.13, 0.16]	0.91 [0.68, 1.24]	1.01 [0.87, 1.20]
Dementia Diagnosis
Extraversion		0.04 [-0.09, 0.18]	0.04 [-0.37, 0.61]	1.01 [0.84, 1.23]	1.07 [0.62, 2.65]	1.13 [0.90, 1.40]	0.03 [-0.07, 0.15]	0.04 [-0.06, 0.20]	0.02 [-0.07, 0.12]	1.02 [0.73, 1.41]	1.01 [0.74, 1.44]
Agreeableness		0.05 [-0.15, 0.25]	-0.03 [-0.63, 0.56]	1.11 [0.75, 1.65]	1.08 [0.30, 4.40]	1.01 [0.43, 4.15]	0.05 [-0.37, 0.34]	-0.01 [-0.50, 0.36]	-0.02 [-0.49, 0.43]	0.99 [0.53, 2.01]	1.18 [0.59, 2.54]
Conscientiousness		0.10 [-0.07, 0.26]	-0.05 [-0.29, 0.22]	1.06 [0.84, 1.32]	1.09 [0.65, 2.19]	1.15 [0.89, 1.49]	0.03 [-0.07, 0.15]	0.03 [-0.06, 0.14]	0.00 [-0.12, 0.12]	0.86 [0.57, 1.28]	1.00 [0.78, 1.31]
Neuroticism		-0.07 [-0.21, 0.07]	0.07 [-0.16, 0.32]	1.10 [0.84, 1.40]	1.03 [0.57, 1.89]	0.92 [0.63, 1.45]	-0.03 [-0.14, 0.09]	-0.03 [-0.17, 0.12]	0.001 [-0.13, 0.12]	0.87 [0.62, 1.24]	1.02 [0.78, 1.36]
Openness to Experience		0.01 [-0.19, 0.25]	0.03 [-0.79, 0.74]	1.13 [0.85, 1.57]	1.01 [0.26, 3.79]	1.09 [0.58, 2.53]	-0.06 [-0.46, 0.29]	-0.00 [-0.41, 0.48]	0.03 [-0.42, 0.57]	1.24 [0.76, 2.26]	0.93 [0.44, 2.19]
Positive Affect		-0.02 [-0.88, 0.46]	-0.03 [-0.57, 0.48]	1.12 [0.67, 2.48]	0.93 [0.56, 1.73]	0.85 [0.44, 2.01]	-0.02 [-0.48, 0.39]	-0.05 [-0.34, 0.27]	0.02 [-0.48, 0.57]	1.12 [0.61, 2.85]	1.10 [0.68, 1.85]
Negative Affect		-0.12 [-2.01, 1.59]	-0.31 [-1.64, 1.31]	1.21 [0.22, 10.72]	1.05 [0.19, 6.33]	1.11 [0.14, 8.85]	-0.60 [-2.31, 1.44]	-0.02 [-1.64, 1.57]	-0.02 [-1.88, 1.47]	0.89 [0.15, 6.47]	0.98 [0.16, 5.75]
Satisfaction with Life		-0.12 [-1.39, 0.57]	-0.03 [-0.56, 0.39]	1.13 [0.58, 2.08]	0.83 [0.36, 1.73]	0.93 [0.44, 2.52]	-0.01 [-0.44, 0.41]	-0.05 [-0.54, 0.45]	-0.01 [-0.44, 0.39]	1.26 [0.25, 7.53]	1.15 [0.66, 1.94]
Note:
Shared covariates with prediction interval adjusted models Include age, gender, education, smoking status, alcohol use, and prediction interval.

4.0.1.2 Study-Specific Effects

Next, we’ll look at these estimates for each sample.

## table function 
ipd_rx_tab_fun <- function(d, moder, cov){
  covar <- mapvalues(cov, str_wrap(covars$long_name, 15), covars$short_name, warn_missing = F)
  md <- mapvalues(moder, moders$long_name, moders$short_name, warn_missing = F)
  rs <- d %>% 
    mutate(Trait = factor(Trait, traits$short_name, traits$long_name)) %>%
    group_by(Trait) %>% tally() %>% 
    mutate(end = cumsum(n), start = lag(end) + 1, start = ifelse(is.na(start), 1, start))
  cs <- rep(1,12)
  names(cs) <- c(" ", paste0("<strong>", outcomes$long_name, "</strong>"))
  cln <- mapvalues(colnames(d)[colnames(d) %in% outcomes$long_name], outcomes$long_name, outcomes$colnm, warn_missing = F)
  cln <- c("Study", cln)
  al <- c("r", rep("c", 11)) 
  d <- d %>% select(-term)
  cap <- if(md == "none") sprintf("<strong>Table X</strong><br><em>%s Overall and Sample-Specific Effects of Personality-Crystallized Domain Associations</em>", cov) else sprintf("<strong>Table X</strong><br><em>%s Overall and Sample-Specific %s Moderation of Personality-Crystallized Domain Associations</em>", cov, md)
  fn <- mapvalues(cov, str_wrap(covars$long_name, 15), covars$desc, warn_missing = F)
  tab <- d %>%
    arrange(Trait) %>%
    select(-Trait) %>%
    kable(., "html"
          , escape = F
          , col.names = cln
          , align = al
          , caption = cap
    ) %>% 
    kable_classic(full_width = F, html_font = "Times New Roman") %>%
    add_header_above(cs, escape = F) %>%
    footnote(fn)
  for (i in 1:nrow(rs)) {
    tab <- tab %>% kableExtra::group_rows(rs$Trait[i], rs$start[i], rs$end[i])
  }
  save_kable(tab, file = sprintf("%s/results/tables/study-specific/%s_%s.html"
                                 , local_path, md, covar))
  return(tab)
}

ipd_rx_tab <- nested_mega_tab %>%
  group_by(Moderator, Covariate) %>%
  nest() %>%
  ungroup() %>%
  mutate(tab = pmap(list(data, Moderator, Covariate), ipd_rx_tab_fun))
ipd_rx_tab

## # A tibble: 45 × 4
##    Moderator Covariate                                                   data               tab           
##    <fct>     <fct>                                                       <list>             <list>        
##  1 None      "Unadjusted"                                                <tibble [63 × 14]> <kablExtr [1]>
##  2 None      "Fully Adjusted"                                            <tibble [21 × 14]> <kablExtr [1]>
##  3 None      "Shared\nCovariates\nAdjusted"                              <tibble [63 × 14]> <kablExtr [1]>
##  4 None      "Standard\nCovariates\nAdjusted"                            <tibble [63 × 14]> <kablExtr [1]>
##  5 None      "All But One\nCovariate\nAdjusted"                          <tibble [55 × 14]> <kablExtr [1]>
##  6 None      "Shared\nCovariates\nAdjusted (With\nPrediction\nInterval)" <tibble [63 × 14]> <kablExtr [1]>
##  7 Age       "Unadjusted"                                                <tibble [63 × 14]> <kablExtr [1]>
##  8 Age       "Fully Adjusted"                                            <tibble [16 × 14]> <kablExtr [1]>
##  9 Age       "Shared\nCovariates\nAdjusted"                              <tibble [63 × 14]> <kablExtr [1]>
## 10 Age       "Standard\nCovariates\nAdjusted"                            <tibble [63 × 14]> <kablExtr [1]>
## # ℹ 35 more rows

## Frequentist
(ipd_rx_tab %>% filter(Moderator == "None" & Covariate == "Shared\nCovariates\nAdjusted (With\nPrediction\nInterval)"))$tab[[1]]

(#tab:ipd2b study specific table)Table X
Shared Covariates Adjusted (With Prediction Interval) Overall and Sample-Specific Effects of Personality-Crystallized Domain Associations

	Incident Dementia Diagnosis	Braak Stage	CERAD	Lewy Body Disease	Gross Cerebral Infarcts	Gross Cerebral Microinfarcts	Cerebral Atherosclerosis	Cerebral Amyloid Angiopathy	Arteriolosclerosis	Hippocampal Sclerosis	TDP-43
Study	OR [CI]	b [CI]	b [CI]	OR [CI]	OR [CI]	OR [CI]	b [CI]	b [CI]	b [CI]	OR [CI]	OR [CI]
Extraversion
ROS	0.96 [0.92, 1.01]	0.05 [-0.01, 0.10]	-0.02 [-0.06, 0.02]	1.03 [0.95, 1.13]	0.93 [0.85, 1.02]	0.96 [0.89, 1.04]	0.01 [-0.02, 0.04]	0.02 [-0.01, 0.05]	-0.01 [-0.05, 0.02]	0.95 [0.84, 1.07]	1.03 [0.95, 1.12]
Rush-MAP	0.95 [0.91, 1.00]	0.03 [-0.02, 0.08]	-0.03 [-0.07, 0.00]	1.00 [0.92, 1.08]	0.95 [0.87, 1.03]	0.97 [0.90, 1.04]	-0.01 [-0.04, 0.02]	0.01 [-0.02, 0.05]	-0.01 [-0.04, 0.03]	0.97 [0.87, 1.08]	1.03 [0.96, 1.11]
EAS	0.96 [0.89, 1.02]	-0.01 [-0.11, 0.10]		1.00 [0.84, 1.15]						0.98 [0.84, 1.16]
WUSM-MAP	0.95 [0.90, 1.00]	-0.11 [-0.19, -0.04]	-0.03 [-0.09, 0.01]	1.02 [0.93, 1.13]	1.38 [0.63, 8.00]	0.94 [0.84, 1.06]	0.01 [-0.02, 0.05]	0.01 [-0.03, 0.04]	-0.02 [-0.06, 0.03]	0.92 [0.73, 1.07]	0.98 [0.87, 1.09]
SATSA	0.95 [0.87, 1.02]
HRS	0.96 [0.93, 0.99]
LISS	0.96 [0.88, 1.05]
GSOEP	0.94 [0.87, 1.00]
Overall	0.95 [0.92, 0.99]	-0.01 [-0.28, 0.15]	-0.03 [-0.10, 0.03]	1.01 [0.91, 1.14]	1.03 [0.70, 1.99]	0.96 [0.83, 1.08]	0.01 [-0.06, 0.09]	0.02 [-0.04, 0.07]	-0.01 [-0.07, 0.09]	0.96 [0.82, 1.16]	1.00 [0.79, 1.22]
Agreeableness
ROS	0.95 [0.89, 1.00]	-0.01 [-0.06, 0.06]	0.000 [-0.05, 0.06]	0.97 [0.86, 1.09]	1.03 [0.90, 1.16]	1.04 [0.92, 1.17]	-0.03 [-0.08, 0.01]	0.01 [-0.04, 0.05]	0.02 [-0.03, 0.07]	1.08 [0.89, 1.32]	1.00 [0.90, 1.13]
EAS	0.96 [0.90, 1.02]	0.01 [-0.08, 0.11]		1.06 [0.87, 1.41]						1.07 [0.82, 1.37]
WUSM-MAP	0.95 [0.89, 1.00]	-0.05 [-0.13, 0.01]	-0.03 [-0.10, 0.03]	0.93 [0.83, 1.04]	1.71 [0.48, 25.10]	1.12 [0.97, 1.32]	-0.000 [-0.04, 0.04]	-0.00 [-0.05, 0.04]	0.01 [-0.04, 0.06]	0.81 [0.51, 1.11]	0.95 [0.83, 1.09]
SATSA	0.98 [0.92, 1.09]
HRS	0.96 [0.93, 0.99]
LISS	0.97 [0.90, 1.08]
GSOEP	0.96 [0.89, 1.03]
Overall	0.96 [0.92, 1.01]	-0.02 [-0.13, 0.09]	-0.02 [-0.29, 0.22]	0.99 [0.76, 1.37]	1.15 [0.42, 3.24]	1.09 [0.61, 1.74]	-0.01 [-0.19, 0.16]	0.00 [-0.32, 0.20]	-0.00 [-0.38, 0.17]	1.00 [0.61, 1.62]	0.98 [0.68, 1.50]
Conscientiousness
ROS	0.86 [0.81, 0.91]	-0.05 [-0.10, -0.000]	0.06 [0.00, 0.12]	0.93 [0.83, 1.03]	1.02 [0.92, 1.14]	1.07 [0.96, 1.17]	-0.02 [-0.06, 0.02]	0.02 [-0.02, 0.06]	-0.02 [-0.06, 0.03]	1.00 [0.84, 1.18]	1.03 [0.94, 1.13]
Rush-MAP	0.86 [0.82, 0.92]	-0.05 [-0.11, 0.00]	0.04 [-0.01, 0.11]	0.93 [0.83, 1.04]	0.99 [0.88, 1.13]	1.10 [0.98, 1.23]	0.02 [-0.03, 0.07]	0.01 [-0.04, 0.04]	-0.03 [-0.08, 0.02]	1.05 [0.90, 1.28]	1.00 [0.91, 1.11]
EAS	0.87 [0.82, 0.94]	-0.05 [-0.14, 0.02]		0.93 [0.76, 1.12]						1.14 [0.93, 1.49]
WUSM-MAP	0.86 [0.82, 0.92]	-0.03 [-0.09, 0.03]	-0.01 [-0.08, 0.06]	1.06 [0.94, 1.20]	1.69 [0.64, 13.03]	0.96 [0.84, 1.09]	-0.001 [-0.03, 0.03]	0.01 [-0.03, 0.05]	-0.02 [-0.06, 0.02]	0.97 [0.75, 1.18]	0.98 [0.88, 1.10]
SATSA	0.86 [0.81, 0.93]
HRS	0.85 [0.82, 0.88]
LISS	0.86 [0.78, 0.93]
GSOEP	0.86 [0.81, 0.93]
Overall	0.86 [0.83, 0.90]	-0.05 [-0.14, 0.02]	0.03 [-0.07, 0.14]	0.99 [0.81, 1.32]	1.01 [0.64, 1.92]	1.05 [0.83, 1.35]	0.00 [-0.05, 0.07]	0.02 [-0.06, 0.13]	-0.02 [-0.09, 0.04]	1.05 [0.85, 1.35]	1.01 [0.87, 1.21]
Neuroticism
ROS	1.12 [1.06, 1.17]	0.01 [-0.04, 0.06]	-0.02 [-0.06, 0.03]	1.01 [0.91, 1.10]	1.00 [0.91, 1.09]	1.00 [0.92, 1.08]	0.02 [-0.01, 0.05]	-0.01 [-0.05, 0.03]	0.01 [-0.02, 0.05]	1.04 [0.91, 1.19]	1.01 [0.90, 1.10]
Rush-MAP	1.12 [1.07, 1.18]	0.04 [-0.01, 0.10]	-0.03 [-0.08, 0.01]	1.06 [0.96, 1.21]	0.96 [0.87, 1.06]	0.98 [0.90, 1.07]	0.01 [-0.03, 0.04]	0.02 [-0.02, 0.06]	-0.00 [-0.05, 0.03]	1.07 [0.93, 1.23]	1.06 [0.97, 1.16]
EAS	1.11 [1.03, 1.16]	-0.02 [-0.10, 0.07]		0.95 [0.75, 1.12]						1.02 [0.82, 1.21]
WUSM-MAP	1.12 [1.07, 1.18]	0.11 [0.04, 0.19]	0.01 [-0.04, 0.06]	1.02 [0.91, 1.14]	1.57 [0.64, 9.92]	0.99 [0.88, 1.13]	0.02 [-0.01, 0.06]	0.01 [-0.03, 0.06]	0.03 [-0.03, 0.08]	0.99 [0.79, 1.19]	1.04 [0.93, 1.18]
SATSA	1.11 [1.03, 1.17]
HRS	1.13 [1.10, 1.16]
LISS	1.11 [1.02, 1.19]
GSOEP	1.11 [1.05, 1.17]
Overall	1.12 [1.07, 1.16]	0.04 [-0.11, 0.31]	-0.01 [-0.11, 0.09]	1.00 [0.77, 1.16]	1.13 [0.67, 2.31]	0.99 [0.85, 1.13]	0.02 [-0.05, 0.09]	0.01 [-0.07, 0.08]	0.01 [-0.07, 0.10]	1.03 [0.87, 1.21]	1.03 [0.88, 1.20]
Openness to Experience
ROS	0.93 [0.85, 0.99]	-0.01 [-0.07, 0.06]	-0.02 [-0.07, 0.04]	1.08 [0.95, 1.24]	0.99 [0.87, 1.12]	0.91 [0.80, 1.02]	-0.03 [-0.07, 0.01]	-0.02 [-0.07, 0.03]	-0.07 [-0.12, -0.03]	1.01 [0.84, 1.23]	1.01 [0.90, 1.14]
EAS	0.97 [0.91, 1.09]	-0.02 [-0.11, 0.07]		1.02 [0.80, 1.26]						1.04 [0.82, 1.33]
WUSM-MAP	0.96 [0.90, 1.03]	-0.03 [-0.09, 0.04]	-0.01 [-0.07, 0.05]	0.98 [0.87, 1.10]	1.86 [0.43, 36.27]	0.95 [0.83, 1.10]	-0.01 [-0.05, 0.03]	-0.03 [-0.08, 0.02]	-0.01 [-0.06, 0.04]	1.01 [0.79, 1.30]	1.00 [0.88, 1.15]
SATSA	0.94 [0.87, 1.01]
HRS	0.95 [0.92, 0.98]
LISS	0.96 [0.87, 1.10]
GSOEP	0.93 [0.85, 0.99]
Overall	0.95 [0.90, 1.00]	-0.02 [-0.13, 0.08]	-0.03 [-0.21, 0.15]	1.03 [0.77, 1.32]	1.09 [0.37, 3.15]	0.94 [0.69, 1.43]	-0.03 [-0.26, 0.12]	-0.06 [-0.19, 0.15]	-0.05 [-0.42, 0.25]	1.03 [0.75, 1.50]	1.02 [0.76, 1.39]
Positive Affect
ROS	0.96 [0.90, 1.07]	0.00 [-0.12, 0.09]	0.02 [-0.06, 0.11]	1.01 [0.81, 1.19]	1.03 [0.89, 1.18]	1.00 [0.82, 1.14]	0.00 [-0.05, 0.05]	0.03 [-0.03, 0.11]	-0.02 [-0.11, 0.04]	1.07 [0.80, 1.52]	1.12 [0.95, 1.63]
Rush-MAP	0.94 [0.91, 0.99]	-0.01 [-0.05, 0.02]	0.01 [-0.02, 0.04]	0.97 [0.90, 1.03]	1.04 [0.98, 1.10]	1.04 [0.98, 1.11]	0.01 [-0.01, 0.03]	0.02 [-0.01, 0.04]	-0.001 [-0.03, 0.02]	1.06 [0.94, 1.20]	1.02 [0.96, 1.08]
SATSA	0.94 [0.89, 1.01]
HRS	0.93 [0.90, 0.95]
LISS	0.91 [0.81, 1.01]
GSOEP	0.90 [0.82, 0.96]
Overall	0.93 [0.87, 0.99]	-0.05 [-0.36, 0.18]	0.00 [-0.26, 0.17]	1.01 [0.67, 1.45]	1.07 [0.80, 1.83]	1.02 [0.74, 1.45]	0.01 [-0.15, 0.15]	0.03 [-0.12, 0.19]	-0.01 [-0.18, 0.18]	1.09 [0.72, 1.70]	1.05 [0.71, 1.54]
Negative Affect
Rush-MAP	1.06 [0.98, 1.15]	0.03 [-0.03, 0.08]	-0.03 [-0.08, 0.02]	0.99 [0.88, 1.11]	0.97 [0.88, 1.07]	0.98 [0.88, 1.08]	0.02 [-0.02, 0.05]	0.02 [-0.02, 0.06]	0.02 [-0.02, 0.06]	0.95 [0.79, 1.12]	1.05 [0.96, 1.16]
SATSA	1.09 [1.02, 1.17]
HRS	1.19 [1.15, 1.23]
LISS	1.15 [0.97, 1.33]
GSOEP	1.22 [1.11, 1.35]
Overall	1.14 [1.00, 1.27]	-0.11 [-1.65, 1.09]	-0.09 [-1.26, 1.01]	1.04 [0.33, 3.79]	1.02 [0.26, 4.16]	1.14 [0.24, 4.75]	0.00 [-1.30, 1.12]	-0.01 [-1.28, 1.19]	-0.08 [-1.32, 1.09]	1.16 [0.26, 8.64]	1.03 [0.26, 4.26]
Satisfaction with Life
ROS	0.95 [0.85, 1.07]	0.02 [-0.07, 0.11]	0.03 [-0.05, 0.13]	1.08 [0.93, 1.28]	0.91 [0.73, 1.07]	1.02 [0.84, 1.20]	0.01 [-0.04, 0.06]	-0.00 [-0.09, 0.07]	-0.04 [-0.12, 0.03]	0.38 [0.02, 1.08]	1.11 [0.95, 1.27]
Rush-MAP	0.92 [0.86, 0.98]	-0.00 [-0.05, 0.05]	-0.01 [-0.06, 0.03]	1.02 [0.93, 1.14]	0.99 [0.92, 1.10]	1.13 [1.03, 1.25]	0.02 [-0.01, 0.05]	0.02 [-0.02, 0.06]	0.00 [-0.04, 0.04]	0.99 [0.83, 1.14]	1.12 [1.02, 1.22]
SATSA	0.98 [0.93, 1.04]
HRS	0.94 [0.91, 0.96]
LISS	0.89 [0.75, 1.00]
GSOEP	0.88 [0.81, 0.95]
Overall	0.93 [0.85, 1.01]	0.01 [-0.29, 0.31]	-0.00 [-0.26, 0.23]	1.05 [0.78, 1.47]	1.15 [0.69, 2.22]	1.10 [0.74, 2.08]	0.02 [-0.20, 0.20]	0.001 [-0.35, 0.35]	0.00 [-0.28, 0.28]	0.79 [0.40, 2.17]	1.22 [0.85, 1.90]
Note:
Shared covariates with prediction interval adjusted models Include age, gender, education, smoking status, alcohol use, and prediction interval.

4.0.1.3 Heterogeneity Estimates

4.0.1.4 All Model Terms

ipd_mod_tab <- nested_mega %>%
  select(-one_of(c("n", "rx"))) %>%
  unnest(fx) %>%
  # keep key terms 
  # mark significance and prettify trait, outcome, and covariate names
  left_join(
    outcomes %>% select(Outcome = short_name, link)
  ) %>%
  mutate(sig = ifelse(sign(conf.low) == sign(conf.high), "sig", "ns"),
         Trait = factor(Trait, traits$short_name),
         Outcome = factor(Outcome, outcomes$short_name, outcomes$long_name),
         Moderator = factor(Moderator, moders$short_name, moders$long_name),
         Covariate = factor(Covariate, covars$short_name, str_wrap(covars$long_name, 15))
         ) %>%
  mutate_at(vars(estimate, conf.low, conf.high), ~ifelse(link == "factor", exp(.), .)) %>%
  # format values as text, combine estimates and CI's, bold significance
  mutate_at(vars(estimate, conf.low, conf.high), 
            ~ifelse(abs(.) < .01, sprintf("%.3f", .), sprintf("%.2f", .))) %>%
  mutate(est = sprintf("%s<br>[%s, %s]", estimate, conf.low, conf.high),
         est = ifelse(sig == "sig", sprintf("<strong>%s</strong>", est), est)) %>%
  # mutate(est = sprintf("%s [%s, %s]", estimate, conf.low, conf.high),
  # est = ifelse(sig == "sig", sprintf("\\textbf{%s}", est), est)) %>%
  # final reshaping, remove extra columns, arrange values, and change to wide format
  select(-estimate, -conf.low, -conf.high, -sig) %>%
  arrange(Outcome, Trait, Moderator, Covariate) %>%
  pivot_wider(names_from = "Trait", values_from = "est") 

ipd_mod_tab_fun <- function(d, out, moder, cov, link){
  md <- mapvalues(moder, moders$long_name, moders$short_name, warn_missing = F)
  o <- mapvalues(out, outcomes$long_name, outcomes$short_name, warn_missing = F)
  cv <- mapvalues(cov, str_wrap(covars$long_name, 15), covars$short_name, warn_missing = F)
  cs <- rep(1,9)
  names(cs) <- c(" ", paste0("<strong>", traits$long_name, "</strong>"))
  # cln <- if(length(unique(d$term2)) == 1) c("Covariate", rep("\\textit{b} [CI]", 5)) else c(" ", "Term", rep("\\textit{b} [CI]", 5))
  lnk <- if(link == "factor") "<em>OR</em> [CI]" else "<em>b</em> [CI]"
  cln <- c("Term", rep(lnk, 8))
  al <- c("r", rep("c", 8))
  # caption 
  cap <- if(md == "none") sprintf("All %s Model Estimates of Fixed Effect Personality-Dementia Diagnosis / Neuropathology Associations", cov) else sprintf("All %s Model Estimates of Fixed Effect %s Moderation of Personality-Crystallized Domain Associations", cov, md)
  fn <- mapvalues(cov, str_wrap(covars$long_name, 15), covars$desc, warn_missing = F)
  
  # kable the table
  tab <- d %>%
    arrange(term) %>%
    kable(., "html"
    # kable(., "latex"
          , booktabs = T
          , escape = F
          , col.names = cln
          , align = al
          , caption = cap
    ) %>% 
    kable_classic(full_width = F, html_font = "Times New Roman") %>%
    # kable_styling(full_width = F, font_size = 7) %>%
    add_header_above(cs, escape = F) %>% 
    footnote(fn)
  # save the resulting html table
  save_kable(tab, file = sprintf("%s/results/tables/all-terms/%s_%s_%s.html"
                                 , local_path, o, md, cv))
  return(tab) # return the html table
}

ipd_mod_tab <- ipd_mod_tab %>%
  group_by(Outcome, Moderator, Covariate, link) %>%
  nest() %>%
  ungroup() %>%
  mutate(tab = pmap(list(data, Outcome, Moderator, Covariate, link), ipd_mod_tab_fun))

(ipd_mod_tab %>% filter(Covariate == "Shared\nCovariates\nAdjusted (With\nPrediction\nInterval)"))$tab[[1]]

Table 4.3: All Shared Covariates Adjusted (With Prediction Interval) Model Estimates of Fixed Effect Personality-Dementia Diagnosis / Neuropathology Associations

	Extraversion	Agreeableness	Conscientiousness	Neuroticism	Openness to Experience	Positive Affect	Negative Affect	Satisfaction with Life
Term	OR [CI]	OR [CI]	OR [CI]	OR [CI]	OR [CI]	OR [CI]	OR [CI]	OR [CI]
(Intercept)	0.01 [0.004, 0.04]	0.01 [0.004, 0.04]	0.03 [0.01, 0.08]	0.006 [0.002, 0.02]	0.01 [0.004, 0.04]	0.03 [0.008, 0.09]	0.007 [0.002, 0.02]	0.03 [0.007, 0.08]
age	1.11 [1.10, 1.11]	1.11 [1.10, 1.11]	1.11 [1.10, 1.11]	1.11 [1.10, 1.12]	1.10 [1.10, 1.11]	1.10 [1.09, 1.10]	1.10 [1.10, 1.11]	1.10 [1.09, 1.10]
alcohol1	0.76 [0.68, 0.85]	0.76 [0.68, 0.85]	0.76 [0.68, 0.85]	0.76 [0.68, 0.85]	0.77 [0.69, 0.87]	0.79 [0.70, 0.88]	0.77 [0.68, 0.88]	0.79 [0.71, 0.89]
cor__(Intercept).p_value	1.03 [0.39, 2.59]	0.76 [0.38, 2.40]	0.94 [0.39, 2.54]	1.08 [0.40, 2.61]	0.98 [0.39, 2.52]	1.33 [0.44, 2.66]	0.72 [0.40, 1.78]	1.06 [0.42, 2.39]
education	0.95 [0.93, 0.96]	0.94 [0.93, 0.96]	0.95 [0.94, 0.97]	0.95 [0.94, 0.97]	0.95 [0.93, 0.96]	0.94 [0.92, 0.95]	0.95 [0.93, 0.96]	0.94 [0.92, 0.95]
gender1	1.01 [0.92, 1.11]	1.03 [0.92, 1.16]	1.02 [0.92, 1.13]	0.97 [0.87, 1.07]	1.00 [0.90, 1.11]	1.01 [0.89, 1.13]	0.94 [0.83, 1.06]	1.01 [0.89, 1.14]
interval	1.13 [1.12, 1.15]	1.12 [1.10, 1.13]	1.13 [1.12, 1.15]	1.13 [1.12, 1.15]	1.12 [1.10, 1.14]	1.08 [1.05, 1.10]	1.10 [1.07, 1.12]	1.07 [1.05, 1.10]
p_value	0.95 [0.92, 0.99]	0.96 [0.92, 1.01]	0.86 [0.83, 0.90]	1.12 [1.07, 1.16]	0.95 [0.90, 1.00]	0.93 [0.87, 0.99]	1.14 [1.00, 1.27]	0.93 [0.85, 1.01]
sd__(Intercept)	3.88 [2.15, 11.25]	4.38 [2.25, 15.03]	3.57 [2.05, 9.51]	3.79 [2.17, 10.53]	4.18 [2.24, 13.67]	3.94 [1.88, 17.02]	3.88 [1.96, 16.01]	3.93 [1.87, 19.73]
sd__p_value	1.03 [1.00, 1.10]	1.03 [1.00, 1.11]	1.03 [1.00, 1.09]	1.02 [1.00, 1.08]	1.04 [1.00, 1.14]	1.05 [1.00, 1.17]	1.11 [1.03, 1.32]	1.08 [1.01, 1.24]
smokes1	1.12 [1.02, 1.24]	1.12 [1.00, 1.25]	1.07 [0.96, 1.20]	1.11 [1.00, 1.23]	1.12 [1.00, 1.26]	1.03 [0.92, 1.16]	1.04 [0.93, 1.18]	1.05 [0.94, 1.18]
Note:
Shared covariates with prediction interval adjusted models Include age, gender, education, smoking status, alcohol use, and prediction interval.

4.0.2 Figures

Next, let’s make figures. These will include 4 kinds:

1. “Forest Plots” over overall associations (and credible intervals) across traits, moderators, covariates, and outcomes
   
2. Sample-Specific Forest Plots (or true forest plots) of sample-specific and overall associations across traits, moderators, outcomes, and covariates
   
3. Overall Simple Slopes or figures showing the associations across levels of the moderators
   
4. Sample-Specific Simple Slopes or figures showing the associations across levels of the moderators for each sample

4.0.2.1 Overall Forest

fx_forest_fun <- function(df, outcome, mod, cov, link){
  print(paste(outcome, mod))
  m <- mapvalues(mod, moders$long_name, moders$short_name, warn_missing = F)
  d <- round(max(abs(min(df$estimate)), abs(max(df$estimate))), 3)
  # stds <- unique(df$study)
  lim <- if(link == "factor") c(.75, 1.25) else c(-1*round(2*d,2), round(2*d, 2))
  brk <- if(link == "factor") c(.75, 1, 1.25) else {
    if(d > .01) round(1.75*d,2) else round(1.75*d,3) 
    }; brk <- c(-1*brk, 0, brk)
  lim_high <- if(link == "factor") lim[2]*2 else lim[2]*4
  lab <- str_replace(brk, "^0.", ".")#str_remove(round(c(0-d-(d/5), 0, 0+d+(d/5)),2), "^0")
  shapes <- c(15, 16, 17, 18)[1:length(unique(df$term))]
  lt <- rep("solid", length(unique(df$term)))
  titl <- if(mod == "None"){"Main Effects"} else {sprintf("Personality x %s", mod)}
  leg <- if(length(unique(df$term)) > 1){"bottom"} else {"none"}
  trm <- if(mod != "None") paste("Personality x", unique(df$term[!is.na(df$term)])) else "Main Effects"
  df <- df %>% full_join(tibble(Trait = " ", estimate = NA, n = NA))
  df <- df %>% arrange(estimate)
  trts <- df$Trait[!df$Trait %in% c(" ")]
  labs <- if(link == "factor") "OR [CI]" else "b [CI]"
  yint <- if(link == "factor") 1 else 0
  df <- df %>%
    mutate_at(vars(estimate, conf.low, conf.high),
      lst(f = ~ifelse(abs(.) < .001, sprintf("%.4f", .), ifelse(abs(.) < .01, sprintf("%.3f", .), sprintf("%.2f", .))))) %>%
    mutate(Trait = factor(Trait, rev(c(" ", trts)))#Trait = factor(Trait, rev(c(" ", traits$short_name)), rev(c(" ", traits$short_name)))
           , lb = ifelse(conf.low < lim[1], "lower", "no")
           , ub = ifelse(conf.high > lim[2], "upper", "no")
           , conf.low2 = ifelse(conf.low < lim[1], lim[1], conf.low)
           , conf.high2 = ifelse(conf.high > lim[2], lim[2], conf.high)
           , est = ifelse(Trait != " ", sprintf("%s [%s, %s]", estimate_f, conf.low_f, conf.high_f), "")
           ) %>% arrange(Trait)
  p1 <- df %>%
    ggplot(aes(x = Trait, y = estimate)) + 
    geom_errorbar(aes(ymin = conf.low2, ymax = conf.high2)
                  , position = "dodge"
                  , width = 0) + 
    geom_point(aes(shape = term, size = term)) +
    geom_segment(data = df %>% filter(lb == "lower")
                 , aes(y = conf.high2, yend = conf.low2, xend = Trait)
                 , arrow = arrow(type = "closed", length = unit(0.1, "cm"))) +
    geom_segment(data = df %>% filter(ub == "upper")
                 , aes(y = conf.low2, yend = conf.high2, xend = Trait)
                 , arrow = arrow(type = "closed", length = unit(0.1, "cm"))) +
    geom_hline(aes(yintercept = yint), linetype = "dashed", size = .5) +
    geom_vline(aes(xintercept = length(trts) + .5)) +
    annotate("rect", xmin = length(trts) + .6, xmax = Inf, ymin = -Inf, ymax = Inf, fill = "white") +
    annotate("text", label = labs, x = length(trts) + .75, y = lim_high*.75, hjust = .5, vjust = 0, fontface = 2, size = 3) +
    annotate("text", label = trm, x = length(trts) + .75, y = 0, hjust = .5, vjust = 0, fontface = 2, size = 3) +
    geom_text(aes(y = lim_high*.75, label = est), size = 3.5) +
    scale_y_continuous(limits = c(lim[1], lim_high), breaks = brk, labels = lab) + 
    scale_size_manual(values = c(3,2)) + 
    scale_shape_manual(values = c(15, 16)) +
    labs(x = NULL
         , y = "Estimate"
         # , title = meth
    ) +
    coord_flip() + 
    theme_classic() + 
    theme(legend.position = "none"
          , axis.text = element_text(face = "bold")
          , axis.title = element_text(face = "bold")
          , plot.title = element_text(face = "bold", hjust = .5)
          , axis.ticks.y = element_blank()
          , axis.line.y = element_blank()
          , axis.line.x.top = element_line(size = 1)
          # , panel.background = element_rect(fill = "transparent", colour = NA)
          # , plot.background = element_rect(fill = "transparent", colour = NA)
          )
  
  my_theme <- function(...) {
    theme_classic() + 
      theme(plot.title = element_text(face = "italic"))
  }
  title_theme <- calc_element("plot.title", my_theme())
  ttl <- ggdraw() + 
      draw_label(
          str_wrap(outcome, 50),
          fontfamily = title_theme$family,
          fontface = title_theme$face,
          size = title_theme$size-2
      )
  p <- cowplot::plot_grid(ttl, p1, rel_heights = c(.15, .85), nrow = 2)
  return(p)  
}

nested_ipd_fx_fig <- nested_mega %>%
  select(-rx, -n) %>%
  unnest(fx) %>%
  left_join(
    outcomes %>% select(Outcome = short_name, link)
  ) %>%
  mutate_at(vars(estimate, conf.low, conf.high), ~ifelse(link == "factor", exp(.), .)) %>%
  filter((Moderator == "none" & term == "p_value") |
         (Moderator != "none" & grepl("p_value:", term)
          & !grepl("p_value:study", term)
          & !(grepl("cor_", term) | grepl("sd_", term)))) %>%
  mutate(sig = ifelse(sign(conf.low) == sign(conf.high), "sig", "ns"),
         Outcome = factor(Outcome, outcomes$short_name, outcomes$long_name),
         Covariate = factor(Covariate, covars$short_name, str_wrap(covars$long_name, 15)),
         term = str_remove_all(term, "p_value:"),
         term = str_to_title(str_remove_all(term, "[0-9]")),
         # term = factor(term, c(covars$short_term, moders$short_term, stdyModers$short_term),
         #               c(covars$long_term, moders$long_term, stdyModers$long_term)),
         Moderator = factor(Moderator, moders$short_name, moders$long_name)) %>%
  group_by(Moderator, Covariate, Outcome, link) %>%
  nest() %>%
  ungroup() %>%
  # filter(Covariate == "Shared\nCovariates\nAdjusted" & Moderator == "None") %>% 
  mutate(p = pmap(list(data, Outcome, Moderator, Covariate, link), fx_forest_fun))

fx_forest_comb_fun <- function(d, mod, cov){
  m <- mapvalues(mod, moders$long_name, moders$short_name, warn_missing = F)
  cv <- mapvalues(cov, str_wrap(covars$long_name, 15), covars$short_name, warn_missing = F)
  # d <- d %>% mutate(Outcome = factor(Outcome, outcomes$short_name, outcomes$long_name))
  p1 <- plot_grid(plotlist = d$p
            , nrow = ceiling(nrow(d)/3))
  titl <- if(mod == "None") "Personality-Dementia and Neuropathology Associations" else sprintf("%s Moderators of Personality-Dementia and Neuropathology Associations", mod)
  titl <- str_wrap(paste(cov, titl), 60)
  my_theme <- function(...) {
    theme_classic() + 
      theme(plot.title = element_text(face = "bold"))
  }
  title_theme <- calc_element("plot.title", my_theme())
  ttl <- ggdraw() + 
      draw_label(
          titl,
          fontfamily = title_theme$family,
          fontface = title_theme$face,
          size = title_theme$size-1
      )
  p <- cowplot::plot_grid(ttl, p1, rel_heights = c(.1, .9), nrow = 2)

  ht <- nrow(d)/3
  ggsave(file = sprintf("%s/results/figures/overall-forest/%s_%s.png", local_path, m, cv)
         , width = 12, height = ht*3)
  ggsave(file = sprintf("%s/results/figures/overall-forest/%s_%s.pdf", local_path, m, cv)
         , width = 12, height = ht*3)
  rm(p)
  gc()
  return(T)
}

nested_ipd_fx_fig2 <- nested_ipd_fx_fig %>%
  arrange(Moderator, Covariate, Outcome) %>%
  group_by(Moderator, Covariate) %>%
  nest() %>% 
  ungroup() %>%
  mutate(p = pmap(list(data, Moderator, Covariate), fx_forest_comb_fun))

knitr::include_graphics("https://github.com/emoriebeck/personality-dementia-neuropath/raw/master/results/figures/overall-forest/none_sharedint.png")

4.0.2.2 Study-Specific Forest

ipd_rx_plot_fun <- function(df, outcome, mod, cov, trait){
  print(paste(outcome, mod))
  trt <- mapvalues(trait, traits$short_name, traits$long_name)
  m <- mapvalues(mod, moders$short_name, moders$long_name, warn_missing = F)
  cv <- mapvalues(cov, covars$short_name, covars$long_name, warn_missing = F)
  d <- round(max(abs(min(df$estimate)), abs(max(df$estimate))), 3)
  # stds <- unique(df$study)
  lim <- c(0-d-(d/2.5), 0+d+(d/2.5))
  brk <- round(c(0-d-(d/5), 0, 0+d+(d/5)),2)
  lab <- str_remove(round(c(0-d-(d/5), 0, 0+d+(d/5)),2), "^0")
  shapes <- c(15, 16, 17, 18)[1:length(unique(df$term))]
  lt <- rep("solid", length(unique(df$term)))
  titl <- if(mod == "none"){trt} else {sprintf("%s x %s", trt, m)}
  leg <- if(length(unique(df$term)) > 1){"bottom"} else {"none"}
  df <- df %>% full_join(tibble(study = " ", estimate = NA, n = NA))
  df <- df %>% arrange(estimate)
  stds <- df$study[!df$study %in% c("Overall", " ")]
  df <- df %>%
    mutate(study = factor(study, rev(c(" ", stds, "Overall")))
           # , conf.low = ifelse(conf.low < lim[1], lim[1], conf.low)
           # , conf.high = ifelse(conf.high > lim[2], lim[2], conf.high)
           , lb = ifelse(conf.low < lim[1], "lower", "no")
           , ub = ifelse(conf.high > lim[2], "upper", "no")
           , conf.low2 = ifelse(conf.low < lim[1], lim[1], conf.low)
           , conf.high2 = ifelse(conf.high > lim[2], lim[2], conf.high)
           , n = ifelse(study == "Overall", sum(n, na.rm = T), n)
           # , study = factor(study, levels = str_remove_all(c("Overall", studies_long), "-"), labels = c("Overall", studies_long))
           # Trait = factor(Trait, levels = traits$short_name, labels = traits$long_name),
           , type = ifelse(study == "Overall", "fixed", "random"))
  p1 <- df %>%
    ggplot(aes(x = study, y = estimate)) + 
    # geom_errorbar(data = df %>% filter(ub != "upper")
    #               , aes(ymin = estimate, ymax = conf.high2)
    #               , position = "dodge"
    #               , width = .2) + 
    # geom_errorbar(data = df %>% filter(lb != "lower")
    #               , aes(ymin = conf.low2, ymax = estimate)
    #               , position = "dodge"
    #               , width = .2) + 
    geom_point(data = df# %>% filter(study != "Overall")
               , aes(shape = term, size = n)) + 
    # geom_point(data = df %>% filter(study == "Overall")
    #            , aes(shape = term)) +
    geom_segment(data = df %>% filter(lb != "lower")
                 , aes(y = conf.high2, yend = conf.low2, xend = study)) + 
    geom_segment(data = df %>% filter(ub != "upper")
                 , aes(y = conf.low2, yend = conf.high2, xend = study)) + 
    geom_segment(data = df %>% filter(lb == "lower")
                 , aes(y = conf.high2, yend = conf.low2, xend = study)
                 , arrow = arrow(type = "closed", length = unit(0.1, "cm"))) +
    geom_segment(data = df %>% filter(ub == "upper")
                 , aes(y = conf.low2, yend = conf.high2, xend = study)
                 , arrow = arrow(type = "closed", length = unit(0.1, "cm"))) +
    geom_hline(aes(yintercept = 0), linetype = "dashed", size = .5) +
    geom_vline(aes(xintercept = 1.5)) +
    geom_vline(aes(xintercept = length(stds) + 1.5)) +
    annotate("rect", xmin = length(stds) + 1.6, xmax = Inf, ymin = -Inf, ymax = Inf, fill = "white") +
    scale_y_continuous(limits = lim, breaks = brk, labels = lab) + 
    scale_size_continuous(range = c(2.5,5)) +
    scale_shape_manual(values = c(15, 16)) +
    labs(x = NULL
         , y = "Estimate"
         # , title = "  "
    ) +
    coord_flip() + 
    theme_classic() + 
    theme(legend.position = "none"
          , axis.text = element_text(face = "bold")
          , axis.title = element_text(face = "bold")
          , plot.title = element_text(face = "bold", hjust = .5)
          , axis.ticks.y = element_blank()
          , axis.line.y = element_blank()
          , axis.line.x.top = element_line(size = 1))
  
  d2 <- df %>%
    mutate_at(vars(estimate, conf.low, conf.high)
              , ~ifelse(abs(.) < .01, sprintf("%.3f", .), sprintf("%.2f", .))) %>%
    mutate_at(vars(estimate, conf.low, conf.high), ~str_replace_all(., "^0.", ".")) %>%
    mutate_at(vars(estimate, conf.low, conf.high), ~str_replace_all(., "^-0.", "-.")) %>%
    mutate(est = ifelse(study != " ", sprintf("%s [%s, %s]      ", estimate, conf.low, conf.high), "")
           , n = as.character(n)
           ) %>%
    select(study, n, est) %>%
    pivot_longer(cols = c(n, est), names_to = "est", values_to = "value")
  p2 <- d2 %>%
    ggplot(aes(x = study, y = est)) +
      geom_text(data = d2 %>% filter(est == "est"), aes(label = value), hjust = .5, size = 3.5) + 
      geom_text(data = d2 %>% filter(est == "n"), aes(label = value), hjust = .5, size = 3.5) + 
      annotate("text", label = "b [CI]", x = length(stds) + 1.75, y = "est", hjust = .5, vjust = 0) +
      annotate("text", label = "N", x = length(stds) + 1.75, y = "n", hjust = .5, vjust = 0) +
      geom_vline(aes(xintercept = 1.5)) +
      geom_vline(aes(xintercept = length(stds) + 1.5)) +
      coord_flip() +
      theme_void() +
      theme(plot.title = element_text(face = "bold", hjust = 0)
            , axis.text = element_blank()
            , axis.ticks = element_blank()
            , axis.title = element_blank())
  
  my_theme <- function(...) {
    theme_classic() + 
      theme(plot.title = element_text(face = "italic"))
  }
  title_theme <- calc_element("plot.title", my_theme())
  ttl <- ggdraw() + 
      draw_label(
          titl,
          fontfamily = title_theme$family,
          fontface = title_theme$face,
          size = title_theme$size-2
      )

  p3 <- cowplot::plot_grid(p1, p2
                     , rel_widths = c(.5, .5)
                     , align = "h"
                     )
  # p <- cowplot::plot_grid(ttl, subttl, p3, rel_heights = c(.05, .05, .9), nrow = 3)
  p <- cowplot::plot_grid(ttl, p3, rel_heights = c(.05, .95), nrow = 2)
  gc()
  save(p
       , file = sprintf("%s/results/figures/study-specific-forest/rdata/%s_%s_%s_%s.RData", local_path, outcome, trait, mod, cov))
  return(p)
}

## fixed effects
nested_reg_fp <- nested_mega %>%
  select(-rx, -n) %>%
  unnest(fx) %>%
  mutate(study = "Overall") %>%
  ## random effects
  full_join(
    nested_mega %>%
      mutate(rx = map2(rx, n, ~(.x) %>% full_join(.y))) %>%
      select(-fx, -n) %>%
      unnest(rx) %>%
      rename(term = names)
      # mutate(term = ifelse(Moderator != "none", paste(term, mapvalues(Moderator, moders$short_name, moders$short_term, warn_missing = F), sep = ":"), term))
  ) %>%
  ## filter key terms
  filter((Moderator == "none" & term == "p_value")|
         (Moderator != "none" & grepl("^p_value:", term) & !grepl("study", term))) %>%
  ## significance
  mutate(sig = ifelse(sign(conf.low) == sign(conf.high), "sig", "ns")
         # , study = mapvalues(study, studies_long, studies_sp, warn_missing = F)
         ) %>%
  ## grouping for plotting
  group_by(Outcome, Moderator, Covariate, Trait) %>%
  nest() %>%
  ungroup() %>%
  # filter(Covariate != "fully" & Outcome == "dementia") %>%
  mutate(p = pmap(list(data, Outcome, Moderator, Covariate, Trait), ipd_rx_plot_fun))

ipd_rx_plot_comb_fun <- function(outcome, cov, mod, d){
  o <- mapvalues(outcome, outcomes$short_name, outcomes$long_name, warn_missing = F)
  cv <- mapvalues(cov, covars$short_name, covars$long_name, warn_missing = F)
  m <- mapvalues(mod, moders$short_name, moders$long_name, warn_missing = F)
  titl <- paste("Prospective Associations Between Personality / Subjective Well-Being\nand", o)
  if(mod != "none") titl <- paste(m, "Moderators of", titl)
  p1 <- plot_grid(
    d$p[[1]], d$p[[2]]
    , d$p[[3]], d$p[[4]]
    , d$p[[5]], d$p[[6]]
    , d$p[[7]], d$p[[8]]
    , nrow = 4
    , ncol = 2
    , axis = "tblr"
    , align = "hv"
    )
  my_theme <- function(...) {
    theme_classic() + 
      theme(plot.title = element_text(face = "bold"))
  }
  title_theme <- calc_element("plot.title", my_theme())
  ttl <- ggdraw() + 
      draw_label(
          titl,
          fontfamily = title_theme$family,
          fontface = title_theme$face,
          size = title_theme$size
      )
  my_theme <- function(...) {
    theme_classic() +
      theme(plot.subtitle = element_text(hjust = 0))
  }
  subtitle_theme <- calc_element("subplot.title", my_theme())
  subttl <- ggdraw() +
      draw_label(
          "Pooled Regression Using Random Effects",
          fontfamily = subtitle_theme$family,
          fontface = subtitle_theme$face,
          size = subtitle_theme$size
      )
  
  p <- cowplot::plot_grid(ttl, subttl, p1, rel_heights = c(.06, .03, .91), nrow = 3)
  ggsave(p 
         , file = sprintf("%s/results/figures/study-specific-forest/%s_%s_%s.png", local_path, outcome, mod, cov)
         , width = 10, height = 11)
  ggsave(p 
         , file = sprintf("%s/results/figures/study-specific-forest/%s_%s_%s.pdf", local_path, outcome, mod, cov)
         , width = 10, height = 11)
  return(T)
}

nested_reg_fp %>%
  mutate(Trait = factor(Trait, traits$short_name)) %>%
  arrange(Trait) %>%
  select(-data) %>%
  group_by(Outcome, Moderator, Covariate) %>%
  nest() %>% 
  ungroup() %>%
  # filter(Covariate == "shared" & Outcome == "dementia") %>%
  mutate(p = pmap(
    list(Outcome, Covariate, Moderator, data)
    , possibly(ipd_rx_plot_comb_fun, NA_real_)
    ))

knitr::include_graphics("https://github.com/emoriebeck/personality-dementia-neuropath/raw/master/results/figures/study-specific-forest/dementia_none_sharedint.png")

4.0.2.3 Overall Simple Effects

loadRData <- function(fileName, cov, obj, folder){
#loads an RData file, and returns it
    path <- sprintf("%s/results/%s/%s/%s", local_path, folder, cov, fileName)
    load(path)
    get(ls()[grepl(obj, ls())])
}

## load in "fixed" effects
## first get file names
nested_mega_simp <- tibble(Covariate = c("fully", "shared", "standard", "butOne", "unadjusted", "shareddx", "standarddx", "sharedint")) %>%
  mutate(file = map(Covariate, ~list.files(sprintf("%s/results/predicted/%s", local_path, .)))) %>%
  unnest(file) %>%
  separate(file, c("Outcome", "Trait", "Moderator"), sep = "_", remove = F) %>% 
  ## read in the files
  mutate(Moderator = str_remove(Moderator, ".RData"),
         pred.fx = map2(file, Covariate, ~loadRData(.x, .y, "pred.fx", "predicted")),
         pred.rx = map2(file, Covariate, ~loadRData(.x, .y, "pred.rx", "predicted"))) %>%
  select(-file) %>%
  left_join(
    outcomes %>% select(Outcome = short_name, link)
  ) %>%
  mutate_at(vars(pred.fx, pred.rx), ~ifelse(link == "factor", map(., ~(.) %>% mutate_at(vars(pred, lower, upper), exp)), .))
nested_mega_simp

## # A tibble: 2,095 × 7
##    Covariate Outcome  Trait Moderator pred.fx            pred.rx            link  
##    <chr>     <chr>    <chr> <chr>     <list>             <list>             <chr> 
##  1 fully     dementia A     age       <tibble [303 × 5]> <tibble [606 × 6]> factor
##  2 fully     dementia A     cognition <tibble [303 × 5]> <tibble [606 × 6]> factor
##  3 fully     dementia A     education <tibble [303 × 5]> <tibble [606 × 6]> factor
##  4 fully     dementia A     gender    <tibble [202 × 5]> <tibble [404 × 6]> factor
##  5 fully     dementia C     education <tibble [303 × 5]> <tibble [606 × 6]> factor
##  6 fully     dementia C     gender    <tibble [202 × 5]> <tibble [404 × 6]> factor
##  7 fully     dementia E     age       <tibble [303 × 5]> <tibble [606 × 6]> factor
##  8 fully     dementia E     cognition <tibble [303 × 5]> <tibble [606 × 6]> factor
##  9 fully     dementia E     education <tibble [303 × 5]> <tibble [606 × 6]> factor
## 10 fully     dementia E     gender    <tibble [202 × 5]> <tibble [404 × 6]> factor
## # ℹ 2,085 more rows

simp_eff_fun <- function(df, outcome, mod, cov, link){
  print(paste(outcome, mod))
  o <- mapvalues(outcome, outcomes$short_name, outcomes$long_name, warn_missing = F)
  cv <- cov# cv <- mapvalues(cov, covars$short_name, covars$long_name, warn_missing = F)
  m <- mapvalues(mod, moders$short_name, moders$long_name, warn_missing = F)
  dmini <- round(min(df$pred),3); dmaxi = round(max(df$pred),3)
  d <- round(max(abs(min(df$pred)), abs(max(df$pred))), 3)
  mini <- if(link == "factor") 0 else dmini - (dmaxi-dmini)
  maxi <- dmaxi + (dmaxi-dmini)
  hl <- if(link == "factor") 1 else 0
  brk <- if(link == "factor") c(round(mini*1.1,2), 1, round(maxi*.9,2)) else c(round(mini*1.1,2), 0, round(maxi*.9,2)) 
  lab <- if(link == "factor") str_remove(c(round(mini*1.1,2), 1, round(maxi*.9,2)), "^0") else str_remove(c(round(mini*1.1,2), 0, round(maxi*.9,2)), "^0")
  # mini <- if(link == "factor") C1+(d+(d/5)) else 0+d+(d/5)
  lim <- c(mini, maxi)
  # brk <- if(link == "factor") round(c(1-d-(d/10), 1, 1+d+(d/10)),2) else round(c(0-d-(d/10), 0, 0+d+(d/10)),2)
  # lab <- if(link == "factor") str_remove(c(round(1-d-(d/10),2), 1, round(1+d+(d/10),2)), "^0") else{str_remove(c(round(0-d-(d/10),2), 0, round(0+d+(d/10),2)), "^0")}
  titl <- if(mod == "none"){o} else {sprintf("%s: Personality x %s Simple Effects", o, m)}
  lt <- c("dotted", "solid", "dashed")[1:length(unique(df$mod_fac))]
  # if(link == "factor") {mini <- round(min(df$pred),2); maxi <- round(max(df$pred),2)} else {mini <- floor(min(df$pred)); maxi <- ceiling(max(df$pred))}
  df %>%
    mutate(Trait = factor(Trait, levels = traits$short_name, labels = traits$long_name),
           lower = ifelse(lower < mini, mini, lower),
           upper = ifelse(upper > maxi, maxi, upper)) %>%
    ggplot(aes(x = p_value
               , y = pred
               , group  = mod_fac))  +
      # ylim(c(mini, maxi)) +
      # scale_y_continuous(limits = lim#c(mini , maxi)
      #                    , breaks = round(seq(mini, maxi, length.out = 4),2)
      #                    , labels = round(seq(mini, maxi,length.out = 4), 2)) +
      scale_linetype_manual(values = lt) +
      geom_ribbon(aes(ymin = lower
                      , ymax = upper
                      , fill = mod_fac)
                  , alpha = .25) +
      geom_hline(aes(yintercept = hl), linetype = "dashed", size = .6, color = "grey30") +
      geom_line(aes(linetype = mod_fac)) +
      labs(x = "Personality (POMP)"
           , y = if(link == "factor") paste(o, "(OR)") else paste(o, "(POMP)")
           , title = str_wrap(titl, 40)
           , linetype = m
           , fill = m
           , subtitle = "Pooled Regression Using Random Effects") +
      facet_wrap(~Trait, nrow = 3, scales = "free") +
      theme_classic() +
      theme(legend.position = "bottom"
            , plot.title = element_text(face = "bold", size = rel(1.2), hjust = .5)
            , plot.subtitle = element_text(size = rel(1.1), hjust = .5)
            , strip.background = element_rect(fill = "black")
            , strip.text = element_text(face = "bold", color = "white")
            , axis.text = element_text(color = "black"))
  ggsave(file = sprintf("%s/results/figures/overall-simple-effects/%s_%s_%s.png", local_path, outcome, mod, cov), width = 6, height = 6)
}

ipd_se_plot <- nested_mega_simp %>%
  filter(Moderator != "dementia") %>%
  select(-pred.rx) %>%
  group_by(Outcome, Moderator, Covariate, link) %>%
  nest() %>%
  ungroup() %>%
  mutate(data = map(data, ~(.) %>% unnest(pred.fx)),
         plot = pmap(list(data, Outcome, Moderator, Covariate, link), simp_eff_fun))

knitr::include_graphics("https://github.com/emoriebeck/personality-dementia-neuropath/raw/master/results/figures/overall-simple-effects/dementia_gender_sharedint.png")

simp_eff_fun <- function(df, outcome, mod, cov, link){
  print(paste(outcome, mod))
  o <- mapvalues(outcome, outcomes$short_name, outcomes$long_name, warn_missing = F)
  cv <- cov# cv <- mapvalues(cov, covars$short_name, covars$long_name, warn_missing = F)
  m <- mapvalues(mod, moders$short_name, moders$long_name, warn_missing = F)
  dmini <- round(min(df$pred),3); dmaxi = round(max(df$pred),3)
  d <- round(max(abs(min(df$pred)), abs(max(df$pred))), 3)
  mini <- if(link == "factor") 0 else dmini - (dmaxi-dmini)
  maxi <- dmaxi + (dmaxi-dmini)
  hl <- if(link == "factor") 1 else 0
  brk <- if(link == "factor") c(round(mini*1.1,2), 1, round(maxi*.9,2)) else c(round(mini*1.1,2), 0, round(maxi*.9,2)) 
  lab <- if(link == "factor") str_remove(c(round(mini*1.1,2), 1, round(maxi*.9,2)), "^0") else str_remove(c(round(mini*1.1,2), 0, round(maxi*.9,2)), "^0")
  # mini <- if(link == "factor") C1+(d+(d/5)) else 0+d+(d/5)
  lim <- c(mini, maxi)
  # brk <- if(link == "factor") round(c(1-d-(d/10), 1, 1+d+(d/10)),2) else round(c(0-d-(d/10), 0, 0+d+(d/10)),2)
  # lab <- if(link == "factor") str_remove(c(round(1-d-(d/10),2), 1, round(1+d+(d/10),2)), "^0") else{str_remove(c(round(0-d-(d/10),2), 0, round(0+d+(d/10),2)), "^0")}
  titl <- if(mod == "none"){o} else {sprintf("%s: Personality x %s Simple Effects", o, m)}
  lt <- c("dotted", "solid", "dashed")[1:length(unique(df$mod_fac))]
  # if(link == "factor") {mini <- round(min(df$pred),2); maxi <- round(max(df$pred),2)} else {mini <- floor(min(df$pred)); maxi <- ceiling(max(df$pred))}
  df %>%
    mutate(Trait = factor(Trait, levels = traits$short_name, labels = traits$long_name)
           , lower = ifelse(lower < mini, mini, lower)
           , upper = ifelse(upper > maxi, maxi, upper)
           # , dementia = factor(dementia, c(0,1), c("No", "Yes"))
           ) %>%
    ggplot(aes(x = pred
               , y = mod_fac))  +
        geom_errorbar(aes(xmin = lower, xmax = upper)
                      , width = .1
                      , position = position_dodge(width = .9)
                      ) + 
        geom_point(aes(fill = Trait)
                   , color = "black"
                   , position = position_dodge(width = .9)
                   , shape = 22
                   ) + 
      xlim(c(mini, maxi)) +
      # scale_y_continuous(limits = lim#c(mini , maxi)
      #                    , breaks = round(seq(mini, maxi, length.out = 4),2)
      #                    , labels = round(seq(mini, maxi,length.out = 4), 2)) +
      # scale_linetype_manual(values = lt) +
      # geom_ribbon(aes(ymin = lower
      #                 , ymax = upper
      #                 , fill = mod_fac)
      #             , alpha = .25) +
      # geom_hline(aes(yintercept = hl), linetype = "dashed", size = .6, color = "grey30") +
      # geom_line(aes(linetype = mod_fac)) +
      labs(y = "Personality / SWB Rating (POMP)"
           , x = if(link == "factor") paste(o, "(OR)") else paste(o, "(POMP)")
           , title = str_wrap(titl, 40)
           , linetype = m
           , fill = m
           , subtitle = "Pooled Regression Using Random Effects") +
      guides(fill = "none") + 
      facet_wrap(~Trait, nrow = 3, scales = "free") +
      theme_classic() +
      theme(legend.position = "bottom"
            , plot.title = element_text(face = "bold", size = rel(1.2), hjust = .5)
            , plot.subtitle = element_text(size = rel(1.1), hjust = .5)
            , strip.background = element_rect(fill = "black")
            , strip.text = element_text(face = "bold", color = "white")
            , axis.text = element_text(color = "black"))
  ggsave(file = sprintf("%s/results/figures/overall-simple-effects/%s_%s_%s.png", local_path, outcome, mod, cov), width = 6, height = 6)
}

ipd_se_plot_dx <- nested_mega_simp %>%
  filter(Moderator == "dementia" & Outcome != Moderator) %>%
  select(-pred.rx) %>%
  group_by(Outcome, Moderator, Covariate, link) %>%
  nest() %>%
  ungroup() %>%
  mutate(data = map(data, ~(.) %>% unnest(pred.fx)),
         plot = pmap(list(data, Outcome, Moderator, Covariate, link), simp_eff_fun))

knitr::include_graphics("https://github.com/emoriebeck/personality-dementia-neuropath/raw/master/results/figures/overall-simple-effects/braak_dementia_sharedint.png")

4.0.2.4 Study-Specific Simple Effects

ipd_std_se_plot_fun <- function(df, outcome, trait, mod, cov, link){
  fctr_vars <- c("gender", "smokes", "alcohol", "race", "stroke", "cancer", "diabetes", "heartProb", "dementia")
  print(paste(outcome, mod))
  o <- mapvalues(outcome, outcomes$short_name, outcomes$long_name, warn_missing = F)
  trt <- mapvalues(trait, traits$short_name, traits$long_name, warn_missing = F)
  cv <- cov# cv <- mapvalues(cov, covars$short_name, covars$long_name, warn_missing = F)
  m <- mapvalues(mod, moders$short_name, moders$long_name, warn_missing = F)
  d <- round(max(abs(min(df$pred)), abs(max(df$pred))), 3)
  titl <- if(mod == "none"){sprintf("%s: %s", o, trt)} else {sprintf("%s: %s x %s Simple Effects", o, trt, m)}
  std <- unique(df$study)
  cols <- (stdcolors %>% filter(studies_long %in% std))$colors
  lt <- (stdcolors %>% filter(studies_long %in% std))$lt
  ht <- length(unique(df$mod_fac))
  if(link == "factor") {mini <- round(min(df$pred),2); maxi <- round(max(df$pred),2)} else {mini <- floor(min(df$pred)); maxi <- ceiling(max(df$pred))}
  df <- df %>%
    mutate(study = factor(study, levels = stdcolors$studies_long, labels = stdcolors$studies_long),
           lower = ifelse(lower < mini, mini, lower),
           upper = ifelse(upper > maxi, maxi, upper),
           gr = ifelse(study == "Overall", "Overall", "study")) %>%
    group_by(study, mod_fac, p_value, gr) %>%
    summarize_at(vars(pred, lower, upper), mean) %>%
    ungroup() 
    p <- df %>% 
      ggplot(aes(x = p_value
               , y = pred
               , group  = study))  +
      scale_y_continuous(limits = c(mini,maxi)
                         , breaks = round(seq(mini, maxi, length.out = 4), 2)
                         , labels = round(seq(mini, maxi, length.out = 4), 2)) +
      scale_linetype_manual(values = lt) +
      scale_color_manual(values = cols) +
      scale_fill_manual(values = cols) +
      scale_size_manual(values = c(2,.8)) + 
      geom_line(aes(linetype = study, color = study, size = gr)) +
      labs(x = "Personality (POMP)"
           , y = if(link == "factor") paste(o, "(OR)") else o
           , title = titl
           , linetype = "Sample"
           , color = "Sample"
           , fill = "Sample") +
      guides(size = "none", fill = "none") +
      facet_wrap(~mod_fac, nrow = 1) +
      theme_classic() +
      theme(legend.position = "bottom"
            , plot.title = element_text(face = "bold", size = rel(1.2), hjust = .5)
            , plot.subtitle = element_text(size = rel(1.1), hjust = .5)
            , strip.background = element_rect(fill = "black")
            , strip.text = element_text(face = "bold", color = "white")
            , axis.text = element_text(color = "black"))
  ggsave(p, file = sprintf("%s/results/figures/study-specific-simple-effects/%s_%s_%s_%s.png", local_path, outcome, trait, mod, cov), width = 3*ht, height = 5)
  return(p)
}

nested_simp_std_se <- nested_mega_simp %>%
  filter(Covariate != "fully" & Moderator != "dementia") %>%
  mutate(pred.fx = map(pred.fx, ~(.) %>% mutate(study = "Overall")),
         comb.fx = map2(pred.fx, pred.rx, full_join)) %>%
  select(-pred.fx, -pred.rx) %>%
  # filter(Moderator %in% c("age", "education")) %>%
  mutate(pmap(list(comb.fx, Outcome, Trait, Moderator, Covariate, link), ipd_std_se_plot_fun))

knitr::include_graphics("https://github.com/emoriebeck/personality-dementia-neuropath/raw/master/results/figures/study-specific-simple-effects/dementia_C_age_sharedint.png")

ipd_std_se_plot_fun <- function(df, outcome, trait, mod, cov, link){
  fctr_vars <- c("gender", "smokes", "alcohol", "race", "stroke", "cancer", "diabetes", "heartProb", "dementia")
  print(paste(outcome, mod))
  o <- mapvalues(outcome, outcomes$short_name, outcomes$long_name, warn_missing = F)
  trt <- mapvalues(trait, traits$short_name, traits$long_name, warn_missing = F)
  cv <- cov# cv <- mapvalues(cov, covars$short_name, covars$long_name, warn_missing = F)
  m <- mapvalues(mod, moders$short_name, moders$long_name, warn_missing = F)
  d <- round(max(abs(min(df$pred)), abs(max(df$pred))), 3)
  
  titl <- if(mod == "none"){sprintf("%s: %s", o, trt)} else {sprintf("%s: %s x %s Simple Effects", o, trt, m)}
  
  std <- unique(df$study)
  cols <- (stdcolors %>% filter(studies_long %in% std))$colors
  lt <- (stdcolors %>% filter(studies_long %in% std))$lt
  ht <- length(unique(df$mod_fac))
  # if(link == "factor") {mini <- round(min(df$pred),2); maxi <- round(max(df$pred),2)} else {mini <- floor(min(df$pred)); maxi <- ceiling(max(df$pred))}
  if(link == "factor") {mini <- round(min(df$lower),2); maxi <- round(max(df$upper),2)} else {mini <- floor(min(df$lower)); maxi <- ceiling(max(df$upper))}
  yint <- if(link == "factor") 1 else 0
  df <- df %>%
    mutate(study = factor(study, levels = stdcolors$studies_long, labels = stdcolors$studies_long),
           lower = ifelse(lower < mini, mini, lower),
           upper = ifelse(upper > maxi, maxi, upper),
           gr = ifelse(study == "Overall", "Overall", "study")) %>%
    group_by(study, mod_fac, p_value, gr) %>%
    summarize_at(vars(pred, lower, upper), mean) %>%
    ungroup() 
  ord <- (df %>% filter(mod_fac == "M" & gr != "Overall") %>% arrange(desc(pred)))$study %>% as.character()
    p <- df %>% 
      # mutate(study = factor(study, c("Overall", ord))) %>%
      ggplot(aes(y = mod_fac
               , x = pred
               , group  = mod_fac))  +
      # scale_y_continuous(limits = c(mini,maxi)
      #                    , breaks = round(seq(mini, maxi, length.out = 4), 2)
      #                    , labels = round(seq(mini, maxi, length.out = 4), 2)) +
      scale_shape_manual(values = c(15, 22)) +
      scale_color_manual(values = cols) +
      # scale_fill_manual(values = cols) +
      scale_size_manual(values = c(4,3)) + 
      scale_alpha_manual(values = c(1, .5)) + 
      geom_vline(aes(xintercept = yint), linetype = "dashed") + 
      # scale_x_continuous(
      #   limits = c(-.5, 1.5)
      #   , breaks = c(0,1)
      #   , labels = c("No", "Yes")
      #   ) + 
      # geom_col(
      #   aes(fill = study, alpha = gr)
      #     , position = position_dodge(width = .9)
      #     , color = "black"
      #     # , alpha = .5
      #   ) +
      geom_errorbar(
        aes(xmin = lower, xmax = upper)
        , position = position_dodge(width = .9)
        , width = 0
        , color = "black"
      ) +
      # geom_errorbar(
      #   aes(ymin = lower, ymax = pred)
      #   , position = position_dodge(width = .9)
      #   , width = 0
      #   , color = "white"
      # ) +
      geom_point(
        aes(shape = gr, fill = study, size = gr)
        , position = position_dodge(width = .9)
        , color = "black"
        ) +
      labs(y = paste(trt, "Score (%)")
           , x = if(link == "factor") paste("Predicted Difference in", o, "(OR)") else paste("Predicted Difference in", o)
           , title = titl) +
      guides(size = "none", color = "none", shape = "none", fill = "none") +
      facet_wrap(~study, nrow = 1) +
      theme_classic() +
      theme(legend.position = "bottom"
            , plot.title = element_text(face = "bold", size = rel(1.2), hjust = .5)
            , plot.subtitle = element_text(size = rel(1.1), hjust = .5)
            , strip.background = element_rect(fill = "black")
            , strip.text = element_text(face = "bold", color = "white")
            , axis.text = element_text(color = "black")
            , panel.border = element_rect(color = "black", fill = NA, size = 1))
  ggsave(p, file = sprintf("%s/results/figures/study-specific-simple-effects/%s_%s_%s_%s.png", local_path, outcome, trait, mod, cov), width = 4*length(std), height = 5)
  return(p)
}

nested_simp_std_se_dx <- nested_mega_simp %>%
  filter(Covariate != "fully" & Moderator == "dementia") %>%
  mutate(pred.fx = map(pred.fx, ~(.) %>% mutate(study = "Overall")),
         comb.fx = map2(pred.fx, pred.rx, full_join)) %>%
  select(-pred.fx, -pred.rx) %>%
  # filter(Moderator %in% c("age", "education")) %>%
  mutate(pmap(list(comb.fx, Outcome, Trait, Moderator, Covariate, link), ipd_std_se_plot_fun))

knitr::include_graphics("https://github.com/emoriebeck/personality-dementia-neuropath/raw/master/results/figures/study-specific-simple-effects/braak_C_dementia_sharedint.png")

4.0.2.5 Significant Forest Plots & Simple Effects

std_eff_comb_plot_fun <- function(p1, p2, cov, out, trt, mod){
  print(paste(cov, out, trt, mod))
  ttl <- (cowplot::get_title(p2))$children
  ttl <- str_wrap(ttl[[1]]$label, 45); print(ttl)
  p2 <- p2 + labs(title = ttl)
  rw <- if(length(levels(p2$data$mod_fac)) == 3) c(.35, .65) else c(.4, .6)
  p <- plot_grid(p1, p2
            , rel_widths = rw
            , align = "v"
            , axis = "tb"
            , ncol = 2
            )
  ggsave(p, file = sprintf("%s/results/figures/study-specific-combined/%s-%s-%s-%s.png", local_path, out, trt, mod, cov)
         , width = length(levels(p2$data$mod_fac))*3 + 3
         , height = 5)
  ggsave(p, file = sprintf("%s/results/figures/study-specific-combined/%s-%s-%s-%s.pdf", local_path, out, trt, mod, cov)
         , width = length(levels(p2$data$mod_fac))*3 + 4
         , height = 4)
  return(p)
}

nested_std_plots_comb <- nested_reg_fp %>% 
  select(-p) %>%
  unnest(data) %>% 
  filter(!Moderator %in% c("none", "dementia") & study != "Overall") %>%
  group_by(Covariate, Outcome, Trait, Moderator, sig) %>%
  tally() %>%
  group_by(Covariate, Outcome, Trait, Moderator) %>%
  mutate(perc = n/sum(n)) %>%
  ungroup() %>%
  filter(sig == "sig" & perc > .3) %>%
  select(-n,-perc) %>%
  full_join(
    nested_reg_fp %>% 
      select(-p) %>%
      unnest(data) %>% 
      filter(!Moderator %in% c("none", "dementia") & study == "Overall" & sign(conf.low) == sign(conf.high)) %>% 
      select(Covariate:Moderator, sig)
  ) %>%
  distinct() %>%
  left_join(
    nested_reg_fp %>% select(everything(), -data, fp=p)
  ) %>%
  left_join(
    nested_simp_std_se %>% select(everything(), -comb.fx, sep = `pmap(...)`)
  ) %>%
  mutate(p = pmap(list(fp, sep, Covariate, Outcome, Trait, Moderator)
                  , possibly(std_eff_comb_plot_fun, NA_real_)))

nested_std_plots_comb_dx <- nested_reg_fp %>% 
  select(-p) %>%
  unnest(data) %>% 
  filter(Moderator == "dementia" & study != "Overall") %>%
  group_by(Covariate, Outcome, Trait, Moderator, sig) %>%
  tally() %>%
  group_by(Covariate, Outcome, Trait, Moderator) %>%
  mutate(perc = n/sum(n)) %>%
  ungroup() %>%
  filter(sig == "sig" & perc > .3) %>%
  select(-n,-perc) %>%
  full_join(
    nested_reg_fp %>% 
      select(-p) %>%
      unnest(data) %>% 
      filter(Moderator == "dementia" & study == "Overall" & sign(conf.low) == sign(conf.high)) %>% 
      select(Covariate:Moderator, sig)
  ) %>%
  distinct() %>%
  left_join(
    nested_reg_fp %>% select(everything(), -data, fp=p)
  ) %>%
  left_join(
    nested_simp_std_se_dx %>% select(everything(), -comb.fx, sep = `pmap(...)`)
  ) %>%
  mutate(p = pmap(list(fp, sep, Covariate, Outcome, Trait, Moderator)
                  , possibly(std_eff_comb_plot_fun, NA_real_)))

knitr::include_graphics("https://github.com/emoriebeck/personality-dementia-neuropath/raw/master/results/figures/study-specific-simple-effects/dementia_N_cognition_sharedint.png")

nested_std_plots_comb_panel <- function(plist, cov, mod, nmod, trt_group){
  p <- plot_grid(
    plotlist = plist$p
    , ncol = 1
    , align = "h"
    , axis = "lr"
  )
  
  ggsave(p, file = sprintf("%s/results/figures/study-specific-combined-panels/%s-%s-%s.png", local_path, mod, cov, trt_group)
         , width = nmod*3+5
         , height = nrow(plist)*3)
  ggsave(p, file = sprintf("%s/results/figures/study-specific-combined-panels/%s-%s-%s.pdf", local_path, mod, cov, trt_group)
         , width = nmod*3+5
         , height = nrow(plist)*4)
}


nested_std_plots_comb_dx %>%
  filter(Moderator == "dementia") %>%
  mutate(nmod = map_dbl(sep, ~length(levels((.)$data$mod_fac)))
         , trt_group = mapvalues(Trait, traits$short_name, c(rep("big5", 5), rep("swb", 3)))) %>%
  select(-fp, -sep) %>%
  group_by(Covariate, Moderator, nmod, trt_group) %>% 
  nest() %>%
  ungroup() %>%
  mutate(p = pmap(list(data, Covariate, Moderator, nmod, trt_group), nested_std_plots_comb_panel))

nested_std_plots_comb_panel <- function(plist, out, cov){
  p <- plot_grid(
    plotlist = plist$p
    , ncol = 1
    , align = "h"
    , axis = "lr"
  )
  
  ggsave(p, file = sprintf("%s/results/figures/study-specific-combined-panels/%s-%s.png", local_path, out, cov)
         , width = 3*3+6
         , height = nrow(plist)*4)
  ggsave(p, file = sprintf("%s/results/figures/study-specific-combined-panels/%s-%s.pdf", local_path, out, cov)
         , width = 3*3+6
         , height = nrow(plist)*4)
}

nested_reg_fp %>% 
      select(-p) %>%
      unnest(data) %>% 
      filter(Moderator != "none" & study == "Overall" & sign(conf.low) == sign(conf.high)) %>% 
      select(Covariate:Moderator, sig) %>%
  left_join(nested_std_plots_comb) %>%
  arrange(Covariate, Outcome, Moderator, Trait) %>%
  group_by(Covariate, Outcome) %>%
  nest() %>%
  ungroup() %>%
  mutate(p = pmap(list(data, Outcome, Covariate), nested_std_plots_comb_panel))

knitr::include_graphics("https://github.com/emoriebeck/personality-dementia-neuropath/raw/master/results/figures/study-specific-combined-panels/dementia-sharedint-big5.png")

knitr::include_graphics("https://github.com/emoriebeck/personality-dementia-neuropath/raw/master/results/figures/study-specific-combined-panels/dementia-sharedint.png")

# C - braak - dementia - shared 
load("/Volumes/Emorie/projects/dementia/prediction/results/models/shared/braak_C_dementia.RData")
hyp <- c(
  "p_value = 0", "p_value + p_value:dementia1 = 0"
); names(hyp) <- c("Dementia = 0", "Dementia = 1")

hyp <- c(
  "dementia1 + 2.5*p_value + 2.5*p_value:dementia1 = 0", "dementia1 + 5*p_value + 5*p_value:dementia1 = 0", "dementia1 + 7.5*p_value + 7.5*p_value:dementia1 = 0"
); names(hyp) <- c("-25%", "M", "+25%")
hypothesis(m, hyp, scope = "coef", group = "study")$hypothesis %>%
  full_join(
    hypothesis(m, hyp)$hypothesis %>% 
      mutate(Group = "Overall")
  ) %>%
  mutate(Hypothesis = factor(Hypothesis, c("-25%", "M", "+25%"))) %>%
  arrange(Group, Hypothesis)

##       Group Hypothesis    Estimate Est.Error    CI.Lower  CI.Upper Evid.Ratio Post.Prob Star
## 1       EAS       -25%  0.01488882 0.4554769 -0.83474194 0.9765685         NA        NA     
## 2       EAS          M -0.08534036 0.4799323 -0.93023269 0.9666525         NA        NA     
## 3       EAS       +25% -0.18556953 0.5374514 -1.15469315 0.9846866         NA        NA     
## 4   Overall       -25%  0.28742084 0.4224154 -0.57087452 1.1065111         NA        NA     
## 5   Overall          M  0.31428802 0.5410931 -0.83842604 1.4063249         NA        NA     
## 6   Overall       +25%  0.34115520 0.7045705 -1.16232201 1.7692894         NA        NA     
## 7       ROS       -25%  0.30100045 0.2579322 -0.21985532 0.7997646         NA        NA     
## 8       ROS          M  0.39222259 0.2387495 -0.08449609 0.8575871         NA        NA     
## 9       ROS       +25%  0.48344472 0.2558920 -0.01437826 0.9952668         NA        NA     
## 10 Rush-MAP       -25%  0.29220652 0.2602555 -0.21477341 0.7978934         NA        NA     
## 11 Rush-MAP          M  0.33539256 0.2444501 -0.13926983 0.8157798         NA        NA     
## 12 Rush-MAP       +25%  0.37857860 0.2798609 -0.18550710 0.9275261         NA        NA     
## 13 WUSM-MAP       -25%  0.61447279 0.3501419 -0.03178734 1.3488414         NA        NA     
## 14 WUSM-MAP          M  0.70855090 0.3469458  0.07826754 1.4258705         NA        NA    *
## 15 WUSM-MAP       +25%  0.80262902 0.3672979  0.13555049 1.5378560         NA        NA    *

# association only for individuals without dementia diag

# C - vsclrMcrInfrcts - dementia - shared 
load("/Volumes/Emorie/projects/dementia/prediction/results/models/shared/vsclrMcrInfrcts_C_dementia.RData")
hypothesis(m, hyp, scope = "coef", group = "study")$hypothesis %>% mutate_at(vars(Estimate, CI.Lower, CI.Upper), exp)

##      Group Hypothesis  Estimate Est.Error  CI.Lower CI.Upper Evid.Ratio Post.Prob Star
## 1      ROS       -25% 0.8915756 0.4611512 0.3565610 2.237268         NA        NA     
## 2 Rush-MAP       -25% 0.8066729 0.4684443 0.3113866 2.031316         NA        NA     
## 3 WUSM-MAP       -25% 0.7302583 0.6818422 0.2432074 3.798966         NA        NA     
## 4      ROS          M 1.3499719 0.4343210 0.5796871 3.231963         NA        NA     
## 5 Rush-MAP          M 1.2828519 0.4455106 0.5342678 3.186609         NA        NA     
## 6 WUSM-MAP          M 0.6937837 0.7008935 0.2265149 3.633169         NA        NA     
## 7      ROS       +25% 2.0440490 0.4687643 0.8096291 5.213544         NA        NA     
## 8 Rush-MAP       +25% 2.0401194 0.5087942 0.7555881 5.727034         NA        NA     
## 9 WUSM-MAP       +25% 0.6591310 0.7658073 0.1819494 3.904996         NA        NA

hypothesis(m, hyp)$hypothesis %>% mutate_at(vars(Estimate, CI.Lower, CI.Upper), exp)

##   Hypothesis Estimate Est.Error   CI.Lower  CI.Upper Evid.Ratio Post.Prob Star
## 1       -25% 0.895769 0.7341303 0.21332568  3.671203         NA        NA     
## 2          M 1.253516 1.0484006 0.15093147 12.652202         NA        NA     
## 3       +25% 1.754138 1.4430505 0.09036386 47.154628         NA        NA

# association only for individuals with dementia, such that C is risk for more pathology

# N - vsclrMcrInfrcts - dementia - shared 
load("/Volumes/Emorie/projects/dementia/prediction/results/models/shared/vsclrMcrInfrcts_N_dementia.RData")
hypothesis(m, hyp, scope = "coef", group = "study")$hypothesis %>% mutate_at(vars(Estimate, CI.Lower, CI.Upper), exp)

##      Group Hypothesis  Estimate Est.Error  CI.Lower  CI.Upper Evid.Ratio Post.Prob Star
## 1      ROS       -25% 2.4471680 0.3023402 1.3226753  4.603844         NA        NA    *
## 2 Rush-MAP       -25% 1.7832685 0.2817748 1.0135332  3.109794         NA        NA    *
## 3 WUSM-MAP       -25% 2.5069669 0.6096029 0.6769813  8.595932         NA        NA     
## 4      ROS          M 1.9018237 0.3070155 1.0411631  3.465852         NA        NA    *
## 5 Rush-MAP          M 1.1171997 0.3129798 0.6180358  2.072676         NA        NA     
## 6 WUSM-MAP          M 2.3770887 0.6621323 0.6346968  9.414883         NA        NA     
## 7      ROS       +25% 1.4780077 0.3777974 0.6958205  3.117623         NA        NA     
## 8 Rush-MAP       +25% 0.6999143 0.4475947 0.2892872  1.621016         NA        NA     
## 9 WUSM-MAP       +25% 2.2539391 0.7638452 0.5257578 11.271002         NA        NA

hypothesis(m, hyp)$hypothesis %>% mutate_at(vars(Estimate, CI.Lower, CI.Upper), exp)

##   Hypothesis Estimate Est.Error   CI.Lower  CI.Upper Evid.Ratio Post.Prob Star
## 1       -25% 2.155638 0.6138059 0.56145431  7.822769         NA        NA     
## 2          M 1.675900 0.9549461 0.20927850 14.470222         NA        NA     
## 3       +25% 1.302928 1.3596562 0.07122702 28.393671         NA        NA

# association for indidvuals with dementia, usch that N is a protective factor against pathology

# SWL - hipSclerosis - dementia - shared 
load("/Volumes/Emorie/projects/dementia/prediction/results/models/shared/hipSclerosis_SWL_dementia.RData")
hypothesis(m, hyp, scope = "coef", group = "study")$hypothesis %>% mutate_at(vars(Estimate, CI.Lower, CI.Upper), exp)

##      Group Hypothesis     Estimate  Est.Error     CI.Lower CI.Upper Evid.Ratio Post.Prob Star
## 1      ROS       -25% 4.538651e-09 28.2828020 3.575913e-30 5.047732         NA        NA     
## 2 Rush-MAP       -25% 8.257432e-01  0.9267724 2.000186e-01 5.987976         NA        NA     
## 3      ROS          M 1.998994e-17 56.0252894 2.940331e-59 3.643485         NA        NA     
## 4 Rush-MAP          M 1.191047e+00  0.7937293 3.185886e-01 7.331039         NA        NA     
## 5      ROS       +25% 8.804328e-26 83.7756345 2.417718e-88 3.634121         NA        NA     
## 6 Rush-MAP       +25% 1.717960e+00  0.7532188 4.191172e-01 9.624497         NA        NA

hypothesis(m, hyp)$hypothesis %>% mutate_at(vars(Estimate, CI.Lower, CI.Upper), exp)

##   Hypothesis Estimate Est.Error     CI.Lower    CI.Upper Evid.Ratio Post.Prob Star
## 1       -25% 1.295809  1.925018 1.593292e-02    54.48063         NA        NA     
## 2          M 2.240864  3.671521 5.489070e-04  1199.50243         NA        NA     
## 3       +25% 3.875163  5.531700 1.396072e-05 37131.38049         NA        NA

# association for indidvuals without dementia, SWL protective against pathology

# PA - tdp43 - dementia - shared 
load("/Volumes/Emorie/projects/dementia/prediction/results/models/shared/tdp43_PA_dementia.RData")
hypothesis(m, hyp, scope = "coef", group = "study")$hypothesis %>% mutate_at(vars(Estimate, CI.Lower, CI.Upper), exp)

##      Group Hypothesis Estimate Est.Error  CI.Lower  CI.Upper Evid.Ratio Post.Prob Star
## 1      ROS       -25% 1.467604 0.9436978 0.1891046  8.329732         NA        NA     
## 2 Rush-MAP       -25% 1.374367 0.3791283 0.6735176  2.910392         NA        NA     
## 3      ROS          M 2.451328 1.0160878 0.4247852 24.003485         NA        NA     
## 4 Rush-MAP          M 1.759433 0.3452709 0.8987734  3.503260         NA        NA     
## 5      ROS       +25% 4.094434 1.2748653 0.6069821 98.205407         NA        NA     
## 6 Rush-MAP       +25% 2.252387 0.3489014 1.1448756  4.478002         NA        NA    *

hypothesis(m, hyp)$hypothesis %>% mutate_at(vars(Estimate, CI.Lower, CI.Upper), exp)

##   Hypothesis Estimate Est.Error   CI.Lower  CI.Upper Evid.Ratio Post.Prob Star
## 1       -25% 1.490759  1.121642 0.17161138  17.10686         NA        NA     
## 2          M 2.087577  1.816012 0.06041279 106.67366         NA        NA     
## 3       +25% 2.923328  2.601191 0.01753368 711.82400         NA        NA

# association for indidvuals with dementia, SWL risk for pathology

# SWL - vsclrInfrcts - dementia - shared 
load("/Volumes/Emorie/projects/dementia/prediction/results/models/shared/vsclrInfrcts_SWL_dementia.RData")
hypothesis(m, hyp, scope = "coef", group = "study")$hypothesis %>% mutate_at(vars(Estimate, CI.Lower, CI.Upper), exp)

##      Group Hypothesis  Estimate Est.Error   CI.Lower CI.Upper Evid.Ratio Post.Prob Star
## 1      ROS       -25% 1.1384492 0.8233407 0.19191739 5.139960         NA        NA     
## 2 Rush-MAP       -25% 2.3972205 0.5027414 0.90584925 6.403171         NA        NA     
## 3      ROS          M 0.6175628 0.9523147 0.07405117 3.297016         NA        NA     
## 4 Rush-MAP          M 1.8299229 0.4528472 0.75870676 4.422587         NA        NA     
## 5      ROS       +25% 0.3350029 1.2251884 0.02054018 2.613335         NA        NA     
## 6 Rush-MAP       +25% 1.3968751 0.4604946 0.57312629 3.469499         NA        NA

hypothesis(m, hyp)$hypothesis %>% mutate_at(vars(Estimate, CI.Lower, CI.Upper), exp)

##   Hypothesis  Estimate Est.Error    CI.Lower  CI.Upper Evid.Ratio Post.Prob Star
## 1       -25% 1.7669728  1.250991 0.126890890  20.73345         NA        NA     
## 2          M 1.2843854  1.999785 0.016166162  79.14483         NA        NA     
## 3       +25% 0.9336001  2.852141 0.001840744 384.31439         NA        NA

# association for indidvuals with dementia, SWL risk for pathology