#167 added residual

reports/correlation-3/correlation-3-pc.R

@@ -130,50 +130,67 @@ d %>%
 
 # ----- custom-save-forest --------------------------------
 track = "pulmonary"
-data_forest <- get_forest_data(catalog,track = track) %>%
-  rename_domains(track) %>%
-  dplyr::filter(
-    model_number == "b1"
-    ,model_type   == "aehplus"
-  ) %>%
-  dplyr::mutate(
-    domain = gsub("delayed/working","working", domain)
-  )
-
-# print single
-# data_forest %>% print_forest_plot("verbal knowledge","male")
-# data_forest %>% print_forest_plot("memory","male")
-# print all
-
-domain_cycle <- setdiff(unique(data_forest$domain),NA)
-subgroup_cycle <- unique(data_forest$subgroup)
-
-for(dom in domain_cycle){
-  # cat("\n##",dom,"\n")
-  for(gender in subgroup_cycle){
-    dom = domain_cycle[3]
-    gender = subgroup_cycle[1]
-    # n_lines = 13
-    n_lines <- data_forest %>%
-      dplyr::filter(domain==dom,subgroup==gender) %>%
-      nrow()
-# save graphic
-    path_save = paste0("./reports/correlation-3/forest-plot-pulmonary/jpeg/",
-                       track,"-",dom,"-",gender,".jpg")
-    jpeg(
-      filename  =  path_save,
-      width     = 900,
-      height    = 140 + 20*n_lines,
-      units     = "px",
-      pointsize = 12,
-      quality   = 100
+path_graph_jpeg = "./reports/correlation-3/forest-plot-pulmonary/jpeg/"
+for(i in c("slope","residual")){
+  # i <- "residual"
+  data_forest <- get_forest_data(catalog,track = track,index = i) %>%
+    rename_domains(track) %>%
+    dplyr::filter(
+      model_number == "b1"
+      ,model_type   == "aehplus"
+    ) %>%
+    dplyr::mutate(
+      domain = gsub("delayed/working","delayed or working", domain)
     )
-    data_forest %>% print_forest_plot(dom,gender)
-    dev.off()
+  domain_cycle <- setdiff(unique(data_forest$domain),NA)
+  subgroup_cycle <- unique(data_forest$subgroup)
+  for(dom in domain_cycle){
+    # cat("\n##",dom,"\n")
+    for(gender in subgroup_cycle){
+      # dom = domain_cycle[3]
+      # gender = subgroup_cycle[1]
+      # n_lines = 13
+      n_lines <- data_forest %>%
+        dplyr::filter(domain==dom,subgroup==gender) %>%
+        nrow()
+      # save graphic
+      path_save = paste0(path_graph_jpeg,track,"-",dom,"-",gender,"-",i,".jpg")
+      jpeg(
+        filename  =  path_save,
+        width     = 900,
+        height    = 140 + 20*n_lines,
+        units     = "px",
+        pointsize = 12,
+        quality   = 100
+      )
+      data_forest %>% print_forest_plot(dom,gender,i)
+      dev.off()
+    }
   }
 }
 
-
+# first attemp at automatic assembly into the complext plot:
+# index = "slope"
+# gender = "male"
+# pattern = paste0("-",gender,"-",index,".jpg$")
+#
+# path_jpeg <- list.files(path_graph_jpeg,pattern = pattern,full.names = T )
+#
+# # setup plot
+# par(mar=rep(0,4)) # no margins
+# # layout the plots into a matrix w/ 12 columns, by row
+# layout(matrix(1:length(path_jpeg), ncol=1, byrow=TRUE))
+#
+# for(i in seq_along(path_jpeg)){
+#     img <- jpeg::readJPEG(path_jpeg[[i]])
+#     plot(NA,xlim=0:1,ylim=0:1,xaxt="n",yaxt="n",bty="n")
+#     rasterImage(img,0,0,1,1)
+# }
+# dev.print(
+#   device = jpeg,
+#   "./reports/correlation-3/forest-plot-pulmonary.jpeg",
+#   width = 700, height = 2100, quality=100
+# )
 
 
 # ---- print-forest -----------------

reports/correlation-3/support-functions.R

@@ -305,7 +305,8 @@ save_corr_table <- function(
 
 get_forest_data <- function(
   catalog,
-  track
+  track,
+  index="slope"
 ){
   # track = "pulmonary"
   # select relevant PROCESS A / PHYSICAL MEASURE
@@ -322,31 +323,43 @@ get_forest_data <- function(
       d1 <- catalog %>% dplyr::filter(process_a %in% c("fev","pef", "pek"))
     }
   }
-
   d2 <- d1 %>%
     prettify_catalog() %>%
     dplyr::select(
       process_b_domain, study_name,
       model_number, subgroup, model_type, process_a, process_b, subject_count,
-      er_tau_11_est, er_tau_11_ci95lo, er_tau_11_ci95hi, er_slopes
-    ) %>%
-    dplyr::mutate(
-      # subject_count = scales::comma(subject_count)
+      er_tau_11_est, er_tau_11_ci95lo, er_tau_11_ci95hi, er_slopes,
+      er_sigma_00_est, er_sigma_00_ci95lo, er_sigma_00_ci95hi, er_resid
     ) %>%
     plyr::rename( c(
       "process_b_domain" ="domain",
       "study_name"       ="study",
       "process_a"        ="physical",
       "process_b"        ="cognitive",
-      "subject_count"    ="n",
-      "er_tau_11_est"    ="mean",
-      "er_tau_11_ci95lo" ="lower",
-      "er_tau_11_ci95hi" ="upper",
-      "er_slopes"        ="dense"
-    )) %>%
-    dplyr::mutate(
-      dense = gsub("[$]p[$]","p",dense)
-    )
+      "subject_count"    ="n"
+    ))
+  if(index == "slope"){
+    d2 <- d2 %>%
+      plyr::rename( c(
+        "er_tau_11_est"    ="mean",
+        "er_tau_11_ci95lo" ="lower",
+        "er_tau_11_ci95hi" ="upper",
+        "er_slopes"        ="dense"
+      ))
+  }
+  if(index == "residual"){
+    d2 <- d2 %>%
+      plyr::rename( c(
+        "er_sigma_00_est"    ="mean",
+        "er_sigma_00_ci95lo" ="lower",
+        "er_sigma_00_ci95hi" ="upper",
+        "er_resid"           ="dense"
+      ))
+  }
+    d2 <- d2 %>%
+      dplyr::mutate(
+        dense = gsub("[$]p[$]","p",dense)
+      )
   return(d2)
 }
 # Usage
@@ -383,7 +396,8 @@ rename_domains <- function(
 print_forest_plot <- function(
   data_forest,
   domain_,
-  subgroup_
+  subgroup_,
+  index = "slope"
 ){
   # domain_="verbal knowledge"
   # subgroup_ = "male"
@@ -471,7 +485,7 @@ print_forest_plot <- function(
     # hrzl_lines = list("3" = gpar(lty=1)),
     hrzl_lines =  gpar(col="#444444"),
     graph.pos  = 5,
-    title = paste0("Slope correlations in ",toupper(domain_)," domain among ",toupper(subgroup_),"S")
+    title = paste0(toupper(index)," correlations in ",toupper(domain_)," domain among ",toupper(subgroup_),"S")
     # title = paste0("Slope correlations among ",toupper(subgroup_),"S")
   )
   return(g)