refactored plotNetwork() cleaner and to work with binData

* still needs more sorting out tho
ICON-in-R · Nov 8, 2023 · c7dac62 · c7dac62
1 parent 84d2b66
commit c7dac62
Show file tree

Hide file tree

Showing 4 changed files with 31 additions and 52 deletions.
diff --git 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
@@ -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
@@ -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
@@ -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