I've been struggling the whole day with creating a flow chart to represent some patients we included in a study.
I already have a rough version ready in a Power Point presentation, depicting what kind of arrangement I'm looking for.
Now, I've got all my boxes ready, but what I need is the same alignment and connection to the arrows as in the picture attached. I have tried to somewhat copy and paste the guide on this page https://cran.r-project.org/web/packages/Gmisc/vignettes/Grid-based_flowcharts.html, but now I'm stuck. Since I have little expertise using R and only work with it occasionally, there might be something easy you might see, that I don't.
Here's my code:
install.packages("Gmisc")
library(Gmisc, quietly = TRUE)
library(glue)
library(htmlTable)
library(grid)
library(magrittr)
org_cohort <- boxGrob(glue("Patients with pancreatic cancer admitted to the University Clinic of Essen",
"from 01/2002 to 08/2020",
"n = {pop}",
pop = txtInt(909),
.sep = "\n"))
included <- boxGrob(glue("Patients with genetic sequencing and survival data",
"n = {incl}",
incl = txtInt(412),
.sep = "\n"))
grp_a <- boxGrob(glue("Patients treated with FOLFIRINOX or Gemcitabine / nab-Paclitaxel",
"n = {recr}",
recr = txtInt(179),
.sep = "\n"))
grp_b <- boxGrob(glue("Patients with genetic sequencing data via MAPK-TRON panel",
"n = {recr}",
recr = txtInt(185),
.sep = "\n"))
excluded_1 <- boxGrob(glue("Excluded (n = {tot}):",
" - No survival data: {NoSurv}",
" - No MAPK-Tron panel and early available abdominal CT-scan: {NoMAPKCT}",
tot = 506,
NoSurv = 300,
NoMAPKCT = 206,
.sep = "\n"),
just = "left")
excluded_2 <- boxGrob(glue("Excluded (n = {NoFGP}):",
" - No FOLFIRINOX or Gemcitabine / nab-Paclitaxel as 1st line: {NoFGP}",
NoFGP = 233,
.sep = "\n"),
just = "left")
excluded_3 <- boxGrob(glue("Excluded (n = {NoMAPK}):",
" - No sequencing data available: {NoMAPK}",
NoMAPK = 227,
.sep = "\n"),
just = "left")
grid.newpage()
vert <- spreadVertical(org_cohort = org_cohort,
included = included,
grps = grp_a)
grps <- alignVertical(reference = vert$grp_a,
grp_a, grp_b) %>%
spreadHorizontal()
vert$grps <- NULL
excluded_1 <- moveBox(excluded_1,
x = .8,
y = coords(vert$included)$top + distance(vert$included, vert$org_cohort, half = TRUE, center = FALSE))
excluded_2 <- moveBox(excluded_2,
x = .8,
y = coords(vert$grp_a)$top + distance(vert$included, vert$grp_a, half = TRUE, center = FALSE))
excluded_3 <- moveBox(excluded_3,
x = .8,
y = coords(vert$grp_b)$bottom + distance(vert$included, vert$grp_b, half = TRUE, center = FALSE))
## already facing problems here: R gives me the following error message: Error in coords(vert$grp_a/b) :
#Assertion on 'box' failed: Must inherit from class 'box', but has class 'NULL'..
for (i in 1:(length(vert) - 1)) {
connectGrob(vert[[i]], vert[[i + 1]], type = "vert") %>%
print
}
connectGrob(vert$included, grps[[1]], type = "N")
connectGrob(vert$included, grps[[2]], type = "N")
connectGrob(vert$included, excluded_1, type = "L")
connectGrob(vert$grp_a, excluded_2, type = "L")
# Print boxes
vert
grps
excluded_1
excluded_2
excluded_3
I'll be honest: I don't really get the code after the "grid.newpage()" thing. Therefore I'm constantly trying something to understand what the components of the code actually do, but every time I think I understood how it works, another setback is waiting for me around the corner.
R basically gives me a plot with arrows and boxes all over the place, but not the way I want them to look like. Then sometimes my boxes are even too large or something? Especially the boxes of the two subgroups at the end of the chart are cut-off oftentimes...
Do you have an idea how to "force" R replicating that kind of chart (see picture) for me?
Your help is extremely appreciated and would bring me a step closer to finally finish my thesis...!
Thank you in advance!!
Here is something to get your started with DiagrammeR.
Use splines = ortho to get 90 degree angles and straight lines.
Add line breaks with <br/> in the labels of nodes.
Use blank nodes to get branches for exclusion boxes. Then use rank
to get the hidden blank nodes to line up with exclusion boxes.
Hope this is helpful.
library(DiagrammeR)
grViz(
"digraph my_flowchart {
graph[splines = ortho]
node [fontname = Helvetica, shape = box, width = 4, height = 1]
node1[label = <Pancreatic cancer patients treated at our center<br/>diagnosed 2002-2020<br/>(n = 909)>]
node2[label = <Patients with MAPK-TRON panel and/or<br/>early available abdominal CT scan (n = 412)>]
blank1[label = '', width = 0.01, height = 0.01]
excluded1[label = <Exclusion of patients without<br/>(1) MARK-TRON panel and early available abdominal CT scan, and<br/>(2) survival data<br/>(n = 506)>]
node1 -> blank1[dir = none];
blank1 -> excluded1[minlen = 2];
blank1 -> node2;
{ rank = same; blank1 excluded1 }
node3[label = <FOLFIRINOX or Gemcitabine/nab-Paclitaxel as first CTx<br/>(n = 179)>]
node4[label = <Patients with MAPK-TRON panel regardless of CT scans<br/>(n = 185)>]
blank2[label = '', width = 0.01, height = 0.01]
excluded2[label = <Exclusion of patients that did not receive<br/>FOLFIRINOX or Gemcitabine/nab Paclitaxel as first CTx<br/>(n = 233)>]
blank3[label = '', width = 0.01, height = 0.01]
excluded3[label = <Exclusion of patients without MAPK-TRON panel<br/>(n = 227)>]
node2 -> blank2[dir = none];
node2 -> blank3[dir = none];
blank2 -> excluded2[minlen = 2];
blank3 -> excluded3[minlen = 2];
blank2 -> node3;
blank3 -> node4;
{ rank = same; blank2 excluded2 blank3 excluded3 }
}"
)
Diagram
Related
I cannot find how to adjust distance from labels to table in grid.arrange:
distances_lsit = c(25,50,75,100)
category_lsit = 0:5
damage_table = matrix(NA, nrow=length(distances_lsit), ncol=length(category_lsit))
damage_table[1,] = c(10,25,50,75,100,100)
damage_table[2,] = c(5,10,25,50,75,100)
damage_table[3,] = c(2.5,5,10,25,50,75)
damage_table[4,] = c(0,2.5,5,10,25,50)
rownames(damage_table) = distances_lsit
colnames(damage_table) = category_lsit
table_scale = tableGrob(damage_table)
grid.arrange(table_scale, top = "Label 1", left = "Label 2")
which produces table as follows:
Is there anyway to glue it to the table? Thank you in advance for your help.
You should play with next parameters for finding your best location
heights;
widths;
textGrob.
For example, this:
grid.arrange(table_scale, top = textGrob("Really looks \n better now?", x = 0, hjust = -1), left = "I'm near,\n my man", heights = c(2,1), widths = c(1,1.5))
show to you this:
I'm plotting decision trees built with partykit in ggparty, and struggling to rotate the tree branches around branch nodes- as in, change the order they are displayed. I'm hoping to plot a tree with the branches displayed in an order according to the values of the terminal nodes. This would be somewhat comparable to using reorder() in a standard ggplot geom.
For instance, outlined below using the WeatherPlay data from the ggparty vignette, can the branches of this tree be rotated so that terminal node geom_bar() plots are displayed in increasing order of proportion "yes"? In this case, this would mean "sunny", then "rainy", then "overcast".
For my project I'll have terminal nodes with boxplots, but I'm guessing that the method for rotating branches is modular and can be repurposed.
## Playing with default WeatherPlay data as demonstrated in ggparty examples here:
# https://cran.r-project.org/web/packages/ggparty/vignettes/ggparty-graphic-partying.html
library(partykit)
library(ggparty)
data("WeatherPlay", package = "partykit")
sp_o <- partysplit(1L, index = 1:3)
sp_h <- partysplit(3L, breaks = 75)
sp_w <- partysplit(4L, index = 1:2)
pn <- partynode(1L, split = sp_o, kids = list(
partynode(2L, split = sp_h, kids = list(
partynode(3L, info = "yes"),
partynode(4L, info = "no"))),
partynode(5L, info = "yes"),
partynode(6L, split = sp_w, kids = list(
partynode(7L, info = "yes"),
partynode(8L, info = "no")))))
py <- party(pn, WeatherPlay)
# Node plots
n1 <- partynode(id = 1L, split = sp_o, kids = lapply(2L:4L, partynode))
t2 <- party(n1,
data = WeatherPlay,
fitted = data.frame(
"(fitted)" = fitted_node(n1, data = WeatherPlay),
"(response)" = WeatherPlay$play,
check.names = FALSE),
terms = terms(play ~ ., data = WeatherPlay)
)
t2 <- as.constparty(t2)
# Plot tree
ggparty(t2) +
geom_edge() +
geom_edge_label() +
geom_node_splitvar() +
geom_node_plot(gglist = list(geom_bar(aes(x = "", fill = play),
position = position_fill()),
xlab("play")),
# draw only one label for each axis
shared_axis_labels = TRUE,
# draw line between tree and legend
legend_separator = TRUE
)
I want to create a PAG(parental ancestral graph) with visNetwork for my shiny app.
In order to do that i have to create edges that have both circles and arrows.
According to the visNetwork package i can convert the arrows to circles like this
visNetwork(nodes, edges) %>%
visEdges(arrows = list(to = list(enabled = TRUE,
scaleFactor = 2, type = 'circle')))
But i want to have both an arrow and a circle, or two circles in one edge like in this picture
PAG
The arrows.from.type and arrows.to.type seem to be working but i now i have this problem.
I want to draw this graph according to an adjacency matrix
So i have this code
i = 1
j = 1
for(i in i:ncol(results))
{
j = i
for(j in j:nrow(results))
{
if(results[j,i]==1)
{
dashBoard = c(dashBoard,TRUE)
colorBoard = c(colorBoard, "green")
if(results[i,j]==1)
{
fromtest <- c(fromtest,Cnames[i])
totest <- c(totest,Rnames[j])
arrfrom <-c(arrfrom,"circle")
arrto<-c(arrto,"circle")
}
else if(results[i,j]==2)
{
fromtest<-c(fromtest,Cnames[i])
totest<-c(totest,Rnames[j])
arrfrom <-c(arrfrom,"circle")
arrto<-c(arrto,"arrow")
}}
That goes on for every possible combination except 1,1 and 1,2
In the end the edges are printed like that
edgesprint <-data.frame(from = fromtest,
to = totest,
arrows.from.type=arrfrom,
arrows.to.type=arrto,
dashes = dashBoard,
physics = FALSE,
smooth = FALSE,
width = 3,
shadow = TRUE,
color = list(color = colorBoard, highlight = "red", hover = "green"),
links = links)
This method works good but sometimes without changing any code i get this error
error in data.frame arguments imply differing number of rows
You can set individual arrow types in the edges data frame by adding columns arrows.to.type and arrows.from.type:
library(visNetwork)
library(magrittr)
nodes <- data.frame(id=c("a","b","c","d"), label=c("a","b","c","d"))
edges <- data.frame(
from = c("a","a","a"),
to = c("b","c","d"),
arrows.from.type = c(NA,"circle","circle"),
arrows.to.type = c("arrow","circle",NA)
)
visNetwork(nodes, edges)
Result:
This approach works for all other attributes you can set through visNodes and visEdges. See here for an example.
I created a Sankey diagram using the plotly package.
Please look at below example. I tried to make five streams, 1_6_7, 2_6_7, and so on. But two of five links between 6 and 7 disappeared. As far as I see, plotly allows to make only three or less links between two nodes.
Can I remove this restrictions ? Any help would be greatly appreciated.
Here is an example code and the outputs:
d <- expand.grid(1:5, 6, 7)
node_label <- 1:max(d)
node_colour <- scales::alpha(RColorBrewer::brewer.pal(7, "Set2"), 0.8)
link_source_nodeind <- c(d[,1], d[,2]) - 1
link_target_nodeind <- c(d[,2], d[,3]) - 1
link_value <- rep(100, nrow(d) * 2)
link_label <- rep(paste(d[,1], d[,2], d[,3], sep = "_"), 2)
link_colour <- rep(scales::alpha(RColorBrewer::brewer.pal(5, "Set2"), 0.2), 2)
p <- plotly::plot_ly(type = "sankey",
domain = c(x = c(0,1), y = c(0,1)),
orientation = "h",
node = list(label = node_label,
color = node_colour),
link = list(source = link_source_nodeind,
target = link_target_nodeind,
value = link_value,
label = link_label,
color = link_colour))
p
Absolutely cannot figure out why the error is coming even though there are no self edges.
Below is a reproducible code. Any help would be great
library(HiveR)
nodes = data.frame(id = 1:9, lab = c("A","B","C","E","F","G","H","I","J"),
axis = c(1,1,1,2,3,2,2,2,3), radius = rep(50,9),size = rep(10,9),
color = c("yellow","yellow","yellow", "green","red","green","green","green","red"))
edges = data.frame(id1 = c(1,2,3,4,5,4,1,9,8,6,1),id2 = c(2,3,4,1,9,9,9,8,7,7,6),
weight = rep(1,11),
color = c(rep("green",7), rep("red",4)))
test3 <- ranHiveData(nx = 3)
test3$nodes = nodes
test3$edges = edges
test3$edges$color <- as.character(test3$edges$color)
test3$edges$id1 <- as.integer(test3$edges$id1)
test3$edges$id2 <- as.integer(test3$edges$id2)
test3$nodes$color <- as.character(test3$nodes$color)
test3$nodes$lab <- as.character(test3$nodes$lab)
test3$nodes$axis = as.integer(test3$nodes$axis)
test3$nodes$id = as.integer(test3$nodes$id)
test3$nodes$radius = as.numeric(test3$nodes$radius)
test3$nodes$size = as.numeric(test3$nodes$size)
test3$edges$weight = as.numeric(test3$edges$weight)
test3$desc = "3 axes --9 nodes -- 11 edges"
sumHPD(test3, chk.sm.pt = TRUE)
The code is giving self edges and the the plot is not rendering plotHive(test3) showing
Error in calcCurveGrob(x,x$debug) : end points must not be identical
In your code the position of the nodes of the axis (radius) are all set to 50. Hence there are overlapping points (3 on axis 1, 4 on axes 2 and 2 on axis 3).
A correct definition of radius solves the problem.
library(HiveR)
# radius has been changed !
nodes = data.frame(id = 1:9, lab = c("A","B","C","E","F","G","H","I","J"),
axis = c(1,1,1,2,3,2,2,2,3), radius = c(1,2,3,1,1,2,3,4,2),size = rep(1,9),
color = c("yellow","yellow","yellow", "green","red","green","green","green","red"))
edges = data.frame(id1 = c(1,2,3,4,5,4,1,9,8,6,1),id2 = c(2,3,4,1,9,9,9,8,7,7,6),
weight = rep(1,11),
color = c(rep("green",7), rep("red",4)))
test3 <- ranHiveData(nx = 3)
test3$nodes = nodes
test3$edges = edges
test3$edges$color <- as.character(test3$edges$color)
test3$edges$id1 <- as.integer(test3$edges$id1)
test3$edges$id2 <- as.integer(test3$edges$id2)
test3$nodes$color <- as.character(test3$nodes$color)
test3$nodes$lab <- as.character(test3$nodes$lab)
test3$nodes$axis = as.integer(test3$nodes$axis)
test3$nodes$id = as.integer(test3$nodes$id)
test3$nodes$radius = as.numeric(test3$nodes$radius)
test3$nodes$size = as.numeric(test3$nodes$size)
test3$edges$weight = as.numeric(test3$edges$weight)
test3$desc = "3 axes --9 nodes -- 11 edges"
sumHPD(test3, chk.sm.pt = TRUE)
plotHive(test3)