From c7dac62ff8f84285b5e3f7ce5660079568088674 Mon Sep 17 00:00:00 2001
From: Dr Nathan Green <n8thangreen@yahoo.co.uk>
Date: Wed, 8 Nov 2023 11:16:25 +0000
Subject: [PATCH] refactored plotNetwork() cleaner and to work with binData

* still needs more sorting out tho
---
 R/new_NMA.R                                   |  4 +-
 R/plotNetwork.R                               | 75 +++++++------------
 vignettes/binary-data.Rmd                     |  3 +-
 .../how-to-use-nma-survival-test-data.Rmd     |  1 +
 4 files changed, 31 insertions(+), 52 deletions(-)

diff --git a/R/new_NMA.R b/R/new_NMA.R
index f5b91f5..3109761 100644
--- a/R/new_NMA.R
+++ b/R/new_NMA.R
@@ -44,8 +44,8 @@ new_NMA <- function(subDataHR = NA,
   
   data_lookup <-
     c(subDataHR = "hr_data",
-      subDataMed = "surv_bin_data",
-      subDataBin = "med_data",
+      subDataMed = "med_data",
+      subDataBin = "surv_bin_data",
       binData = "bin_data",
       countData = "count_data",
       contsData = "conts_data")
diff --git a/R/plotNetwork.R b/R/plotNetwork.R
index 2755f1f..c31428f 100644
--- a/R/plotNetwork.R
+++ b/R/plotNetwork.R
@@ -23,63 +23,40 @@ plotNetwork <- function(dat,
 plotNetwork.default <- function(dat,
                                 usecurve = FALSE,
                                 ...) {
+  keep_dat <- names(dat) %in% c("subDataBin", "subDataMed", "binData")  #, "subDataHR"
+  study_data <- dat[keep_dat]
   
-  is_bin <- !(any(is.na(dat$subDataBin)) || any(is.null(dat$subDataBin)))
-  is_med <- !(any(is.na(dat$subDataMed)) || any(is.null(dat$subDataMed)))
-  
-  if (!is_bin & !is_med) {
-    subDataComb <- dat$subData[, c("study", "tx", "base", "Ltx", "Lbase")]
-  }
-  
-  if (is_bin & !is_med) {
-    subDataBinN <- dat$subDataBin
-    
-    names(subDataBinN)[names(subDataBinN) == "BinR"] <- "Ltx"
-    names(subDataBinN)[names(subDataBinN) == "BinN"] <- "Lbase"
-
-    subDataComb <-
-      rbind(dat$subData[, c("study", "tx", "base", "Ltx", "Lbase")],
-            subDataBinN[, c("study", "tx", "base", "Ltx", "Lbase")])
-  }
-  
-  if (!is_bin & is_med) {
-    subDataMedN <- dat$subDataMed
+  for (i in seq_along(study_data)) {
     
-    names(subDataMedN)[names(subDataMedN) == "medR"] <- "Ltx"
-    names(subDataMedN)[names(subDataMedN) == "medN"] <- "Lbase"
+    # change to same column names across data types
+    names(study_data[[i]])[names(study_data[[i]]) %in% c("BinR", "medR", "r")] <- "Ltx"
+    names(study_data[[i]])[names(study_data[[i]]) %in% c("BinN", "medN", "n")] <- "Lbase"
     
-    subDataComb <-
-      rbind(data$subData[, c("study", "tx", "base", "Ltx", "Lbase")],
-            subDataMedN[, c("study", "tx", "base", "Ltx", "Lbase")])
-  }
+    names(study_data[[i]])[names(study_data[[i]]) %in% "treatment"] <- "tx"
   
-  if (is_bin & is_med) {
-    
-    subDataBinN <- dat$subDataBin
-    subDataMedN <- dat$subDataMed
-
-    names(subDataBinN)[names(subDataBinN) == "BinR"] <- "Ltx"
-    names(subDataMedN)[names(subDataMedN) == "medR"] <- "Ltx"
-    names(subDataBinN)[names(subDataBinN) == "BinN"] <- "Lbase"
-    names(subDataMedN)[names(subDataMedN) == "medN"] <- "Lbase"
-    
+    # missing column added
+    # assume base first treatment
+    if (!"base" %in% names(study_data[[i]])) {
+      study_data[[i]] <-
+        study_data[[i]] |> 
+        group_by(study) |> 
+        mutate(base = first(tx))
+    }
+      
     keep_cols <- c("study", "tx", "base", "Ltx", "Lbase")
-    
-    subDataComb <-
-      rbind(dat$subData[, keep_cols],
-            subDataBinN[, keep_cols],
-            subDataMedN[, keep_cols])
-  }
+    study_data[[i]] <- study_data[[i]][, keep_cols]
+  }  
   
-  subDataCombLng <-
-    reshape(
-      subDataComb,
-      direction = "long",
-      varying = list(c("Ltx", "Lbase")),
-      timevar = "txCode")
+  # combine to single array
+  subDataComb <- do.call(rbind, study_data)
   
   subDataCombLng <-
-    subDataCombLng[order(subDataCombLng$study), ]
+    melt(subDataComb,
+         id.vars = c(1,2,3),
+         variable.name = "txCode",
+         value.name = "Ltx") |> 
+    mutate(txCode = as.numeric(txCode)) |> 
+    arrange(study)
   
   ##TODO: pass as argument  
   nTx <- length(dat$txList)
diff --git a/vignettes/binary-data.Rmd b/vignettes/binary-data.Rmd
index c1e970f..fe642ff 100644
--- a/vignettes/binary-data.Rmd
+++ b/vignettes/binary-data.Rmd
@@ -89,7 +89,8 @@ nma_model <-
           bugs_params = bugs_params,
           is_random = RANDOM,
           data_type = data_type,
-          refTx = REFTX ,
+          refTx = REFTX,
+          effectParam = c("d", "mu"),
           label = "",
           endpoint = "")
 
diff --git a/vignettes/how-to-use-nma-survival-test-data.Rmd b/vignettes/how-to-use-nma-survival-test-data.Rmd
index 7bf16bd..094be5c 100644
--- a/vignettes/how-to-use-nma-survival-test-data.Rmd
+++ b/vignettes/how-to-use-nma-survival-test-data.Rmd
@@ -181,6 +181,7 @@ nma_res <- NMA_run(nma_model, save = FALSE)
 nma_res
 ```
 
+http://127.0.0.1:34255/graphics/plot_zoom_png?width=1121&height=900
 
 ### Reconfigure model