diff --git a/R/helpers.R b/R/helpers.R index e9a986c..e655d40 100644 --- a/R/helpers.R +++ b/R/helpers.R @@ -44,6 +44,12 @@ get_judgements <- function(tool){ "No information", "Not applicable" ) + if (tool == "ROBIS") { ## ADDED ROBIS + values = c( + "High", + "Unclear", + "Low", + "No information" } return(values) @@ -410,7 +416,7 @@ check_data <- function(data){ # Check colours check_colour <- function(tool, colour) { if(!(colour[1] %in% c("cochrane","colourblind"))){ - 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)!=4){ stop(paste("Wrong number of colours specified.", "This template expects 4 colours.")) @@ -431,7 +437,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)] diff --git a/R/rob_summary.R b/R/rob_summary.R index 20ff8d2..63b72dd 100644 --- a/R/rob_summary.R +++ b/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) +} diff --git a/R/rob_traffic_light.R b/R/rob_traffic_light.R index e4f00eb..68d3ee1 100644 --- a/R/rob_traffic_light.R +++ b/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( @@ -816,3 +825,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) +}