Related
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)
I have a set of points in a scatter plot as below. I want to change the shape of one point or few points. I searched for this but could not find a way to do it.
I want to achieve like this
And like this
Code:
df <- data.frame(x = c(1,2,2,3,3.5,4,4.5,5,5.5,6,1.5,2,2,2,2,1.5,2.5,3,3,3,3,5.5,5,6,5.5,7)
,y = c(2,1,2,2,2,2,2,2,1.5,2,2.5,3,3.5,4,4.5,3.5,3.5,2,3,3.5,4,2.5,3,3,4,3.5))
library(ggplot2)
library(extrafont)
# helper dataframe for axis
df_arrow <- data.frame(x = c(0, 0),
y = c(0, 0),
xend = c(0, 8),
yend = c(8, 0))
ggplot(df,aes(x, y)) +
geom_point(colour = "blue", size = 5, shape = 3)+
scale_x_continuous(breaks = 1:7, expand = expansion(add = c(0, 1)))+
scale_y_continuous(breaks = 1:7, expand = expansion(add = c(0, 1)))+
coord_fixed(xlim = c(0, 7), ylim = c(0, 7), clip = "off")+
geom_segment(data = df_arrow, aes(x = x, xend = xend, y = y, yend = yend), size = 0.75, colour = "black",
arrow = arrow(angle = 20, length = unit(3, "mm"), ends = "last", type = "closed"), linejoin = "mitre") +
annotate("text", x = c(7.8, 0.3), y = c(0.3, 7.8), label = c("italic(x)", "italic(y)"), parse = TRUE, size = 6, family = "Times New Roman")+
labs(x = NULL,
y = NULL)+
theme_bw()+
theme(panel.grid.major = element_line(colour = "gray80"),
panel.grid.minor = element_blank(),
panel.border = element_blank(),
axis.ticks.length = unit(1, "mm"),
text = element_text(size = 18, family = "Times New Roman"))
How is this?
Create a new column using dplyr::mutate, which is conditional upon the x-coordinates (for example, but it could be anything). Then, use this column within aes to control the shape size.
Also, you can use scale_shape_manual and scale_colour_manual to manually control the shape and colours. It's not clear to me what shape you want but you would just need to change the arguments in scale_shape_manual.
EDIT:
Since you specifically need a different symbol, then you need to use geom_text instead.
df %>%
dplyr::mutate(z = ifelse(x >= 5, "-", "+")) %>%
ggplot(aes(x, y)) +
geom_text(size = 12, aes(colour=z, label=z)) +
scale_x_continuous(breaks = 1:7, expand = expansion(add = c(0, 1)))+
scale_y_continuous(breaks = 1:7, expand = expansion(add = c(0, 1)))+
coord_fixed(xlim = c(0, 7), ylim = c(0, 7), clip = "off")+
geom_segment(data = df_arrow, aes(x = x, xend = xend, y = y, yend = yend), size = 0.75, colour = "black",
arrow = arrow(angle = 20, length = unit(3, "mm"), ends = "last", type = "closed"), linejoin = "mitre") +
annotate("text", x = c(7.8, 0.3), y = c(0.3, 7.8), label = c("italic(x)", "italic(y)"), parse = TRUE, size = 6, family = "Times New Roman")+
labs(x = NULL,
y = NULL)+
theme_bw()+
theme(panel.grid.major = element_line(colour = "gray80"),
panel.grid.minor = element_blank(),
panel.border = element_blank(),
axis.ticks.length = unit(1, "mm"),
text = element_text(size = 18, family = "Times New Roman")) +
scale_shape_manual(values=c(8, 9)) +
scale_colour_manual(values = c('red', 'blue'))
I would like to create a label with a comma as follows:
label2 <- "epsilon[f[c]']"
label3 <- "epsilon[f[c],adj]"
I use the following:
... + annotate("text", x = -0.003, y= -0.25, label = label2, size = fontsize,
family = "sans", parse = TRUE) +
annotate("text", x = -0.003, y= -0.25, label = label3, size = fontsize,
family = "sans", parse = TRUE)
But for label2: the ' needs to be removed for the code to even run and
for label3: everything after "ult" is ignored in the subscript
EDIT:
Data:
> dput(material)
structure(list(strain = c(-0.00375, -0.00248, -0.00195, -0.00121,
-0.000248, 0, 0.000132, 0.00145, -0.0046736, -0.0034036, -0.0028676,
-0.0021336, -0.0011707, -0.0009226), stress = c(-4.6011, -5,
-4.8555, -3.9414, -0.9901, 0, 0.5303, 0, -4.6011, -5, -4.8555,
-3.9414, -0.9901, 0), type = structure(c(1L, 1L, 1L, 1L, 1L,
1L, 1L, 1L, 2L, 2L, 2L, 2L, 2L, 2L), .Label = c("Standard 5 ksi Concrete",
"Adjusted 5 ksi Concrete"), class = "factor")), row.names = c(NA,
-14L), class = "data.frame")
Plot:
plot <- ggplot(material) + theme_void() +
aes(x = strain, y = stress, colour = type, group = type) +
geom_xspline(size = 0.7, spline_shape = 0.5) + labs(x = "Strain (in/in)",
y = "Stress (ksi)", color = element_blank()) + theme(legend.position = "bottom",
axis.title.y = element_text(size=10, colour="black", angle = 90, vjust = -22, hjust = 0.55),
axis.title.x = element_text(size=10, colour="black", vjust = 4, hjust = 0.6),
axis.text.y = element_blank(), axis.text.x = element_blank(),
legend.text=element_text(size=10), legend.direction="vertical",
legend.spacing.x = unit(0, 'cm')) + scale_colour_manual(values =
c("Standard 5 ksi Concrete" = "blue", "Adjusted 5 ksi Concrete" = "red")) +
scale_y_continuous(trans = "reverse") + scale_x_continuous(trans = "reverse") +
geom_vline(aes(xintercept = 0), size = 0.3) + geom_hline(aes(yintercept = 0), size = 0.3) +
geom_segment(aes(x = 0, y = 0, xend = -0.0009226, yend = 0), size = 0.7) +
geom_segment(aes(x = -0.0009226, y = 0, xend = -0.0011707, yend = -0.94), size = 0.7) +
geom_segment(aes(x = 0, y = -4.958, xend = -0.00333, yend = -4.958),
size = 0.6, linetype = "dotted", colour = "black") +
geom_segment(aes(x = -0.00333, y = 0, xend = -0.00333, yend = -4.958),
size = 0.6, linetype = "dotted", colour = "black") +
geom_segment(aes(x = -0.0024, y = 0, xend = -0.0024, yend = -4.958),
size = 0.6, linetype = "dotted", colour = "black") +
geom_segment(aes(x = -3.75E-03, y = 0, xend = -3.75E-03, yend = -4.6011),
size = 0.6, linetype = "dotted", colour = "black") +
geom_segment(aes(x = -0.0046736, y = 0, xend = -0.0046736, yend = -4.6011),
size = 0.6, linetype = "dotted", colour = "black") +
annotate("text", x = 0.0002, y= -5, label = label0, size = fontsize, family = "sans", parse = TRUE) +
annotate("text", x = -0.0006, y= 0.2, label = label1, size = fontsize, family = "sans", parse = TRUE) +
annotate("text", x = -0.0021, y= -0.25, label = label2, size = fontsize, family = "sans", parse = TRUE) +
annotate("text", x = -0.003, y= 0.2, label = label3, size = fontsize, family = "sans", parse = TRUE) +
annotate("text", x = -0.0041, y= -0.25, label = label4, size = fontsize, family = "sans", parse = TRUE) +
annotate("text", x = -0.0045, y= 0.2, label = label5, size = fontsize, family = "sans", parse = TRUE)
Change the label2 as below.
label2 <- "epsilon[f[c]*'\\'']"
label3 <- "epsilon[f[c*',adj']]"
I checked as below and it works fine.
p + annotate("text", x = -0.003, y= 0.25, label = label2, parse = TRUE, size = 12) +
annotate("text", x = -0.003, y= -0.25, label = label3, size = 12, parse = TRUE)
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'm trying to create a multiple plot with the same x-axis but different y-axes, because I have values for two groups with different ranges. As I want to control the values of the axes (respectively the y-axes shall reach from 2.000.000 to 4.000.000 and from 250.000 to 500.000), I don't get along with facet_grid with scales = "free".
So what I've tried is to create two plots (named "plots.treat" and "plot.control") and combine them with grid.arrange and arrangeGrob. My problem is, that I don't know how to control the exact position of the two plots, so that both y-axes are positioned on one vertical line. So in the example below the second plot's y-axis needs to be positioned a bit more to the right.
Here is the code:
# Load Packages
library(ggplot2)
library(grid)
library(gridExtra)
# Create Data
data.treat <- data.frame(seq(2005.5, 2015.5, 1), rep("SIFI", 11),
c(2230773, 2287162, 2326435, 2553602, 2829325, 3372657, 3512437,
3533884, 3519026, 3566553, 3527153))
colnames(data.treat) <- c("Jahr", "treatment",
"Aggregierte Depositen (in Tausend US$)")
data.control <- data.frame(seq(2005.5, 2015.5, 1), rep("Nicht-SIFI", 11),
c(324582, 345245, 364592, 360006, 363677, 384674, 369007,
343893, 333370, 318409, 313853))
colnames(data.control) <- c("Jahr", "treatment",
"Aggregierte Depositen (in Tausend US$)")
# Create Plot for data.treat
plot.treat <- ggplot() +
geom_line(data = data.treat,
aes(x = `Jahr`,
y = `Aggregierte Depositen (in Tausend US$)`),
size = 1,
linetype = "dashed") +
geom_point(data = data.treat,
aes(x = `Jahr`,
y = `Aggregierte Depositen (in Tausend US$)`),
fill = "white",
size = 2,
shape = 24) +
scale_x_continuous(breaks = seq(2005, 2015.5, 1),
minor_breaks = seq(2005, 2015.5, 0.5),
limits = c(2005, 2015.8),
expand = c(0.01, 0.01)) +
scale_y_continuous(breaks = seq(2000000, 4000000, 500000),
minor_breaks = seq(2000000, 4000000, 250000),
labels = c("2.000.000", "2.500.000", "3.000.000",
"3.500.000", "4.000.000"),
limits = c(2000000, 4000000),
expand = c(0, 0.01)) +
theme(text = element_text(family = "Times"),
axis.title.x = element_blank(),
axis.title.y = element_blank(),
axis.line.x = element_line(color="black", size = 0.6),
axis.line.y = element_line(color="black", size = 0.6),
legend.position = "none") +
geom_segment(aes(x = c(2008.7068),
y = c(2000000),
xend = c(2008.7068),
yend = c(3750000)),
linetype = "dotted") +
annotate(geom = "text", x = 2008.7068, y = 3875000, label = "Lehman\nBrothers + TARP",
colour = "black", size = 3, family = "Times") +
geom_segment(aes(x = c(2010.5507),
y = c(2000000),
xend = c(2010.5507),
yend = c(3750000)),
linetype = "dotted") +
annotate(geom = "text", x = 2010.5507, y = 3875000, label = "Dodd-Frank-\nAct",
colour = "black", size = 3, family = "Times") +
geom_rect(aes(xmin = 2007.6027, xmax = 2009.5, ymin = -Inf, ymax = Inf),
fill="dark grey", alpha = 0.2)
# Create Plot for data.control
plot.control <- ggplot() +
geom_line(data = data.control,
aes(x = `Jahr`,
y = `Aggregierte Depositen (in Tausend US$)`),
size = 1,
linetype = "solid") +
geom_point(data = data.control,
aes(x = `Jahr`,
y = `Aggregierte Depositen (in Tausend US$)`),
fill = "white",
size = 2,
shape = 21) +
scale_x_continuous(breaks = seq(2005, 2015.5, 1), # x-Achse
minor_breaks = seq(2005, 2015.5, 0.5),
limits = c(2005, 2015.8),
expand = c(0.01, 0.01)) +
scale_y_continuous(breaks = seq(250000, 500000, 50000),
minor_breaks = seq(250000, 500000, 25000),
labels = c("250.000", "300.000", "350.000", "400.000",
"450.000", "500.000"),
limits = c(250000, 500000),
expand = c(0, 0.01)) +
theme(text = element_text(family = "Times"),
axis.title.x = element_blank(), # Achse
axis.title.y = element_blank(), # Achse
axis.line.x = element_line(color="black", size = 0.6),
axis.line.y = element_line(color="black", size = 0.6),
legend.position = "none") +
geom_segment(aes(x = c(2008.7068),
y = c(250000),
xend = c(2008.7068),
yend = c(468750)),
linetype = "dotted") +
annotate(geom = "text", x = 2008.7068, y = 484375, label = "Lehman\nBrothers + TARP",
colour = "black", size = 3, family = "Times") +
geom_segment(aes(x = c(2010.5507),
y = c(250000),
xend = c(2010.5507),
yend = c(468750)),
linetype = "dotted") +
annotate(geom = "text", x = 2010.5507, y = 484375, label = "Dodd-Frank-\nAct",
colour = "black", size = 3, family = "Times") +
geom_rect(aes(xmin = 2007.6027, xmax = 2009.5, ymin = -Inf, ymax = Inf),
fill="dark grey", alpha = 0.2)
# Combine both Plots with grid.arrange
grid.arrange(arrangeGrob(plot.treat, plot.control,
ncol = 1,
left = textGrob("Aggregierte Depositen (in Tausend US$)",
rot = 90,
vjust = 1,
gp = gpar(fontfamily = "Times",
size = 12,
colout = "black",
fontface = "bold")),
bottom = textGrob("Jahr",
vjust = 0.1,
hjust = 0.2,
gp = gpar(fontfamily = "Times",
size = 12,
colout = "black",
fontface = "bold"))))
Do:
install.packages("cowplot")
but do not library(cowplot) as it'll mess up your theme work.
Then, do:
grid.arrange(
arrangeGrob(cowplot::plot_grid(plot.treat, plot.control, align = "v", ncol=1),
ncol = 1,
left = textGrob("Aggregierte Depositen (in Tausend US$)",
rot = 90,
vjust = 1,
gp = gpar(fontfamily = "Times",
size = 12,
colout = "black",
fontface = "bold")),
bottom = textGrob("Jahr",
vjust = 0.1,
hjust = 0.2,
gp = gpar(fontfamily = "Times",
size = 12,
colout = "black",
fontface = "bold"))))