I am trying to make a classic Von Neumann Morgenstern concave utility function plot using ggplot2, but are having some trouble with the getting the axis ticks in the plot.
This is my complete code. There is no need for a dataset.
library(ggplot2)
library(tidyverse)
library(hrbrthemes)
library(ggforce)
utility2 = function(c, A){
ret = ((c^(1-A))/(1-A))
}
risk_grid <- 1:20/10
risk_aversion = 1.2
return2 = utility2(risk_grid, risk_aversion)
return2 <- as.data.frame(return2)
return2 <- cbind(return2, risk_grid)
name <- data.frame(c(0.165,1.512, 0.77), c(-6.92, -4.5, -5.17))
points <- data.frame(c(0.188,1.512, 0.8, 0.8), c(-7, -4.6, -5.88, -5.23))
line <- data.frame(c(.188, 1.512),c(-7, -4.6))
line2 <- data.frame(c(0.8, 0.8), c(-5.88, -5.23))
axis_lineA <- data.frame(c(0.188,0.188,0.1), c(-7, -Inf, -7))
axis_lineB <- data.frame(c(1.512, 1.512, 0.1), c(-4.6, -Inf, -4.6))
axis_lineC <- data.frame(c(0.8, 0.8, 0.1), c(-5.23, -Inf, -5.23))
axis_lineD <- data.frame(c(0.8, 0.1), c(-5.88, -5.88))
ticks <- data.frame(c(0.188,1.512), c(-7.5, -7))
colnames(name) <- c("x", "y")
colnames(points) <- c("x", "y")
colnames(line) <- c("x", "y")
colnames(line2) <- c("x", "y")
colnames(axis_lineA) <- c("x", "y")
colnames(axis_lineB) <- c("x", "y")
colnames(axis_lineC) <- c("x", "y")
colnames(axis_lineD) <- c("x", "y")
colnames(ticks) <- c("x", "y")
jpeg(file = "Utility_plot.jpeg", width = 800, height = 800)
P_Utility <- ggplot()+
geom_line(data = return2, aes(x=risk_grid, y = return2), size = 1, color = "steelblue")+
#scale_x_continuous(breaks = return2$risk_grid, labels = return2$risk_grid) +
geom_text(data = name, aes(x=x, y = y), label = c("a", "b", "c"), size = 7, family = "serif")+
geom_line(data = line, aes(x=x, y = y), size = .5, color = "black")+
geom_line(data = line2, aes(x=x, y = y), size = 1, color = "grey", linetype = "dashed")+
geom_line(data = axis_lineA, aes(x=x, y = y), size = 1, color = "grey", linetype = "dashed")+
geom_line(data = axis_lineB, aes(x=x, y = y), size = 1, color = "grey", linetype = "dashed")+
geom_line(data = axis_lineC, aes(x=x, y = y), size = 1, color = "grey", linetype = "dashed")+
geom_line(data = axis_lineD, aes(x=x, y = y), size = 1, color = "grey", linetype = "dashed")+
geom_point(data = points, aes(x=x, y = y), size = 4, color = "red")+
#geom_point(data = ticks, aes(x=x, y = y), size = 4, color = "red")+
theme_ipsum()+
#theme(legend.text = element_text(size = 12))+
#theme(legend.title = element_blank())+
#theme(axis.ticks=element_line(size = 2))+
theme(panel.grid.major = element_blank(), panel.grid.minor = element_blank())+
theme(axis.text.x = element_blank()) +
theme(axis.text.y = element_blank())+
scale_x_continuous(expand = c(0,0))+
xlab("c") + ylab("u(c)")+
theme(axis.title.y = element_text(size = 20, vjust = .5, angle = 0, family = "serif"),
axis.title.x = element_text(size = 20, hjust = .5, family = "serif"))+
theme(axis.line = element_line(arrow = arrow(length = unit(3, 'mm'))))+
theme(text=element_text(family="serif"))
P_Utility
dev.off()
The code might not be optimal but it works so far. I am happy with the plot, but would like to have scale ticks and labels where the dashed lines cross the x- and y-axis.
This could be achieved like so:
Set the breaks for the axis to be unique x and y values from you line dfs
To get the you have to set axis.ticks.x/y = element_line(). Using axis.ticks will not do the job as in theme_ipsum axis.ticks.x/y are both set to element_blank()
library(ggplot2)
library(tidyverse)
library(hrbrthemes)
library(ggforce)
utility2 = function(c, A){
ret = ((c^(1-A))/(1-A))
}
risk_grid <- 1:20/10
risk_aversion = 1.2
return2 = utility2(risk_grid, risk_aversion)
return2 <- as.data.frame(return2)
return2 <- cbind(return2, risk_grid)
name <- data.frame(c(0.165,1.512, 0.77), c(-6.92, -4.5, -5.17))
points <- data.frame(c(0.188,1.512, 0.8, 0.8), c(-7, -4.6, -5.88, -5.23))
line <- data.frame(c(.188, 1.512),c(-7, -4.6))
line2 <- data.frame(c(0.8, 0.8), c(-5.88, -5.23))
axis_lineA <- data.frame(c(0.188,0.188,0.1), c(-7, -Inf, -7))
axis_lineB <- data.frame(c(1.512, 1.512, 0.1), c(-4.6, -Inf, -4.6))
axis_lineC <- data.frame(c(0.8, 0.8, 0.1), c(-5.23, -Inf, -5.23))
axis_lineD <- data.frame(c(0.8, 0.1), c(-5.88, -5.88))
ticks <- data.frame(c(0.188,1.512), c(-7.5, -7))
colnames(name) <- c("x", "y")
colnames(points) <- c("x", "y")
colnames(line) <- c("x", "y")
colnames(line2) <- c("x", "y")
colnames(axis_lineA) <- c("x", "y")
colnames(axis_lineB) <- c("x", "y")
colnames(axis_lineC) <- c("x", "y")
colnames(axis_lineD) <- c("x", "y")
colnames(ticks) <- c("x", "y")
breaks_x <- unique(c(axis_lineA$x, axis_lineB$x, axis_lineC$x, axis_lineD$x))
breaks_y <- unique(c(axis_lineA$y, axis_lineB$y, axis_lineC$y, axis_lineD$y))
ggplot()+
geom_line(data = return2, aes(x=risk_grid, y = return2), size = 1, color = "steelblue")+
geom_text(data = name, aes(x=x, y = y), label = c("a", "b", "c"), size = 7, family = "serif")+
geom_line(data = line, aes(x=x, y = y), size = .5, color = "black")+
geom_line(data = line2, aes(x=x, y = y), size = 1, color = "grey", linetype = "dashed")+
geom_line(data = axis_lineA, aes(x=x, y = y), size = 1, color = "grey", linetype = "dashed")+
geom_line(data = axis_lineB, aes(x=x, y = y), size = 1, color = "grey", linetype = "dashed")+
geom_line(data = axis_lineC, aes(x=x, y = y), size = 1, color = "grey", linetype = "dashed")+
geom_line(data = axis_lineD, aes(x=x, y = y), size = 1, color = "grey", linetype = "dashed")+
geom_point(data = points, aes(x=x, y = y), size = 4, color = "red") +
scale_x_continuous(breaks = breaks_x, expand = c(0,0))+
scale_y_continuous(breaks = breaks_y, expand = c(0,0))+
theme_ipsum() +
theme(panel.grid.major = element_blank(),
panel.grid.minor = element_blank(),
axis.ticks.x = element_line(),
axis.ticks.y = element_line(),
axis.ticks.length = unit(5, "pt")) +
theme(axis.text.x = element_blank()) +
theme(axis.text.y = element_blank())+
xlab("c") + ylab("u(c)")+
theme(axis.title.y = element_text(size = 20, vjust = .5, angle = 0, family = "serif"),
axis.title.x = element_text(size = 20, hjust = .5, family = "serif"))+
theme(axis.line = element_line(arrow = arrow(length = unit(3, 'mm'))))+
theme(text=element_text(family="serif"))
Related
I have two normal curves and I want to fill the right area between both curves, so left curve is inferior y limit and right curve is superior y limit. To plot the curves I am using stat_function() so ggplot draws the curve without defining an y-column in aes(). I have drawn the fill area between the curve and the X axis, but I need the area between both curves and the trick of emptying the left curve with NA doesn't seem to work as I expected.
The code to generate the plot is in a function as I need to plot several different couples of normal curves.
How can I do that?
library(ggplot2)
library(ggthemes)
graf_normal <- function(Xmedia1, Xdt1, Xmedia2, Xdt2) {
Xmin1 <- Xmedia1-4*Xdt1
Xmax1 <- Xmedia1+4*Xdt1
Xmin2 <- Xmedia2-4*Xdt2
Xmax2 <- Xmedia2+4*Xdt2
Ymax1 <- max(dnorm(Xmedia1, Xmedia1, Xdt1))
Ymax2 <- max(dnorm(Xmedia2, Xmedia2, Xdt2))
Xmin <- min(Xmin1, Xmin2)
Xmax <- max(Xmax1, Xmax2)
ggplot(data.frame(X = c(Xmin, Xmax)), aes(x = X)) +
geom_hline(yintercept = 0, colour = "grey", linewidth = 1) +
stat_function(fun = dnorm,
args = c(Xmedia1, Xdt1),
linewidth = 1,
colour = "grey") +
stat_function(fun = dnorm,
args = c(Xmedia2, Xdt2),
linewidth = 1,
colour = "black") +
geom_segment(aes(x = Xmedia1, y = 0, xend = Xmedia1, yend = Ymax1),
linetype = "dashed",
linewidth = 0,
colour = "grey") +
geom_segment(aes(x = Xmedia2, y = 0, xend = Xmedia2, yend = Ymax2),
linetype = "dashed",
linewidth = 0,
colour = "black") +
####################################################################
stat_function(fun = dnorm,
args = c(Xmedia2, Xdt2),
xlim = c(Xmedia2+1.5*Xdt2,Xmax2),
geom = "area",
fill = "red",
alpha = 0.5) +
stat_function(fun = dnorm,
args = c(Xmedia1, Xdt1),
xlim = c(Xmedia1,Xmax1),
geom = "area",
fill = NA,
alpha = 0.01) +
##################################################################
theme(
line = element_blank(),
axis.line.y = 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(),
legend. Position = "none",
panel. Grid = element_blank(),
panel. Background = element_rect(fill = "lightgray", colour = NA),
) +
xlim(c(Xmin, Xmax))
}
g1 <- graf_normal(250, 7, 253, 7)
g1
The plot of both curves I get is this:
Thanks,
EDIT:
Using #stephan's code and playing with data filtering, I've been able to do this, easier using geom_ribbon():
Cool way of differencing overlapping zones!
Complete code:
library(ggplot2)
graf_normal <- function(Xmedia1, Xdt1, Xmedia2, Xdt2, n = 1000) {
x1 <- Xmedia1 + 4 * Xdt1 * seq(-1, 1, length. Out = n)
x2 <- Xmedia2 + 4 * Xdt2 * seq(-1, 1, length. Out = n)
dat <- data. Frame(
x = union(x1, x2)
)
dat$y1 <- dnorm(dat$x, Xmedia1, Xdt1)
dat$y2 <- dnorm(dat$x, Xmedia2, Xdt2)
Ymax1 <- dnorm(Xmedia1, Xmedia1, Xdt1)
Ymax2 <- dnorm(Xmedia2, Xmedia2, Xdt2)
ggplot(dat, aes(x)) +
geom_hline(yintercept = 0, colour = "grey", linewidth = 1) +
geom_ribbon(
data = subset(dat, x >= Xmedia2 + 1.5 * Xdt2),
aes(ymin = y1, ymax = y2),
fill = "red", alpha = 0.8
) +
geom_ribbon(
data = subset(dat, (x <= Xmedia2 + 1.5 * Xdt2) & (y2 > y1)),
aes(ymin = y1, ymax = y2),
fill = "red", alpha = 0.2
) +
geom_ribbon(
data = subset(dat, x <= Xmedia1 - 1.5 * Xdt2),
aes(ymin = y1, ymax = y2),
fill = "blue", alpha = 0.8
) +
geom_ribbon(
data = subset(dat, (x <= Xmedia2 ) & (y1 > y2)),
aes(ymin = y1, ymax = y2),
fill = "blue", alpha = 0.2
) +
annotate(
geom = "segment",
x = c(Xmedia1, Xmedia2), y = 0,
xend = c(Xmedia1, Xmedia2), yend = c(Ymax1, Ymax2),
linetype = "dashed",
linewidth = 1,
colour = c("grey", "black")
) +
geom_line(aes(y = y1), linewidth = 1, colour = "grey") +
geom_line(aes(y = y2), linewidth = 1, colour = "black") +
theme(
line = element_blank(),
axis.line.y = element_blank(),
axis. Text = element_blank(),
axis. Ticks = element_blank(),
axis. Title = element_blank(),
legend. Position = "none",
panel. Grid = element_blank(),
panel. Background = element_rect(fill = "lightgray", colour = NA),
)
}
graf_normal(250, 7, 253, 7)
However, the code doesn't work for all curves, working on it!:
graf_normal(250, 7, 253, 3)
One option to fill the area between the normal curves would be to use ggh4x::stat_difference which however requires to compute the values for the densities manually and drawing via geom_line instead of relying on stat_function():
library(ggplot2)
library(ggh4x)
graf_normal <- function(Xmedia1, Xdt1, Xmedia2, Xdt2, n = 101) {
x1 <- Xmedia1 + 4 * Xdt1 * seq(-1, 1, length.out = n)
x2 <- Xmedia2 + 4 * Xdt2 * seq(-1, 1, length.out = n)
dat <- data.frame(
x = union(x1, x2)
)
dat$y1 <- dnorm(dat$x, Xmedia1, Xdt1)
dat$y2 <- dnorm(dat$x, Xmedia2, Xdt2)
Ymax1 <- dnorm(Xmedia1, Xmedia1, Xdt1)
Ymax2 <- dnorm(Xmedia2, Xmedia2, Xdt2)
ggplot(dat, aes(x)) +
geom_hline(yintercept = 0, colour = "grey", linewidth = 1) +
ggh4x::stat_difference(
data = ~ subset(.x, x >= Xmedia2 + 1.5 * Xdt2),
aes(ymin = y1, ymax = y2)
) +
annotate(
geom = "segment",
x = c(Xmedia1, Xmedia2), y = 0,
xend = c(Xmedia1, Xmedia2), yend = c(Ymax1, Ymax2),
linetype = "dashed",
linewidth = 1,
colour = c("grey", "black")
) +
geom_line(aes(y = y1), linewidth = 1, colour = "grey") +
geom_line(aes(y = y2), linewidth = 1, colour = "black") +
scale_fill_manual(values = c(scales::alpha("red", .5), "transparent")) +
theme(
line = element_blank(),
axis.line.y = element_blank(),
axis.text = element_blank(),
axis.ticks = element_blank(),
axis.title = element_blank(),
legend.position = "none",
panel.grid = element_blank(),
panel.background = element_rect(fill = "lightgray", colour = NA),
)
}
graf_normal(250, 7, 253, 7)
EDIT Actually stat_differnce is not really needed for your case. Was thinking too complicated. As #JuanRiera mentioned in his comment, we could fill the area using a geom_ribbon:
library(ggplot2)
graf_normal <- function(Xmedia1, Xdt1, Xmedia2, Xdt2, n = 101) {
x1 <- Xmedia1 + 4 * Xdt1 * seq(-1, 1, length.out = n)
x2 <- Xmedia2 + 4 * Xdt2 * seq(-1, 1, length.out = n)
dat <- data.frame(
x = union(x1, x2)
)
dat$y1 <- dnorm(dat$x, Xmedia1, Xdt1)
dat$y2 <- dnorm(dat$x, Xmedia2, Xdt2)
Ymax1 <- dnorm(Xmedia1, Xmedia1, Xdt1)
Ymax2 <- dnorm(Xmedia2, Xmedia2, Xdt2)
ggplot(dat, aes(x)) +
geom_hline(yintercept = 0, colour = "grey", linewidth = 1) +
geom_ribbon(aes(ymin = y1, ymax = y2),
data = subset(dat, x >= Xmedia2 + 1.5 * Xdt2),
fill = "red", alpha = 0.5
) +
annotate(
geom = "segment",
x = c(Xmedia1, Xmedia2), y = 0,
xend = c(Xmedia1, Xmedia2), yend = c(Ymax1, Ymax2),
linetype = "dashed",
linewidth = 1,
colour = c("grey", "black")
) +
geom_line(aes(y = y1), linewidth = 1, colour = "grey") +
geom_line(aes(y = y2), linewidth = 1, colour = "black") +
theme(
line = element_blank(),
axis.line.y = element_blank(),
axis.text = element_blank(),
axis.ticks = element_blank(),
axis.title = element_blank(),
legend.position = "none",
panel.grid = element_blank(),
panel.background = element_rect(fill = "lightgray", colour = NA),
)
}
graf_normal(250, 7, 253, 7)
One way is using a geom_polygon instead of stat_function.
Add this to your function, before the ggplot():
poly <- data.frame(xs = seq(Xmedia2+1.5*Xdt2, Xmax2, length.out = n)) |>
transform(
y1 = dnorm(xs, Xmedia1, Xdt1),
y2 = dnorm(xs, Xmedia2, Xdt2)
) |>
with(data.frame(X = c(xs, rev(xs)), Y = c(y1, rev(y2))))
And then replace your both of your second two stat_function calls with a single
geom_polygon(aes(X, Y), data = poly,
fill = "red", alpha = 0.5) +
Full source:
graf_normal <- function(Xmedia1, Xdt1, Xmedia2, Xdt2, n = 20) {
Xmin1 <- Xmedia1-4*Xdt1
Xmax1 <- Xmedia1+4*Xdt1
Xmin2 <- Xmedia2-4*Xdt2
Xmax2 <- Xmedia2+4*Xdt2
Ymax1 <- max(dnorm(Xmedia1, Xmedia1, Xdt1))
Ymax2 <- max(dnorm(Xmedia2, Xmedia2, Xdt2))
Xmin <- min(Xmin1, Xmin2)
Xmax <- max(Xmax1, Xmax2)
poly <- data.frame(xs = seq(Xmedia2+1.5*Xdt2, Xmax2, length.out = n)) |>
transform(
y1 = dnorm(xs, Xmedia1, Xdt1),
y2 = dnorm(xs, Xmedia2, Xdt2)
) |>
with(data.frame(X = c(xs, rev(xs)), Y = c(y1, rev(y2))))
ggplot(data.frame(X = c(Xmin, Xmax)), aes(x = X)) +
geom_hline(yintercept = 0, colour = "grey", linewidth = 1) +
geom_polygon(aes(X, Y), data = poly,
fill = "red", alpha = 0.5) +
stat_function(fun = dnorm,
args = c(Xmedia1, Xdt1),
linewidth = 1,
colour = "grey") +
stat_function(fun = dnorm,
args = c(Xmedia2, Xdt2),
linewidth = 1,
colour = "black") +
geom_segment(aes(x = Xmedia1, y = 0, xend = Xmedia1, yend = Ymax1),
linetype = "dashed",
linewidth = 0,
colour = "grey") +
geom_segment(aes(x = Xmedia2, y = 0, xend = Xmedia2, yend = Ymax2),
linetype = "dashed",
linewidth = 0,
colour = "black") +
####################################################################
# stat_function(fun = dnorm,
# args = c(Xmedia2, Xdt2),
# xlim = c(Xmedia2+1.5*Xdt2,Xmax2),
# geom = "area",
# fill = "red",
# alpha = 0.5) +
# stat_function(fun = dnorm,
# args = c(Xmedia1, Xdt1),
# xlim = c(Xmedia1,Xmax1),
# geom = "area",
# fill = NA,
# alpha = 0.01) +
##################################################################
theme(
line = element_blank(),
axis.line.y = 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(),
legend.position = "none",
panel.grid = element_blank(),
panel.background = element_rect(fill = "lightgray", colour = NA),
) +
xlim(c(Xmin, Xmax))
}
Note: I chose to move the geom_polygon to much earlier in the plot-stack so that the dnorm-lines would be "on top" of the red area. Whether this is important depends on your context and rendering engine.
After running the following commands:
Population <- c("A", "A", "A", "A", "B", "B", "B", "B")
Group <- rep(c("Experimental", "Experimental", "Control", "Control"), 2)
wave <- rep(c("Pretest", "Posttest"), 4)
outcome <- c(-.3, -.2, -.3, .4, -.6, -.5, -.6, .6)
ci <- rep(c(.13, .14), 4)
df <- data.frame(Population, Group, wave, outcome, ci)
df$wave <- factor(df$wave,levels = c('Pretest','Posttest'))
library(ggplot2)
pd <- position_dodge(0.1)
ggplot(df, aes(x = wave, y = outcome, color = interaction(Population, Group), shape = Group, group = interaction(Population, Group))) +
geom_errorbar(aes(ymin = outcome - ci, ymax = outcome + ci), width = .25, position = pd, size=.5) +
geom_line(aes(linetype = Group), position = pd, size=1, show.legend = FALSE) +
geom_point(position = pd, size = 3.5, fill = "white", stroke = 1.25, show.legend = FALSE) +
scale_color_manual(values = c("#000000", "#606060", "#000000", "#606060")) +
scale_shape_manual(values = c(23, 21)) +
coord_cartesian(xlim = c(1.4, 1.6), ylim = c(-.91, .91)) +
labs(title = "Outcomes by Population and Study Group", x = "Time", y = "Outcome\nLower scores denote fewer instances", color = "Population and Study Group") +
theme(plot.title = element_text(hjust = 0.5), axis.text.x = element_text(color = "black"), axis.text.y = element_text(color = "black"), panel.background = element_rect(fill = "#F0F0F0"))
I generate a figure that does not have dots symbols or correct line styles in the legend:
How can I:
add the dots shown in the figure itself into the legend and
have the legend lines reflect that some of dotted lines in the figure?
TYIA.
The simplest way is to create another variable that would reflect the interaction instead of creating it on the fly. If we build the plot step by step, this below gives the dots and errorbars:
library(ggplot2)
pd <- position_dodge(0.1)
df$grp = paste(df$Population,df$Group,sep=".")
g = ggplot(df, aes(x = wave, y = outcome, color = grp, shape = grp))+
geom_errorbar(aes(ymin = outcome - ci, ymax = outcome + ci), width = .25, position = pd, size=.5) +
geom_point(position = pd, size = 3.5, fill = "white", stroke = 1.25) +
scale_color_manual(values = c("#000000", "#000000","#606060", "#606060")) +
scale_shape_manual(values = c(23,21,23,21)) +
coord_cartesian(xlim = c(1.4, 1.6), ylim = c(-.91, .91)) +
labs(title = "Outcomes by Population and Study Group", x = "Time", y = "Outcome\nLower scores denote fewer instances") +
theme(plot.title = element_text(hjust = 0.5), axis.text.x = element_text(color = "black"),
axis.text.y = element_text(color = "black"), panel.background = element_rect(fill = "#F0F0F0"))
print(g)
Then add the line while specifying the legend:
g +
geom_line(inherit.aes=FALSE,aes(x = wave, y = outcome,group=grp,linetype=grp)) +
scale_linetype_manual(values=c("solid","dashed","solid","dashed"))
Sample-data:
df <- data.frame("SL" = runif(50, 2.2, 5.8), "LMX" = runif(50, 1.8, 5.5))
I have many different variables for each of which I want to make a box plot with the code below. So that all panels will have the same size, I determined the plot margin so that it is not influenced by the length of the name of the variable. Therefore, now I want to add the variable name outside of the panel to the left.
However, this turns out to be more difficult than expected. I know that this issue has been raised before, but none of the solutions works with me (rnorm or geom_text).
Any help is much appreciated, thank you :)
df %>%
select("Servant Leadership" = SL) %>%
gather(key = "variable", value = "value") -> n
n$variable <- factor(n$variable, levels = c("Servant Leadership"))
ggplot(data = n, aes(y = value, x = as.numeric(variable))) +
stat_summary(fun.data = min.mean.sd.max, geom = "boxplot", col = "#323232", fill = "#EFC76C") +
scale_fill_identity() +
scale_x_continuous(breaks = as.numeric(unique(n$variable)), minor_breaks = NULL,
labels = "", expand = c(0.12, 0.12)) +
scale_y_continuous(breaks = c(1, 2, 3, 4, 5, 6, 7)) +
expand_limits(y = c(1, 7)) + coord_flip() + labs(x = "", y = "") +
theme(text = element_text(size = 15), panel.background = element_rect(fill = "#EAEDED"),
panel.border = element_rect(fill=NA, color = "grey", size = 0.5, linetype = "solid")) +
theme(plot.margin=unit(c(0.2, 0.2, 0, 4),"cm"))
I forgot this code which I ran before:
min.mean.sd.max <- function(x) {
r <- c(min(x), mean(x) - sd(x), mean(x), mean(x) + sd(x), max(x))
names(r) <- c("ymin", "lower", "middle", "upper", "ymax")
r
}
And this are the packages which I use (maybe not all in this code however):
library(reshape)
library(scales)
library(ggplot2)
library(dplyr)
library(tidyr)
Based on the answer by Tung I amended the code for the box plot in the following way:
ggplot(data = n, aes(y = value, x = as.numeric(variable))) +
stat_summary(fun.data = min.mean.sd.max, geom = "boxplot", col = "#323232", fill = "#EFC76C") +
scale_fill_identity() +
scale_x_continuous(breaks = as.numeric(unique(n$variable)), minor_breaks = NULL,
labels = "", expand = c(0.12, 0.12)) +
scale_y_continuous(breaks = c(1, 2, 3, 4, 5, 6, 7)) +
expand_limits(y = c(1, 7)) + coord_flip(clip = "off") + labs(x = "", y = "") +
theme(text = element_text(size = 18), panel.background = element_rect(fill = "#EAEDED"),
panel.border = element_rect(fill=NA, color = "grey", size = 0.5, linetype = "solid")) +
geom_text(x = 1, y = 0.5, inherit.aes = FALSE, label = "Servant Leadership", check_overlap = TRUE, hjust = 1,
fontface = 'plain', size = 6, color = "#4E4E4E") +
theme(plot.margin=unit(c(0.05, 4.5, 0, 9.5),"cm"))
I've been scratching my head for hours on this. What I have up to now:
library(ggplot2)
library(grid)
all_data = data.frame(country=rep(c("A","B","C","D"),times=1,each=20),
value=rep(c(10,20,30,40),times=1,each=20),
year = rep(seq(1991,2010),4))
# PLOT GRAPH
p1 <- ggplot() + theme_bw() + geom_line(aes(y = value, x = year,
colour=country), size=2,
data = all_data, stat="identity") +
theme(plot.title = element_text(size=18,hjust = -0.037), legend.position="bottom",
legend.direction="horizontal", legend.background = element_rect(size=0.5, linetype="solid", colour ="black"),
legend.text = element_text(size=16,face = "plain"), panel.grid.major = element_blank(), panel.grid.minor = element_blank(),
panel.border = element_blank(),axis.line = element_line(colour = "black"),legend.title = element_blank(),
axis.text=element_text(size=18,face = "plain"),axis.title.x=element_text(size=18,face = "plain", hjust = 1,
margin = margin(t = 10, r = 0, b = 0, l = 0)),
axis.title.y=element_blank())
p1 <- p1 + ggtitle("Index")
p1 <- p1 + xlab("Year")
p1 <- p1 + scale_x_continuous(expand=c(0,0),breaks=seq(1991,2010,4))
p1 <- p1 + theme(plot.margin=unit(c(5.5, 300, 5.5, 5.5), "points"))
p1 <- p1 + geom_text(aes(label = "Country", x = 2011, y =
max(all_data$value)+10), hjust = 0, vjust = -2.5, size = 6)
p1 <- p1 + geom_text(aes(label = "Average", x = Inf, y =
max(all_data$value)+10), hjust = -1.5, vjust = -2, size = 6)
p1 <- p1 + geom_text(aes(label = all_data$country, x = 2011, y =
all_data$value), hjust = 0, size = 6)
p1 <- p1 + geom_text(aes(label = as.character(all_data$value), x = Inf,
y = all_data$value), hjust = -5, size = 6)
p1 <- p1 +
annotate("segment",x=2011,xend=2014,y=Inf,yend=Inf,color="black",lwd=1)
# Override clipping
gg2 <- ggplot_gtable(ggplot_build(p1))
gg2$layout$clip[gg2$layout$name == "panel"] <- "off"
grid.draw(gg2)
What I am struggling with is the following:
1) how to annotate outside of the plot, underline both "Country" and "Average" without extending the x-axis.
2) Isn't there more systematic approach to the whole annotation process. Adjusting hjust and vjust by visual inspection seems very troublesome.
Any help is appreciated!
See if this works for you:
# define some offset parameters
x.offset.country = 2
x.offset.average = 5
x.range = range(all_data$year) + c(0, x.offset.average + 2)
y.range = range(all_data$value) + c(-5, 10)
y.label.height = max(all_data$value) + 8
# subset of data for annotation
all_data_annotation <- dplyr::filter(all_data, year == max(year))
p <- ggplot(all_data,
aes(x = year, y = value, group = country, colour = country)) +
geom_line(size = 2) +
# fake axes (x-axis stops at year 2009, y-axis stops at value 45)
annotate("segment", x = 1991, y = 5, xend = 2009, yend = 5) +
annotate("segment", x = 1991, y = 5, xend = 1991, yend = 45) +
# country annotation
geom_text(data = all_data_annotation, inherit.aes = FALSE,
aes(x = year + x.offset.country, y = value, label = country)) +
annotate("text", x = max(all_data$year) + x.offset.country, y = y.label.height,
label = "~underline('Country')", parse = TRUE) +
# average annotation
geom_text(data = all_data_annotation, inherit.aes = FALSE,
aes(x = year + x.offset.average, y = value, label = value)) +
annotate("text", x = max(all_data$year) + x.offset.average, y = y.label.height,
label = "~underline('Average')", parse = TRUE) +
# index (fake y-axis label)
annotate("text", x = 1991, y = y.label.height,
label = "Index") +
scale_x_continuous(name = "Year", breaks = seq(1991, 2009, by = 4), expand = c(0, 0)) +
scale_y_continuous(name = "", breaks = seq(10, 40, by = 10), expand = c(0, 0)) +
scale_colour_discrete(name = "") +
coord_cartesian(xlim = x.range, ylim = y.range) +
theme_classic() +
theme(axis.line = element_blank(),
legend.position = "bottom",
legend.background = element_rect(size=0.5, linetype="solid", colour ="black"))
# Override clipping (this part is unchanged)
gg2 <- ggplot_gtable(ggplot_build(p))
gg2$layout$clip[gg2$layout$name == "panel"] <- "off"
grid.draw(gg2)
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"))))