Skip to content

Commit

Permalink
Merge pull request #10 from chriscpritchard/shiny-update
Browse files Browse the repository at this point in the history 
Shiny improvements
  • Loading branch information
@nealhaddaway
nealhaddaway authored Jul 7, 2021
2 parents eb76a3c + 0be1ed7 commit 2b105e9
Show file tree
Hide file tree
Showing 22 changed files with 419 additions and 1,037 deletions.
10 changes: 7 additions & 3 deletions DESCRIPTION
View file
Original file line number Diff line number Diff line change
@@ -1,6 +1,6 @@
Package: PRISMA2020
Title: Make Interactive 'PRISMA' Flow Diagrams
Version: 0.0.1
Version: 0.0.2
Authors@R: c(
person(given = "Neal",
family = "Haddaway",
Expand All @@ -10,7 +10,9 @@ Authors@R: c(
person("Luke", "McGuinness", role = "aut",
email = "[email protected]",
comment = c(ORCID = "0000-0001-8730-9761")),
person("Chris", "Pritchard", role = "ctb")
person("Chris", "Pritchard", role = "aut",
email = "[email protected]",
comment = c(ORCID = "0000-0002-1143-9751"))
)
Description: Systematic reviews should be described in a high degree of
methodological detail. The 'PRISMA' Statement calls for a high level of
Expand All @@ -23,7 +25,7 @@ Description: Systematic reviews should be described in a high degree of
texts), with a mouse-over tool tip that describes the information linked
to in more detail. Interactive versions can be saved as HTML files,
whilst static versions for inclusion in manuscripts can be saved as
PNG or TIFF files.
HTML, PDF, PNG, SVG, PS or WEBP files.
Imports:
DiagrammeR,
DiagrammeRsvg,
Expand All @@ -38,6 +40,8 @@ Imports:
utils,
xml2,
webp,
DT,
rio,
tools
License: MIT + file LICENSE
Encoding: UTF-8
Expand Down
1 change: 1 addition & 0 deletions NAMESPACE
View file
Original file line number Diff line number Diff line change
@@ -1,5 +1,6 @@
# Generated by roxygen2: do not edit by hand

export(PRISMA_data)
export(PRISMA_flowdiagram)
export(PRISMA_save)
export(read_PRISMAdata)
Expand Down
192 changes: 75 additions & 117 deletions R/PRISMA_flowdiagram.R
View file
Original file line number Diff line number Diff line change
@@ -1,13 +1,14 @@
#' Plot interactive flow diagrams for systematic reviews
#'
#'
#' @description Produces a PRISMA2020 style flow diagram for systematic reviews,
#' with the option to add interactivity through tooltips (mouseover popups) and
#' hyperlink URLs to each box. Data can be imported from the standard CSV template
#' provided.
#' @param data List of data inputs including numbers of studies, box text, tooltips
#' and urls for hyperlinks. Data inputted via the `read_PRISMAdata()` function. If
#' and urls for hyperlinks. Data inputted via the [PRISMA_data()] function. If
#' inputting individually, see the necessary parameters listed in the
#' `read_PRISMAdata()` function and combine them in a list using `data <- list()`.
#' [PRISMA_data()]) function and combine them in a list using `data <- list()`.
#' @param interactive Logical argument TRUE or FALSE whether to plot interactivity
#' (tooltips and hyperlinked boxes).
#' @param previous Logical argument (TRUE or FALSE) specifying whether previous
Expand All @@ -34,12 +35,13 @@
#' @param arrow_tail The tail shape for the line connectors. The default is
#' 'none'. See DiagrammeR arrow shape specification
#' <http://rich-iannone.github.io/DiagrammeR/graphviz_and_mermaid.html#arrow-shapes>.
#' @param side_boxes Whether or not to include the blue label boxes along the side
#' @return A flow diagram plot.
#' @examples
#' \dontrun{
#' data <- read.csv(file.choose(), stringsAsFactors=FALSE);
#' data <- read_PRISMAdata(data);
#' attach(data);
#' data <- PRISMA_data(data);
#' attach(data);
#' plot <- PRISMA_flowdiagram(data,
#' fontsize = 12,
#' interactive = TRUE,
Expand All @@ -59,13 +61,13 @@ PRISMA_flowdiagram <- function (data,
main_colour = 'Black',
arrow_colour = 'Black',
arrow_head = 'normal',
arrow_tail = 'none') {
arrow_tail = 'none',
side_boxes = TRUE) {
#wrap exclusion reasons
dbr_excluded[,1] <- stringr::str_wrap(dbr_excluded[,1],
width = 35)
other_excluded[,1] <- stringr::str_wrap(other_excluded[,1],
width = 35)

if(stringr::str_count(paste(dbr_excluded[,1], collapse = "\n"), "\n") > 3){
dbr_excludedh <- 3.5 - ((stringr::str_count(paste(dbr_excluded[,1], collapse = "\n"), "\n")-4)/9)
} else {
Expand Down Expand Up @@ -158,7 +160,19 @@ PRISMA_flowdiagram <- function (data,
prevnode2 <- ""

}

if(side_boxes == TRUE){
sidebox <- paste0("node [shape = box,
fontsize = ", fontsize,",
fontname = ", font, ",
color = ", title_colour, "
]
identification [color = LightSteelBlue2, label=' ', style = 'filled,rounded', pos='",-1.4,",",ystart+7,"!', width = 0.4, height = 1.5, tooltip = '", tooltips[20], "'];
screening [color = LightSteelBlue2, label=' ', style = 'filled,rounded', pos='",-1.4,",",ystart+4.5,"!', width = 0.4, height = 2.5, tooltip = '", tooltips[21], "'];
included [color = LightSteelBlue2, label=' ', style = 'filled,rounded', pos='",-1.4,",",h_adj1+0.87,"!', width = 0.4, height = ",2.5-h_adj2,", tooltip = '", tooltips[22], "'];\n
")
} else {
sidebox <- ""
}
if(other == TRUE){
if (is.data.frame(other_excluded) == TRUE){
other_excluded_data <- paste0(':',
Expand Down Expand Up @@ -269,17 +283,8 @@ PRISMA_flowdiagram <- function (data,
x <- DiagrammeR::grViz(
paste0("digraph TD {
graph[splines=ortho, layout=neato, tooltip = 'Click the boxes for further information', outputorder=edgesfirst]
node [shape = box,
fontsize = ", fontsize,",
fontname = ", font, ",
color = ", title_colour, "
]
identification [color = LightSteelBlue2, label=' ', style = 'filled,rounded', pos='",-1.4,",",ystart+7,"!', width = 0.4, height = 1.5, tooltip = '", tooltips[20], "'];
screening [color = LightSteelBlue2, label=' ', style = 'filled,rounded', pos='",-1.4,",",ystart+4.5,"!', width = 0.4, height = 2.5, tooltip = '", tooltips[21], "'];
included [color = LightSteelBlue2, label=' ', style = 'filled,rounded', pos='",-1.4,",",h_adj1+0.87,"!', width = 0.4, height = ",2.5-h_adj2,", tooltip = '", tooltips[22], "'];\n
",
graph[splines=ortho, layout=neato, tooltip = 'Click the boxes for further information', outputorder=edgesfirst]",
sidebox,
previous_nodes,"
node [shape = box,
fontsize = ", fontsize,",
Expand Down Expand Up @@ -438,29 +443,30 @@ PRISMA_flowdiagram <- function (data,
}
")
)

x <- insertJS_(x, identification_text = identification_text,screening_text = screening_text,included_text = included_text)
if (side_boxes == TRUE) {
x <- PRISMA_insert_js_(x, identification_text = identification_text,screening_text = screening_text,included_text = included_text)
}

if (interactive == TRUE) {
x <- sr_flow_interactive(x, urls, previous = previous, other = other)
x <- PRISMA_interactive_(x, urls, previous = previous, other = other)
}
return(x)
}


#' Read in PRISMA flow diagram data
#'
#'
#' @description Read in a template CSV containing data for the flow diagram
#' @param data File to read in.
#' @return A list of objects needed to plot the flow diagram
#' @examples
#' @examples
#' \dontrun{
#' data <- read.csv(file.choose(), stringsAsFactors=FALSE);
#' data <- read_PRISMAdata(data);
#' data <- PRISMA_data(data);
#' attach(data);
#' }
#' @export
read_PRISMAdata <- function(data){
PRISMA_data <- function(data){

#Set parameters
previous_studies <- scales::comma(as.numeric(data[grep('previous_studies', data[,1]),]$n))
Expand Down Expand Up @@ -585,94 +591,11 @@ read_PRISMAdata <- function(data){

}


#' Plot interactive flow diagram for systematic reviews
#'
#' @description Converts a PRISMA systematic review flow diagram into an
#' interactive HTML plot, for embedding links from each box.
#' @param plot A plot object from sr_flow().
#' @param urls A dataframe consisting of two columns: nodes and urls. The first
#' column should contain 19 rows for the nodes from node1 to node19. The second
#' column should contain a corresponding URL for each node.
#' @param previous Logical argument (TRUE or FALSE) (supplied through
#' PRISMA_flowdiagram()) specifying whether previous studies were sought.
#' @param other Logical argument (TRUE or FALSE) (supplied through
#' PRISMA_flowdiagram()) specifying whether other studies were sought.
#' @return An interactive flow diagram plot.
#' @examples
#' \dontrun{
#' urls <- data.frame(
#' box = c('box1', 'box2', 'box3', 'box4', 'box5', 'box6', 'box7', 'box8',
#' 'box9', 'box10', 'box11', 'box12', 'box13', 'box14', 'box15', 'box16'),
#' url = c('page1.html', 'page2.html', 'page3.html', 'page4.html', 'page5.html',
#' 'page6.html', 'page7.html', 'page8.html', 'page9.html', 'page10.html',
#' 'page11.html', 'page12.html', 'page13.html', 'page14.html', 'page15.html',
#' 'page16.html'));
#' output <- sr_flow_interactive_p1o1(x, urls, previous = TRUE, other = TRUE);
#' output
#' }
#' @export
sr_flow_interactive <- function(plot,
urls,
previous,
other) {

if(paste0(previous, other) == 'TRUETRUE'){
link <- data.frame(boxname = c('identification', 'screening', 'included', 'prevstud', 'box1', 'newstud', 'box2', 'box3', 'box4', 'box5', 'box6', 'box7',
'box8', 'box9', 'box10', 'othstud', 'box11', 'box12', 'box13', 'box14', 'box15', 'box16', 'A', 'B'),
node = paste0('node', seq(1, 24)))
target <- c('node1', 'node2', 'node3', 'node4', 'node5', 'node23', 'node6', 'node7', 'node8', 'node9', 'node10', 'node11', 'node12', 'node13', 'node14',
'node15', 'node22', 'node16', 'node17', 'node18', 'node19', 'node20', 'node21', 'node24')
} else if(paste0(previous, other) == 'FALSETRUE'){
link <- data.frame(boxname = c('identification', 'screening', 'included', 'newstud', 'box2', 'box3', 'box4', 'box5', 'box6', 'box7',
'box8', 'box9', 'box10', 'othstud', 'box11', 'box12', 'box13', 'box14', 'box15', 'B'),
node = paste0('node', seq(1, 20)))
target <- c('node1', 'node2', 'node3', 'node4', 'node5', 'node6', 'node7', 'node8', 'node9', 'node10', 'node11', 'node12', 'node13', 'node14', 'node15',
'node16', 'node17', 'node18', 'node19', 'node20')
}
else if(paste0(previous, other) == 'TRUEFALSE'){
link <- data.frame(boxname = c('identification', 'screening', 'included', 'prevstud', 'box1', 'newstud', 'box2', 'box3', 'box4', 'box5', 'box6', 'box7',
'box8', 'box9', 'box10', 'box16', 'A'),
node = paste0('node', seq(1, 17)))
target <- c('node1', 'node2', 'node3', 'node4', 'node5', 'node6', 'node7', 'node8', 'node9', 'node10', 'node11', 'node12', 'node13', 'node14', 'node15',
'node16', 'node17')
}
else {
link <- data.frame(boxname = c('identification', 'screening', 'included', 'newstud', 'box2', 'box3', 'box4', 'box5', 'box6', 'box7',
'box8', 'box9', 'box10'),
node = paste0('node', seq(1, 13)))
target <- c('node1', 'node2', 'node3', 'node4', 'node5', 'node6', 'node7', 'node8', 'node9', 'node10', 'node11', 'node12', 'node13')
}


link <- merge(link, urls, by.x = 'boxname', by.y = 'box', all.x = TRUE)
link <- link[match(target, link$node),]
node <- link$node
url <- link$url

#the following function produces three lines of JavaScript per node to add a specified hyperlink for the node, pulled in from nodes.csv
myfun <- function(node,
url){
t <- paste0('const ', node, ' = document.getElementById("', node, '");
var link', node, ' = "<a href=\'', url, '\' target=\'_blank\'>" + ', node, '.innerHTML + "</a>";
', node, '.innerHTML = link', node, ';
')
}
#the following code adds the location link for the new window
javascript <- htmltools::HTML(paste(mapply(myfun,
node,
url),
collapse = '\n'))
htmlwidgets::prependContent(plot,
htmlwidgets::onStaticRenderComplete(javascript))
}


#' Save PRISMA2020 flow diagram
#'
#' @description Save the output from PRISMA_flowdiagram() to the
#' @description Save the output from [PRISMA_flowdiagram()] to the
#' working directory.
#' @param plotobj A plot produced using PRISMA_flowdiagram().
#' @param plotobj A plot produced using [PRISMA_flowdiagram()].
#' @param filename The filename to save (including extension)
#' @param filetype The filetype to save the plot in, supports: HTML, PDF, PNG, SVG, PS and WEBP
#' (if NA, the filetype will be calculated out based on the file extension)
Expand All @@ -681,7 +604,7 @@ sr_flow_interactive <- function(plot,
#' @examples
#' \dontrun{
#' data <- read.csv(file.choose());
#' data <- read_PRISMAdata(data);
#' data <- PRISMA_data(data);
#' attach(data);
#' plot <- PRISMA_flowdiagram(data,
#' fontsize = 12,
Expand All @@ -692,7 +615,7 @@ sr_flow_interactive <- function(plot,
#' }
#' @export
PRISMA_save <- function(plotobj, filename = 'PRISMA2020_flowdiagram.html', filetype = NA){
format_real <- calc_filetype_(filename, filetype)
format_real <- PRISMA_calc_filetype_(filename, filetype)
switch(
format_real,
"HTML" = {
Expand All @@ -703,28 +626,63 @@ PRISMA_save <- function(plotobj, filename = 'PRISMA2020_flowdiagram.html', filet
}
},
"PDF" = {
tmp_svg <- gen_tmp_svg_(plotobj)
tmp_svg <- PRISMA_gen_tmp_svg_(plotobj)
rsvg::rsvg_pdf(tmp_svg, filename)
},
"PNG" = {
tmp_svg <- gen_tmp_svg_(plotobj)
tmp_svg <- PRISMA_gen_tmp_svg_(plotobj)
rsvg::rsvg_png(tmp_svg, filename)
},
"SVG" = {
tmp_svg <- gen_tmp_svg_(plotobj)
tmp_svg <- PRISMA_gen_tmp_svg_(plotobj)
if (!(file.copy(tmp_svg, filename, overwrite = TRUE))){
stop("Error saving SVG")
}
},
"PS" = {
tmp_svg <- gen_tmp_svg_(plotobj)
tmp_svg <- PRISMA_gen_tmp_svg_(plotobj)
rsvg::rsvg_ps(tmp_svg, filename)
},
"WEBP" = {
tmp_svg <- gen_tmp_svg_(plotobj)
tmp_svg <- PRISMA_gen_tmp_svg_(plotobj)
rsvg::rsvg_webp(tmp_svg, filename)
},
stop("Please choose one of the supported file types")
)
return(tools::file_path_as_absolute(filename))
}

#' Plot interactive flow diagram for systematic reviews - DEPRECATED
#'
#' @description DEPRECATED - Converts a PRISMA systematic review flow diagram into an
#' interactive HTML plot, for embedding links from each box.
#' @seealso [PRISMA_interactive_()]
#' @param plot A plot object from [PRISMA_flowdiagram()].
#' @param urls A dataframe consisting of two columns: nodes and urls. The first
#' column should contain 19 rows for the nodes from node1 to node19. The second
#' column should contain a corresponding URL for each node.
#' @param previous Logical argument (TRUE or FALSE) (supplied through
#' [PRISMA_flowdiagram()]) specifying whether previous studies were sought.
#' @param other Logical argument (TRUE or FALSE) (supplied through
#' [PRISMA_flowdiagram()]) specifying whether other studies were sought.
#' @return An interactive flow diagram plot.
#' @export
sr_flow_interactive <- function(plot,
urls,
previous,
other) {
.Deprecated("PRISMA_interactive_")
return(PRISMA_interactive_(plot, urls, previous, other))
}

#' Read in PRISMA flow diagram data - DEPRECATED
#' @description DEPRECATED - read in a template CSV containing data for the flow diagram
#' @seealso [PRISMA_data()]
#' @param data File to read in.
#' @return A list of objects needed to plot the flow diagram
#' @export
read_PRISMAdata <- function(data){
.Deprecated("PRISMA_data")
x <- PRISMA_data(data)
return(x)
}
Loading

0 comments on commit 2b105e9

Please sign in to comment.