Pull in ROBIS functionality

R/helpers.R

@@ -37,6 +37,12 @@ check_first_row <- function(data){
                "headings (e.g. \"Study\", \"Overall\"). Did you set ",
                "\"header = TRUE\" when reading in your data?")
     )
+  if (tool == "ROBIS") { ## ADDED ROBIS
+    values = c(
+      "High",
+      "Unclear",
+      "Low",
+      "No information"
   }
 
 }
@@ -515,10 +521,24 @@ get_judgements <- function(tool){
       "Not applicable"
     )
   }
-
+  if (tool == "ROBIS") {
+    values = c(
+      "High",
+      "Unclear",
+      "Low"
+     )
+   }
   return(values)
 }
 
+# Check colours
+check_colour <- function(tool, colour) {
+  if(!(colour[1] %in% c("cochrane","colourblind"))){
+    if (tool == "ROB2" || tool == "ROB2-Cluster" || tool == "QUADAS-2" || tool == "ROBIS") { ##ADDED ROBIS
+      if(length(colour)!=4){
+        stop(paste("Wrong number of colours specified.",
+                   "This template expects 4 colours."))
+      }
 
 # Define caption adjustment value, based on number of unique judgements
 get_caption_adjustment <- function(data){
@@ -532,7 +552,7 @@ get_colour <- function(tool, colour) {
 
   rob_colours$na_colour <- "#cccccc"
 
-  if (tool == "ROB2" || tool == "ROB2-Cluster" || tool == "QUADAS-2") {
+  if (tool == "ROB2" || tool == "ROB2-Cluster" || tool == "QUADAS-2" || tool = "ROBIS") { ##ADDED ROBIS
     if (length(colour) > 1) {
       rob_colours$low_colour <- colour[c(1)]
       rob_colours$concerns_colour <- colour[c(2)]

R/rob_summary.R

@@ -115,6 +115,16 @@ rob_summary <- function(data,
       ...
     )
   }
+  ### ADDED ROBIS
+  if (tool == "ROBIS") {
+    plot <- rob_summary_robis(
+      data = data,
+      tool = tool,
+      overall = overall,
+      weighted = weighted,
+      rob_colours = rob_colours
+    )
+  }
 
   plot$rec_height <- get_height(
     type = "summ"
@@ -507,3 +517,57 @@ rob_summary_generic <- function(data,
 
   return(plot)
 }
+
+# ROBIS ===================================================================================
+
+rob_summary_robis <- function(data,
+                             tool,
+                             overall,
+                             weighted,
+                             rob_colours) {
+  domain_names <- c(
+    "Study",
+    "Domain 1: Eligiability criteria",
+    "Domain 2: Identification and selection of studies",
+    "Domain 3: Data collection and study appraisal",
+    "Domain 4: Synthesis and findings",
+    "Overall risk of bias",
+    "Weights"
+  )
+
+  max_domain_column <- 6
+  }
+
+
+  rob.tidy <- tidy_data_summ(data,
+                             max_domain_column,
+                             overall,
+                             weighted,
+                             domain_names,
+                             levels = c("x", "n", "h", "s", "l"))
+
+  # Create plot
+  plot <- ggplot2::ggplot(data = rob.tidy) +
+    rob_summ_theme(overall, max_domain_column-2) +
+    ggplot2::scale_fill_manual(
+      "Risk of Bias",
+      values = c(
+        l = rob_colours$low_colour,
+        s = rob_colours$concerns_colour,
+        h = rob_colours$high_colour,
+        n = rob_colours$ni_colour,
+        x = rob_colours$na_colour
+      ),
+      labels = c(
+        n = "  No information  ",
+        h = "  High risk       ",
+        s = "  Unclear   ",
+        l = "  Low risk        ",
+        x = "  N/A  "
+      ),
+      drop = TRUE,
+      limits = force
+    )
+
+  return(plot)
+}

R/rob_traffic_light.R

@@ -127,6 +127,15 @@ rob_traffic_light <-
         ...
       )
     }
+       if (tool == "ROBIS") {
+      plot <- rob_traffic_light_robis(
+        data = data,
+        tool = tool,
+        rob_colours = rob_colours,
+        psize = psize,
+        overall = overall
+      )
+    }
 
     # Add recommended saving height to the plot object
     plot$rec_height <- get_height(
@@ -855,3 +864,82 @@ rob_traffic_light_generic <- function(data,
   return(trafficlightplot)
 
 }
+# ROBIS ==================================================================
+
+rob_traffic_light_robis <- function(data,
+                                   tool,
+                                   get_colour,
+                                   psize,
+                                   overall) {
+  max_domain_column <- 6
+  domain_names <- c("Study", "D1", "D2", "D3", "D4", "Overall")
+
+  rob.tidy <- tidy_data(data,
+                        max_domain_column = max_domain_column,
+                        domain_names = domain_names,
+                        overall = overall,
+                        levels = c("h", "s", "l", "n", "x"))
+
+  ssize <- psize - (psize / 4)
+
+  adjust_caption <- get_caption_adjustment(rob.tidy)
+
+  trafficlightplot <-
+    ggplot2::ggplot(rob.tidy,
+                    ggplot2::aes(x = 1,
+                                 y = 1,
+                                 colour = judgement)) +
+    rob_tf_theme(rob.tidy,
+                 domain_names,
+                 psize,
+                 ssize,
+                 adjust_caption,
+                 overall) +
+    ggplot2::labs(
+      caption = "  Domains:
+  Domain 1: Eligiability criteria
+  Domain 2: Identification and selection of studies
+  Domain 3: Data collection and study appraisal
+  Domain 4: Synthesis and findings
+ "
+    ) +
+    ggplot2::scale_colour_manual(
+      values = c(
+        h = rob_colours$high_colour,
+        s = rob_colours$concerns_colour,
+        l = rob_colours$low_colour,
+        n = rob_colours$ni_colour,
+        x = rob_colours$na_colour,
+        "black", "black", "black", "black", "black"
+      ),
+      labels = c(
+        h = "High",
+        s = "Some concerns",
+        l = "Low",
+        n = "No information",
+        x = "Not applicable"
+      ),
+      drop = TRUE,
+      limits = force
+    ) +
+    ggplot2::scale_shape_manual(
+      values = c(
+        h = 120,
+        s = 45,
+        l = 43,
+        n = 63,
+        x = 32
+      ),
+      labels = c(
+        h = "High",
+        s = "Unclear",
+        l = "Low",
+        n = "No information",
+        x = "Not applicable"
+      ),
+      drop = TRUE,
+      limits = force
+    )
+
+  return(trafficlightplot)
+}