Related
you'll see with the code below that I end up with a nicely faceted plot that looks how I need it, but all I want is to hide the y axis labels for all facets except the ones on the far left. So hide labels for facet 2, 3, 4, 6, and 7. That way I am just left with "White", "Black", and "Hispanic" on the far left of each row (I can clean up the prefix_ later). Any ideas?
d2 %>%
ggplot(., aes(x = var_new, y = coef,
ymin = ci_lower, ymax = ci_upper)) +
geom_point(color = "red") +
geom_errorbar(width = 0,
size = 1,
color = "red") +
facet_wrap(~model,
nrow = 2,
scales = "free") +
geom_hline(yintercept = 0, linetype = "dashed", color = "black", size = .3) +
coord_flip() +
theme_minimal(base_size = 10) +
theme(legend.position = "none")
structure(list(model = c(7, 6, 5, 7, 6, 5, 7, 6, 5, 4, 3, 4,
3, 4, 3, 2, 1, 2, 1, 2, 1), race = c("hispanic", "hispanic",
"hispanic", "black", "black", "black", "white", "white", "white",
"hispanic", "hispanic", "black", "black", "white", "white", "hispanic",
"hispanic", "black", "black", "white", "white"), var_new = c("ela_hispanic",
"math_hispanic", "sci_hispanic", "ela_black", "math_black", "sci_black",
"ela_white", "math_white", "sci_white", "after_hispanic", "before_hispanic",
"after_black", "before_black", "after_white", "before_white",
"part_hispanic", "full_hispanic", "part_black", "full_black",
"part_white", "full_white"), coef = c(0.91, 0.2615005, -0.0622102,
3.1966945, 0.9665615, 0.4419779, -4.1608082, -1.75, -3.4185874,
-1.72661788, -1.87514649, 0.61605887, 0.58634364, 0.87, 0.4,
1.52820746, 1.35976557, 1.08885352, 0.8323809019, 0.728991331,
1.53140561), ci_lower = c(0.3, -1.04316665, -1.68479242, -1.0382233,
-0.70264707, -1.29579134, -12.008101, -3, -6.4522842, -1.9858909,
-2.10047863, 0.41173674, 0.37007869, -0.3428254, -0.1, 1.21339829,
1.07813362, 0.778488586, 0.44183285, 0.30081336, 0.98770764),
ci_upper = c(1.2, 1.748, 1.560372, 7.4316126, 2.63577, 2.179747,
3.6864845, 0.01, -0.3848905, -1.467344828, -1.64981433, 0.8203809961,
0.802608596, 0.4, 0.8, 1.8430166, 1.64139752, 1.39921842,
1.22292898, 1.15716932, 2.0751036)), row.names = c(NA, -21L
), class = c("tbl_df", "tbl", "data.frame"))
I don't understand why folks continue to switch the x and y axis variables then use coord_flip to put them round the right way. This is confusing, unnecessary, and requires more code. It's best to just put the variables round the right way and keep the coord as-is.
Once that's done, the simplest solution is to put race on the y axis, and change scales to free_x. I've added a border around each panel to make things a bit clearer.
library(tidyverse)
ggplot(d2, aes(y = race, x = coef, xmin = ci_lower, xmax = ci_upper)) +
geom_errorbar(width = 0, linewidth = 1.5, color = "red3", alpha = 0.5) +
geom_point(shape = 21, fill = "red2", size = 3, color = 'white') +
facet_wrap(~ model, nrow = 2, scales = 'free_x') +
geom_vline(xintercept = 0, linetype = "dashed", linewidth = 0.3) +
theme_minimal(base_size = 14) +
theme(legend.position = "none",
panel.grid.major.y = element_blank(),
panel.border = element_rect(color = 'gray75', fill = NA))
If you want to include the prefixes in the facet titles (since they have a 1:1 correspondence with model), you could use tidyr::separate:
d2 %>%
separate(var_new, into = c('model_name', 'race')) %>%
mutate(model = paste(model, model_name, sep = ' - ')) %>%
ggplot(aes(y = race, x = coef, xmin = ci_lower, xmax = ci_upper)) +
geom_errorbar(width = 0, linewidth = 1.5, color = "red3", alpha = 0.5) +
geom_point(shape = 21, fill = "red2", size = 3, color = 'white') +
facet_wrap(~model, nrow = 2, scales = 'free_x') +
geom_vline(xintercept = 0, linetype = "dashed", linewidth = 0.3) +
theme_minimal(base_size = 14) +
theme(legend.position = "none",
panel.grid.major.y = element_blank(),
panel.border = element_rect(color = 'gray75', fill = NA))
Addendum
To compare coefficients across groups like this, it is normally better to put them all in a single linerange plot (similar to a forest plot). I think this provides a much better visualization that requires less cognitive effort from the reader. This also shows a good use-case for coord_flip, namely when you want a vertical dodge between groups.
d2 %>%
separate(var_new, into = c('model_name', 'race')) %>%
mutate(model = paste0('Model ', model, ' : ', model_name)) %>%
ggplot(aes(x = model, y = coef, ymin = ci_lower, ymax = ci_upper,
color = race)) +
annotate("segment", y = rep(-Inf, 3), yend = rep(Inf, 3),
x = c('Model 2 : part', 'Model 4 : after', 'Model 6 : math'),
xend = c('Model 2 : part', 'Model 4 : after', 'Model 6 : math'),
linewidth = 22, alpha = 0.05) +
coord_flip() +
geom_errorbar(width = 0, linewidth = 1, alpha = 0.5,
position = position_dodge(width = 0.5)) +
geom_point(size = 1.5, position = position_dodge(width = 0.5)) +
geom_hline(yintercept = 0, linetype = "dashed", color = "black",
linewidth = 0.3) +
scale_color_brewer(palette = 'Set1') +
theme_minimal(base_size = 14) +
guides(color = guide_legend(reverse = TRUE)) +
theme(panel.grid.major.y = element_blank(),
panel.border = element_rect(color = 'gray75', fill = NA),
axis.text.y = element_text(hjust = 0))
I am trying to reproduce the plot from this question, but code is deprecated and I cant seem to figure out why it always gives the error.
Error: Discrete value supplied to continuous scale.
I thought I had omitted each row for being discrete to figure uot what was going on, but anyway I do it it alyways breaks because of that. There are some minor errors due to axis.ticks.margin and panel.margin as well as vjust but I don think they are the main issue. Although not 100%.
Find the reproducible dataset here:
groupData <- dput(structure(list(ID = 1:12, Group = c("Renal Failure", "Renal Failure",
"Diabetes", "Diabetes", "PA Disease", "PA Disease", "CV Disease",
"CV Disease", "Sex", "Sex", "Age", "Age"), Subgroup = c("No",
"Yes", "No", "Yes", "No", "Yes", "No", "Yes", "Female", "Male",
">70 yr", "<70 yr"), NoP = c(4594L, 66L, 2523L, 2228L, 4366L,
385L, 4296L, 456L, 908L, 3843L, 1935L, 2815L), P_S = c(0.2, 0.37,
0.84, 0.06, 0.37, 0.33, 0.18, 0.69, 0.21, 0.47, 0.17, 0.77),
P_G = c(0.51, 0.51, 0.13, 0.13, 0.54, 0.54, 0.41, 0.41, 0.46,
0.46, 0.46, 0.46)), class = "data.frame", row.names = c(NA, -12L)))
Code
## REQUIRED PACKAGES
require(grid)
require(ggplot2)
require(plyr)
############################################
### CUSTOMIZE APPEARANCE WITH THESE ####
############################################
blankRows<-2 # blank rows under boxplot
titleSize<-4
dataSize<-4
boxColor<-"pink"
############################################
############################################
## BASIC THEMES (SO TO PLOT BLANK GRID)
theme_grid <- theme(
axis.line = element_blank(),
axis.text.x = element_blank(),
axis.text.y = element_blank(),
axis.ticks = element_blank(),
axis.title.x = element_blank(),
axis.title.y = element_blank(),
axis.ticks.length = unit(0.0001, "mm"),
axis.ticks.margin = unit(c(0,0,0,0), "lines"),
legend.position = "none",
panel.background = element_rect(fill = "transparent"),
panel.border = element_blank(),
panel.grid.major = element_line(colour="grey"),
panel.grid.minor = element_line(colour="grey"),
panel.margin = unit(c(-0.1,-0.1,-0.1,-0.1), "mm"),
plot.margin = unit(c(5,0,5,0.01), "mm")
)
theme_bare <- theme_grid +
theme(
panel.grid.major = element_blank(),
panel.grid.minor = element_blank()
)
## LOAD GROUP DATA AND P values from csv file
groupData
## SYNTHESIZE SOME PLOT DATA - you can load csv instead
## EXPECTS 2 columns - integer for 'ID' matching groupdatacsv
## AND 'HR' Hazard Rate
hazardData<-expand.grid(ID=1:nrow(groupData),HR=1:6)
hazardData$HR<-1.3-runif(nrow(hazardData))*0.7
hazardData<-rbind(hazardData,ddply(groupData,.(Group),summarize,ID=max(ID)+0.1,HR=NA)[,2:3])
hazardData<-rbind(hazardData,data.frame(ID=c(0,-1:(-2-blankRows),max(groupData$ID)+1,max(groupData$ID)+2),HR=NA))
## Make the min/max mean labels
hrlabels<-ddply(hazardData[!is.na(hazardData$HR),],.(ID),summarize,lab=paste(round(mean(HR),2)," (",round(min(HR),2),"-",round(max(HR),2),")",sep=""))
## Points to plot on the log scale
scaledata<-data.frame(ID=0,HR=c(0.2,0.6,0.8,1.2,1.8))
## Pull out the Groups & P values
group_p<-ddply(groupData,.(Group),summarize,P=mean(P_G),y=max(ID)+0.1)
## identify the rows to be highlighted, and
## build a function to add the layers
hl_rows<-data.frame(ID=(1:floor(length(unique(hazardData$ID[which(hazardData$ID>0)]))/2))*2,col="lightgrey")
hl_rows$ID<-hl_rows$ID+blankRows+1
hl_rect<-function(col="white",alpha=0.5){
rectGrob( x = 0, y = 0, width = 1, height = 1, just = c("left","bottom"), gp=gpar(alpha=alpha, fill=col))
}
## DATA FOR TEXT LABELS
RtLabels<-data.frame(x=c(rep(length(unique(hazardData$ID))-0.2,times=3)),
y=c(0.6,6,10),
lab=c("Hazard Ratio\n(95% CI)","P Value","P Value for\nInteraction"))
LfLabels<-data.frame(x=c(rep(length(unique(hazardData$ID))-0.2,times=2)),
y=c(0.5,4),
lab=c("Subgroup","No. of\nPatients"))
LegendLabels<-data.frame(x=c(rep(1,times=2)),
y=c(0.5,1.8),
lab=c("Off-Pump CABG Better","On-Pump CABG Better"))
## BASIC PLOT
haz<-ggplot(hazardData,aes(factor(ID),HR))+ labs(x=NULL, y=NULL)
## RIGHT PANEL WITH LOG SCALE
rightPanel<-haz +
apply(hl_rows,1,function(x)annotation_custom(hl_rect(x["col"],alpha=0.4),as.numeric(x["ID"])-0.5,as.numeric(x["ID"])+0.5,-20,20)) +
geom_segment(aes(x = 2, y = 1, xend = 1.5, yend = 1)) +
geom_hline(aes(yintercept=1),linetype=2, linewidth=0.5)+
geom_boxplot(fill=boxColor,size=0.5, alpha=0.8)+
scale_y_log10() + coord_flip() +
geom_text(data=scaledata,aes(3,HR,label=HR), vjust=0.5, size=dataSize) +
geom_text(data=RtLabels,aes(x,y,label=lab, fontface="bold"), vjust=0.5, size=titleSize) +
geom_text(data=hrlabels,aes(factor(ID),4,label=lab),vjust=0.5, hjust=1, size=dataSize) +
geom_text(data=group_p,aes(factor(y),11,label=P, fontface="bold"),vjust=0.5, hjust=1, size=dataSize) +
geom_text(data=groupData,aes(factor(ID),6.5,label=P_S),vjust=0.5, hjust=1, size=dataSize) +
geom_text(data=LegendLabels,aes(x,y,label=lab, fontface="bold"),hjust=0.5, vjust=1, size=titleSize) +
geom_point(data=scaledata,aes(2.5,HR),shape=3,size=3) +
geom_point(aes(2,12),shape=3,alpha=0,vjust=0) +
geom_segment(aes(x = 2.5, y = 0, xend = 2.5, yend = 13)) +
geom_segment(aes(x = 2, y = 1, xend = 2, yend = 1.8),arrow=arrow(),linetype=1,size=1) +
geom_segment(aes(x = 2, y = 1, xend = 2, yend = 0.2),arrow=arrow(),linetype=1,size=1) +
theme_bare
## LEFT PANEL WITH NORMAL SCALE
leftPanel<-haz +
apply(hl_rows,1,function(x)annotation_custom(hl_rect(x["col"],alpha=0.4),as.numeric(x["ID"])-0.5,as.numeric(x["ID"])+0.5,-20,20)) +
coord_flip(ylim=c(0,5.5)) +
geom_point(aes(x=factor(ID),y=1),shape=3,alpha=0,vjust=0) +
geom_text(data=group_p,aes(factor(y),0.5,label=Group, fontface="bold"),vjust=0.5, hjust=0, size=dataSize) +
geom_text(data=groupData,aes(factor(ID),1,label=Subgroup),vjust=0.5, hjust=0, size=dataSize) +
geom_text(data=groupData,aes(factor(ID),5,label=NoP),vjust=0.5, hjust=1, size=dataSize) +
geom_text(data=LfLabels,aes(x,y,label=lab, fontface="bold"), vjust=0.5, hjust=0, size=4, size=titleSize) +
geom_segment(aes(x = 2.5, y = 0, xend = 2.5, yend = 5.5)) +
theme_bare
## PLOT THEM BOTH IN A GRID SO THEY MATCH UP
grid.arrange(leftPanel,rightPanel, widths=c(1,3), ncol=2, nrow=1)
The issue is that in your right panel plot you first map a continuous value on x via geom_segment and afterwards a discrete value via geom_boxplot. To fix that you could add a scale_x_discrete at the start of your code. Additionally I fixed the minor issues related to vjust in geom_point and a duplicated size argument in one of your geom_text layers.
## BASIC PLOT
haz <- ggplot(hazardData, aes(factor(ID), HR)) +
labs(x = NULL, y = NULL)
## RIGHT PANEL WITH LOG SCALE
rightPanel <- haz +
### Init the discrete x scale
scale_x_discrete() +
###
apply(hl_rows, 1, function(x) annotation_custom(hl_rect(x["col"], alpha = 0.4), as.numeric(x["ID"]) - 0.5, as.numeric(x["ID"]) + 0.5, -20, 20)) +
geom_segment(aes(x = 2, y = 1, xend = 1.5, yend = 1)) +
geom_hline(aes(yintercept = 1), linetype = 2, linewidth = 0.5) +
geom_boxplot(fill = boxColor, size = 0.5, alpha = 0.8) +
scale_y_log10() +
coord_flip() +
geom_text(data = scaledata, aes(3, HR, label = HR), vjust = 0.5, size = dataSize) +
geom_text(data = RtLabels, aes(x, y, label = lab, fontface = "bold"), vjust = 0.5, size = titleSize) +
geom_text(data = hrlabels, aes(factor(ID), 4, label = lab), vjust = 0.5, hjust = 1, size = dataSize) +
geom_text(data = group_p, aes(factor(y), 11, label = P, fontface = "bold"), vjust = 0.5, hjust = 1, size = dataSize) +
geom_text(data = groupData, aes(factor(ID), 6.5, label = P_S), vjust = 0.5, hjust = 1, size = dataSize) +
geom_text(data = LegendLabels, aes(x, y, label = lab, fontface = "bold"), hjust = 0.5, vjust = 1, size = titleSize) +
geom_point(data = scaledata, aes(2.5, HR), shape = 3, size = 3) +
geom_point(aes(2, 12), shape = 3, alpha = 0) +
geom_segment(aes(x = 2.5, y = 0, xend = 2.5, yend = 13)) +
geom_segment(aes(x = 2, y = 1, xend = 2, yend = 1.8), arrow = arrow(), linetype = 1, size = 1) +
geom_segment(aes(x = 2, y = 1, xend = 2, yend = 0.2), arrow = arrow(), linetype = 1, size = 1) +
theme_bare
## LEFT PANEL WITH NORMAL SCALE
leftPanel <- haz +
apply(hl_rows, 1, function(x) annotation_custom(hl_rect(x["col"], alpha = 0.4), as.numeric(x["ID"]) - 0.5, as.numeric(x["ID"]) + 0.5, -20, 20)) +
coord_flip(ylim = c(0, 5.5)) +
geom_point(aes(x = factor(ID), y = 1), shape = 3, alpha = 0) +
geom_text(data = group_p, aes(factor(y), 0.5, label = Group, fontface = "bold"), vjust = 0.5, hjust = 0, size = dataSize) +
geom_text(data = groupData, aes(factor(ID), 1, label = Subgroup), vjust = 0.5, hjust = 0, size = dataSize) +
geom_text(data = groupData, aes(factor(ID), 5, label = NoP), vjust = 0.5, hjust = 1, size = dataSize) +
geom_text(data = LfLabels, aes(x, y, label = lab, fontface = "bold"), vjust = 0.5, hjust = 0, size = titleSize) +
geom_segment(aes(x = 2.5, y = 0, xend = 2.5, yend = 5.5)) +
theme_bare
## PLOT THEM BOTH IN A GRID SO THEY MATCH UP
grid.arrange(leftPanel, rightPanel, widths = c(1, 3), ncol = 2, nrow = 1)
EDIT To get rid of the gap in your horizontal line and/or to extend the lines on the left and the right set yend=Inf and/or y=-Inf in the geom_segmentwhich draws the line.
library(gridExtra)
library(ggplot2)
## BASIC PLOT
haz <- ggplot(hazardData, aes(factor(ID), HR)) +
labs(x = NULL, y = NULL)
## RIGHT PANEL WITH LOG SCALE
rightPanel <- haz +
### Init the discrete x scale
scale_x_discrete() +
###
apply(hl_rows, 1, function(x) annotation_custom(hl_rect(x["col"], alpha = 0.4), as.numeric(x["ID"]) - 0.5, as.numeric(x["ID"]) + 0.5, -20, 20)) +
geom_segment(aes(x = 2, y = 1, xend = 1.5, yend = 1)) +
geom_hline(aes(yintercept = 1), linetype = 2, linewidth = 0.5) +
geom_boxplot(fill = boxColor, size = 0.5, alpha = 0.8) +
scale_y_log10() +
coord_flip() +
geom_text(data = scaledata, aes(3, HR, label = HR), vjust = 0.5, size = dataSize) +
geom_text(data = RtLabels, aes(x, y, label = lab, fontface = "bold"), vjust = 0.5, size = titleSize) +
geom_text(data = hrlabels, aes(factor(ID), 4, label = lab), vjust = 0.5, hjust = 1, size = dataSize) +
geom_text(data = group_p, aes(factor(y), 11, label = P, fontface = "bold"), vjust = 0.5, hjust = 1, size = dataSize) +
geom_text(data = groupData, aes(factor(ID), 6.5, label = P_S), vjust = 0.5, hjust = 1, size = dataSize) +
geom_text(data = LegendLabels, aes(x, y, label = lab, fontface = "bold"), hjust = 0.5, vjust = 1, size = titleSize) +
geom_point(data = scaledata, aes(2.5, HR), shape = 3, size = 3) +
geom_point(aes(2, 12), shape = 3, alpha = 0) +
geom_segment(aes(x = 2.5, y = 0, xend = 2.5, yend = Inf)) +
geom_segment(aes(x = 2, y = 1, xend = 2, yend = 1.8), arrow = arrow(), linetype = 1, size = 1) +
geom_segment(aes(x = 2, y = 1, xend = 2, yend = 0.2), arrow = arrow(), linetype = 1, size = 1) +
theme_bare
## LEFT PANEL WITH NORMAL SCALE
leftPanel <- haz +
apply(hl_rows, 1, function(x) annotation_custom(hl_rect(x["col"], alpha = 0.4), as.numeric(x["ID"]) - 0.5, as.numeric(x["ID"]) + 0.5, -20, 20)) +
coord_flip(ylim = c(0, 5.5)) +
geom_point(aes(x = factor(ID), y = 1), shape = 3, alpha = 0) +
geom_text(data = group_p, aes(factor(y), 0.5, label = Group, fontface = "bold"), vjust = 0.5, hjust = 0, size = dataSize) +
geom_text(data = groupData, aes(factor(ID), 1, label = Subgroup), vjust = 0.5, hjust = 0, size = dataSize) +
geom_text(data = groupData, aes(factor(ID), 5, label = NoP), vjust = 0.5, hjust = 1, size = dataSize) +
geom_text(data = LfLabels, aes(x, y, label = lab, fontface = "bold"), vjust = 0.5, hjust = 0, size = titleSize) +
geom_segment(aes(x = 2.5, y = -Inf, xend = 2.5, yend = Inf)) +
theme_bare
## PLOT THEM BOTH IN A GRID SO THEY MATCH UP
grid.arrange(leftPanel, rightPanel, widths = c(1, 3), ncol = 2, nrow = 1)
Is there a way to create a figure similar to the one below without having any data on this?
You could do something like this. You could add another geom_curve and a couple of geom_vlines.
library(tidyverse)
ggplot() +
geom_abline() +
geom_curve(aes(x = 0, y = 0, xend = 1, yend = 1), curvature = -0.4) +
annotate("text", x = 0.5, y = 0.5, label = "Line of Equality", angle = 35, vjust = 2) +
labs(x = "Individuals Neighbourhoods\nAcross Space", y = "Scoioeconomic Position") +
theme_minimal() +
theme(axis.text = element_blank())
Created on 2022-04-27 by the reprex package (v2.0.1)
For the arrows you can use this code: arrow = arrow(length = unit(0.5, "cm")) in a geom_segment. It is a bit tricky without any numbers, but maybe you want something like this:
library(ggplot2)
ggplot() +
geom_abline(slope = 1) +
geom_curve(aes(x = 0, y = 0, xend = 1, yend = 1), curvature = -0.4) +
geom_curve(aes(x = 0, y = 1, xend = 1, yend = 0.1), curvature = 0.4, linetype = "dashed") +
geom_segment(aes(x=0.9,y=0.98,xend=0.9,yend=0.12), arrow = arrow(length = unit(0.5, "cm"))) +
geom_segment(aes(x=0.02,y=0.85,xend=0.02,yend=0.23), arrow = arrow(length = unit(0.5, "cm"))) +
annotate("text", x = 0.5, y = 0.5, label = "Line of Equality", angle = 45, vjust = 2) +
annotate("text", x = 0.25, y = 0.75, label = "Income (etc.)", angle = 45, vjust = 2) +
annotate("text", x = 1.2, y = 0.1, label = "Corresponding\nExposure", angle = 0) +
labs(x = "Individuals Neighbourhoods\nAcross Space", y = "Scoioeconomic Position") +
scale_x_continuous(limits = c(0, 1.3)) +
theme_minimal() +
theme(axis.text = element_blank())
Output:
I would really appreciate it if anyone can help me use the thickness of the lines as a legend.
Thin line = low correlation
Think line = High correlation
I tried using the size of the dots to show the thickness but it confuses the audience even further. I am open to other creative methods to communicate this message to the audience.
My code is listed below.
Thanks in advance!
library(ggplot2)
# custom empty theme to clear the plot area
empty_theme <- theme(
plot.background = element_blank(),
panel.grid.major = element_blank(),
panel.grid.minor = element_blank(),
panel.border = element_blank(),
panel.background = element_blank(),
axis.line = element_blank(),
axis.ticks = element_blank(),
axis.text.y = element_text(angle = 90)
)
plot <- ggplot(NULL, aes()) +
# fix the scale so it's always a square
coord_fixed() +
# set the scale to one greater than 0-10 in each direction
# this gives us some breating room and space to add some arrows
scale_x_continuous(expand = c(0, 0), limits = c(-1, 11),
breaks = c(2,8), labels=c("2" = "", "8" = "")) +
scale_y_continuous(expand = c(0, 0), limits = c(-1,11),
breaks = c(2,8), labels=c("2" = "", "8" = "")) +
# apply the empty theme
empty_theme +
# labels
labs(title = "Magic Quadrant",
x = "Completeness of Vision",
y = "Ability to Execute") +
# create the quadrants
geom_segment(aes(x = 10, y = 0, xend = 10, yend = 10), color = "#EDEDED") +
geom_segment(aes(x = 0, y = 0, xend = 0, yend = 10), color = "#EDEDED") +
geom_segment(aes(x = 0, y = 0, xend = 10, yend = 0), color = "#EDEDED") +
geom_segment(aes(x = 0, y = 5, xend = 10, yend = 5), color = "#EDEDED") +
geom_segment(aes(x = 5, y = 0, xend = 5, yend = 10), color = "#EDEDED") +
geom_segment(aes(x = 0, y = 10, xend = 10, yend = 10), color = "#EDEDED") +
#Rectangle
geom_rect(mapping = aes(xmin = 0, xmax = 5, ymin = 0, ymax = 5), fill = "#deecff") +
geom_rect(mapping = aes(xmin = 5, xmax = 10, ymin = 5, ymax = 10), fill = "#deecff") +
# quadrant labels
annotate("text", x = 2.5, y = 2.5, alpha = 0.35, label = "Niche Players", color = "#979b9c") +
annotate("text", x = 2.5, y = 7.5, alpha = 0.35, label = "Challengers", color = "#979b9c") +
annotate("text", x = 7.5, y = 2.5, alpha = 0.35, label = "Visionaries", color = "#979b9c") +
annotate("text", x = 7.5, y = 7.5, alpha = 0.35, label = "Leaders", color = "#979b9c") +
# arrows are cut in half which conveniently matches the gartner one
annotate("segment", x = 0, xend = 10, y = -1, yend = -1,colour = "blue",
size=2, alpha=1, arrow=arrow(type = "closed", angle = 15)) +
annotate("segment", x = -1, xend = -1, y = 0, yend = 10, colour = "blue",
size=2, alpha=1, arrow=arrow(type = "closed", angle = 15))
tools_quad_data <- data.frame(
title = c("A", "B", "C", "D", "E"),
value = c(6,6,6.3,6,8),
effort = c(3,8,9,4,7.9),
txt_position_value = c(6,6,6,6.2,8),
txt_position_effort = c(3.3,8.3,9.3,4.3,8.2)
)
plot <- plot +
geom_point(data = tools_quad_data, aes(x = value, y = effort, color = "ML Tool"), size = 4) +
geom_text(data = tools_quad_data, aes(label = title, x = txt_position_value, y = txt_position_effort), color = "#011d80")
db_quad_data <- data.frame(
title = c("U","V", "W","X","Y","Z"),
value = c(6.5,9,7.3,8,2,1),
effort = c(2.2, 9, 1, 3.4,1.5,0.1),
txt_position_value = c(6.7, 9.2, 7,8,2.2,1.3),
txt_position_effort = c(2,9.3, 0.7,3.1,1.3, 0.35)
)
plot <- plot +
geom_point(data = db_quad_data, aes(x = value, y = effort, color = "Database"), size = 4) +
geom_text(data = db_quad_data, aes(label = title, x = txt_position_value, y = txt_position_effort ), color = "#e09900") +
scale_colour_manual(name="Legend", values=c(Database="#e09900", `ML Tool`="#011d80"))
plot +
geom_curve(aes(x = 6.3, y = 9, xend = 2, yend = 1.5),
color = "black", curvature = 0.2, size = 0.5, alpha = 0.1) +
geom_curve(aes(x = 8, y = 7.9, xend = 2, yend = 1.5),
color = "black", curvature = -0.2, size = 1.5, alpha = 0.1) +
geom_curve(aes(x = 6, y = 4, xend = 2, yend = 1.5),
color = "black", curvature = -0.1, size = 1, alpha = 0.1) +
geom_curve(aes(x = 6, y = 8,
xend = 6.5, yend = 2.2),
color = "black", curvature = -0.1, size = 2, alpha = 0.1) +
geom_curve(aes(x = 8, y = 7.9,
xend = 6.5, yend = 2.2),
color = "black", curvature = -0.1, size = 0.8, alpha = 0.1) +
geom_curve(aes(x = 8, y = 3.4,
xend = 8, yend = 7.9),
color = "black", curvature = 0.1, size = 0.6, alpha = 0.1) +
geom_curve(aes(x = 9, y = 9,
xend = 6, yend = 4),
color = "black", curvature = -0.3, size = 1.5, alpha = 0.1) +
geom_curve(aes(x = 9, y = 9,
xend = 6, yend = 8),
color = "black", curvature = 0.3, size = 1.3, alpha = 0.1) +
geom_curve(aes(x = 7.3, y = 1,
xend = 6, yend = 8),
color = "black", curvature = 0.3, size = 0.5, alpha = 0.1)
Another option is to use different linetypes, these are generally more distinguishable than line thickness. This can be controlled with the linetype aesthetic
I have a dataframe like this
library(ggplot2)
df = data.frame(N = c(12, 18))
And I want to get
I do
ggplot()+ geom_segment(aes(x = 0, y = 0.5, xend = max(df$N), yend =0.5), color="grey50",
linetype="dashed", size=1.5) +
geom_segment(aes(x = df$N[1], y = 0, xend = df$N[1], yend = 0.5), color="grey50",
linetype="dashed", size=1.5)+
geom_segment(aes(x = df$N[2], y = 0, xend = df$N[2], yend = 0.5), color="grey50",
linetype="dashed", size=1.5)
The problem is that the data can change, the rows can be not two, but three or more, and the code becomes incorrect. So I try to use a loop
v = list()
for (i in 1:length(df$N)) {
n = geom_segment(aes(x = df$N[i], y = 0, xend = df$N[i], yend = 0.5), color="grey50",
linetype="dashed", size=1.5)
v = append(n, v)
}
v
ggplot()+ geom_segment(aes(x = 0, y = 0.5, xend = max(df$N), yend =0.5), color="grey50",
linetype="dashed", size=1.5) + v
But the diagram only shows the last line. How to fix the loop or I have to do another way?
You don't need a loop; geom_segment can handle multiple inputs from a vector.
df1 <- data.frame(N = c(12, 18, 24))
library(ggplot2)
ggplot(data = df1)+
geom_segment(aes(x = 0, y = 0.5, xend = max(N), yend =0.5),
color="grey50", linetype="dashed", size=1.5) +
geom_segment(aes(x = N, y = 0, xend = N, yend = 0.5),
color="grey50", linetype="dashed", size=1.5)