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:
Related
I am trying to show ranking in line and increase in number means a decrease in rank. That's why to visualize this relation I multiple rank values with minus 1. However, in tooltip it shows up with minus sign and I can't make calculations in double curly braces. Code is below.
library(data.table)
library(sparkline)
library(tidyverse)
library(DT)
vec_line <- data.table(rank = c(3,2,6,7), cur_year=c(2001,2002,2003,2004))
line = spk_chr(-vec_line[,rank],
type="line",
chartRangeMin = min(-vec_line[,rank]),
chartRangeMax = max(-vec_line[,rank]),
xvalues = vec_line[,cur_year],
tooltipFormat= sprintf('<span style=\"color: {{color}}\">●</span> Year {{x}}: {{y}}.'),
numberDigitGroupSep = "",
width = 150,
height = 50,
lineColor = '#896B84',
fillColor = NULL,
lineWidth = 2)
datatable(data.table(graph = line),
escape = F,
options = list(fnDrawCallback = htmlwidgets::JS('function(){HTMLWidgets.staticRender();}')))%>%
spk_add_deps()
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
I want to skip a empty panel using lattice package in R.
set.seed(1)
df1 <- data.frame("treatment" = c(rep("A",16),rep("B",16),rep("C",16)),
"disease_type" = c(rep("1",8),rep("2",8)),
"days_after_application" = rep(c(rep("10-24",4),rep("24-48",4)),6),
"severity" = rnorm(48, mean = 80, sd = 5))
df1[(df1$disease_type == "2" & df1$days_after_application == "24-48"),"severity"] <- NA
library(lattice)
figure1 <- bwplot(treatment~severity|days_after_application+disease_type,
data = df1,layout = c(2,2),
strip = strip.custom(strip.names = TRUE))
jpeg("figure1.jpeg")
print(figure1)
dev.off()
Here is what I get
My question is how I can remove/skip empty panel in the top right WITHOUT changing layout?
I have tried following code. However, it doesn't work.
figure2 <- bwplot(treatment~severity|days_after_application+disease_type,
data = df1,layout = c(2,2),
strip = strip.custom(strip.names = TRUE),
skip = c(FALSE,FALSE,FALSE,TRUE))
jpeg("figure2.jpeg")
print(figure2)
dev.off()
Here is what I got
I also tried following codes. But it is not what I want since I do want 2 levels strips.
df1[(df1$disease_type == "2" & df1$days_after_application == "24-48"),] <- NA
bwplot(treatment~severity|interaction(days_after_application,disease_type),
data = df1,layout = c(2,2),
strip = strip.custom(strip.names = TRUE))
Thank you!
Get help from a Professor in Temple University.
Here is his solution:
figure4 <- bwplot(treatment~severity|days_after_application+disease_type,
data = df1,layout = c(2,2),
strip = strip.custom(strip.names = TRUE),
skip = c(FALSE,FALSE,FALSE,TRUE),
scales=list(alternating=FALSE), ## keep x-scale on bottom
between=list(x=1, y=1)) ## space between panels
pdf("figure4%03d.pdf",onefile = FALSE) ## force two pages in file.
print(figure4)
dev.off()
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)
I have a question about the par function in R.
I want to change the color and/or width of a line in a graph with par function. (I am using par function because the gaps.plot command below does not allow "col" option to be included. The gaps.plot command is used after the synth command).
So, I used the following command. But I noticed that the lines of the BOX are changed rather than the lines of the GRAPHS.
synth1<-read.csv(file="C:\\Users\\Research\\R\\synthinR_v4.csv",header=TRUE)
attach(synth1)
library("Synth")
dataprep.out34 <- dataprep(foo = synth1, predictors = c("lncdsales", "md1", "md2","md3", "md4", "md5", "md6", "md7", "md8", "md9", "md10", "md11", "yd1", "yd2", "yd3", "yd4", "yd5", "yd6", "yd7", "yd8"), predictors.op = "mean", time.predictors.prior = -13:1, dependent = "lndigital", unit.variable = "artistalbumcode", time.variable = "release", treatment.identifier = 34, controls.identifier = c(1:33, 35:49), time.optimize.ssr = -13:1, time.plot = -13:25)
synth.out34 <- synth(data.prep.obj = dataprep.out34, method = "BFGS")
par(lwd = 2, col="#cccccc")
gaps.plot(synth.res = synth.out34, dataprep.res = dataprep.out34, Ylab = " Log Digital Sales ", Xlab = "Release", Ylim = c(-7, 7) , Main = NA)
Does anyone know how to fix this problem??
Thank you in advance for your willingness to help. I greatly appreciate it!
The col argument to par sets the default plotting colour (i.e. when col is not explicitly specified in plotting calls), but unfortunately col = "black" is hard-coded into the source of gaps.plot.
You can make a modified copy of the function by either (1) viewing the source (F2 in RStudio, or just executing gaps.plot), editing it and assigning it to a new object, or (2) doing something like the following:
gaps.plot2 <- eval(parse(text=gsub('col = "black"', 'col = "red"',
deparse(Synth:::gaps.plot))))
and then using gaps.plot2 as you would use gaps.plot:
gaps.plot2(synth.res = synth.out34, dataprep.res = dataprep.out34,
Ylab = " Log Digital Sales ", Xlab = "Release", Ylim = c(-7, 7) ,
Main = NA)
Alter the lwd similarly. For example to make lines red and have width of 3, use nested gsub calls like this:
gaps.plot2 <- eval(parse(text=gsub('lwd = 2', 'lwd = 3',
gsub('col = "black"', 'col = "red"',
deparse(Synth:::gaps.plot)))))