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.
Related
I have a problem with drawing coloured areas behind the plot of a Normal Distribution. I desire to achieve something like this:
enter image description here
but without the blank gaps.
My code is
normal <- function(mu, sigma, x){
1/(sigma*sqrt(2*pi))*exp(-((x-mu)/sigma)^2)
}
normal_shade1 <- function(mu, sigma, x){
y <- normal(mu=mu, sigma=sigma, x)
y[x < 0.5 | x > 1.5] <- NA
return(y)
}
normal_shade2 <- function(mu, sigma, x){
y <- normal(mu=mu, sigma=sigma, x)
y[x < 1.5 | x > 2.5] <- NA
return(y)
}
normal_shade3 <- function(mu, sigma, x){
y <- normal(mu=mu, sigma=sigma, x)
y[x < 2.5 | x > 3.5] <- NA
return(y)
}
normal_shade4 <- function(mu, sigma, x){
y <- normal(mu=mu, sigma=sigma, x)
y[x < 3.5 | x > 4.5] <- NA
return(y)
}
normal_shade5 <- function(mu, sigma, x){
y <- normal(mu=mu, sigma=sigma, x)
y[x < 4.5 | x > 5.5] <- NA
return(y)
}
normal_shade6 <- function(mu, sigma, x){
y <- normal(mu=mu, sigma=sigma, x)
y[x < 5.5 | x > 6.5] <- NA
return(y)
}
normal_shade7 <- function(mu, sigma, x){
y <- normal(mu=mu, sigma=sigma, x)
y[x < 6.5 | x > 7.5] <- NA
return(y)
}
p2 <- ggplot(data = data.frame(x = seq(0.5,7.5,by=0.1)), aes(x)) +
stat_function(fun=normal_shade1, geom='area', fill = '#f0f9e8', args=list(mu=4, sigma=1.6), alpha = 1) +
stat_function(fun=normal_shade2, geom='area', fill = '#ccebc5', args=list(mu=4, sigma=1.6), alpha = 1) +
stat_function(fun=normal_shade3, geom='area', fill = '#a8ddb5', args=list(mu=4, sigma=1.6), alpha = 1) +
stat_function(fun=normal_shade4, geom='area', fill = '#7bccc4', args=list(mu=4, sigma=1.6), alpha = 1) +
stat_function(fun=normal_shade5, geom='area', fill = '#4eb3d3', args=list(mu=4, sigma=1.6), alpha = 1) +
stat_function(fun=normal_shade6, geom='area', fill = '#2b8cbe', args=list(mu=4, sigma=1.6), alpha = 1) +
stat_function(fun=normal_shade7, geom='area', fill = '#08589e', args=list(mu=4, sigma=1.6), alpha = 1) +
stat_function(fun=normal, geom='line', args=list(mu=4, sigma=1.6), size = 0.3) + ylab("") +
scale_y_continuous(expand = expansion(mult = c(0, 0)), breaks = NULL) +
scale_x_continuous(breaks = seq(0.5,7.5,by=1), labels = ("−∞",1.5,2.5,3.5,4.5,5.5,6.5,"\U221E"))
p2 + labs(title = "",
x = "", y = "", fill = "Legenda") +
theme_set(
theme_bw() +
theme(
#axis.title.x = element_text(margin = margin(15, 0, 0, 0)),
axis.title.y = element_text(margin = margin(0, 1, 0, 0)),
strip.text = element_text(size = 11),
axis.text = element_text(size = 12, color = "black"),
plot.title = element_blank(),#element_text(size = 20),
plot.subtitle = element_text(size = 17),
axis.title = element_blank(),#element_text(size = 20),
axis.line.x = element_line(colour = "black", size = 0.3),
axis.line.y = element_blank(),
axis.text.x = element_text(size = 12, family = "Iwona"),
axis.text.y = element_text(size = 20),
legend.text = element_text(size = 20),
axis.ticks = element_line(colour = "black", size = 0.3),
legend.key = element_rect(fill = "white"),
legend.position = "top",
panel.border = element_blank(),
panel.grid.major = element_blank(),
panel.grid.minor = element_blank(),
axis.line = element_line(colour = "black"),
panel.background = element_rect(fill = "white")
)
)
I have already obtained the results that I am looking for in this image:
enter image description here
with a similar code.
I really appreciate if anyone can help me.
stat_function works by sampling points along the x-axis and calculating the corresponding y-value. This is controlled by the n parameter ("Number of points to interpolate along the x axis."), which is by default 101. In your case, this is not enough, thus yielding gaps. If you increase the n to a high enough value, the gaps will be gone.
In this case with n = 2000:
ggplot(data = data.frame(x = seq(0.5,7.5,by=0.1)), aes(x)) +
stat_function(fun=normal_shade1, geom='area', fill = '#f0f9e8', n = 2000, args=list(mu=4, sigma=1.6), alpha = 1) +
stat_function(fun=normal_shade2, geom='area', fill = '#ccebc5', n = 2000, args=list(mu=4, sigma=1.6), alpha = 1) +
stat_function(fun=normal_shade3, geom='area', fill = '#a8ddb5', n = 2000, args=list(mu=4, sigma=1.6), alpha = 1) +
stat_function(fun=normal_shade4, geom='area', fill = '#7bccc4', n = 2000, args=list(mu=4, sigma=1.6), alpha = 1) +
stat_function(fun=normal_shade5, geom='area', fill = '#4eb3d3', n = 2000, args=list(mu=4, sigma=1.6), alpha = 1) +
stat_function(fun=normal_shade6, geom='area', fill = '#2b8cbe', n = 2000, args=list(mu=4, sigma=1.6), alpha = 1) +
stat_function(fun=normal_shade7, geom='area', fill = '#08589e', n = 2000, args=list(mu=4, sigma=1.6), alpha = 1) +
stat_function(fun=normal, geom='line', args=list(mu=4, sigma=1.6), size = 0.3) + ylab("") +
scale_y_continuous(expand = expansion(mult = c(0, 0)), breaks = NULL) +
scale_x_continuous(breaks = seq(0.5,7.5,by=1), labels = c("−∞",1.5,2.5,3.5,4.5,5.5,6.5,"\U221E"))
I am trying to add images to a y-axis label. At the moment I am only able to add them inside the graph. You can find the code for the added images at the bottom of the code chunk. I want the flags to be displayed after or under or on top of the country name.
Does anybody know how to do it or where I can find a tutorial?
p <- ggplot(data, aes(x = country, y = thisyear)) +
geom_segment(aes(
x = reorder(country, thisyear) ,
xend = country,
y = lastyear,
yend = thisyear
),
color = "#3b3b3b") +
geom_point(size = 3, color = "#f7931b") +
geom_point(aes(x = country, y = lastyear), color = "#BCBCBC", size = 4) +
geom_point(aes(x = country, y = thisyear), color = "#f7931b", size = 4) +
annotate(
"text",
label = "this year",
x = nrow(data) - 0.7,
y = data[2, 3] + 3,
size = 4,
color = "#f7931b",
fontface = "bold"
) +
geom_curve(
aes(
x = nrow(data) - 0.85,
y = data[2, 3] + 3,
xend = nrow(data) - 1,
yend = data[2, 3] + 0.5
),
colour = "#f7931b",
size = 1,
curvature = -0.2,
arrow = arrow(length = unit(0.015, "npc"))
) +
annotate(
"text",
label = "last year",
x = nrow(data) - 1.5,
y = data[2, 2] + 3.2,
size = 4,
color = "#A8A8A8",
fontface = "bold"
) +
geom_curve(
aes(
x = nrow(data) - 1.35,
y = data[2, 2] + 3.2,
xend = nrow(data) - 1.05,
yend = data[2, 2] + 0.5
),
colour = "#A8A8A8",
size = 1,
curvature = -0.15,
arrow = arrow(length = unit(0.015, "npc"))
) +
scale_y_continuous(expand = expansion(mult = c(0, .05))) +
coord_flip() +
theme_ipsum() +
theme(
panel.grid.minor.y = element_blank(),
panel.grid.major.y = element_blank(),
legend.position = "none"
) +
labs(
title = "Share Of Global Bictoin Hashrate",
subtitle = paste0(as.character(format(maxdate, "%B %Y")), " Monthly Average"),
x = "",
y = '%',
caption = "#data99076083 | Source: Cambridge Centre for Alternative Finance (https://www.cbeci.org/mining_map)"
) +
theme_ipsum() +
theme(
legend.title = element_blank(),
plot.title = element_text(color = "#f7931b"),
plot.subtitle = element_text(color = "#3b3b3b"),
plot.caption = element_text(color = "#646464", face = 'bold'),
panel.border = element_rect(
colour = "grey",
fill = NA,
size = 1
)
)
p <-
p + geom_image(data = data, aes(x = id, y = 70, image = emoji), size = 0.04)
p
SOLUTION
As suggested I have tried to add the images with the [ggtext][2] tutorial. First I had to make the label vector with the HTML code:
labels <- c()
for (i in 1:length(data$emoji)){
img.name <- data$country[i]
labels <- c(labels, paste0("<img src='", data$emoji[i], "' width='25' /><br>*", img.name,"*"))
}
Example image code:
"<img src='../pics/twitter-emojis/flag-cote-divoire_1f1e8-1f1ee.png'
width='100' /><br>*I. virginica*"
After that the labels can be changed and printed with markdown:
p + scale_x_discrete(name = NULL,
labels = rev(labels)) +
theme(axis.text.y = element_markdown(color = "black", size = 11))
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"))
I'm trying to control the height of plots in a grid layout in ggplot2. I found some promising examples for page spacing using viewport.
I managed to control the column width. I want the first column to be a third of the page width.
However, I want the second row of figures to sit close to the first row. I tried fooling around with the plot margins, but I'm unable to affect the spacing between the two rows.
Here's the code that draws my figures.
library(ggplot2)
library(gridExtra)
# Generate a vector of times.
t=seq(0, 2 , 0.0001)
# Draw some figures using segments.
df1 <- data.frame(x1 = 0, x2 = 1, y1 = 0, y2 = .1)
open_pipe_p <- ggplot(data = df1) +
theme(panel.background = element_rect(fill = "white"),
axis.text = element_blank(),
axis.title = element_blank(),
axis.ticks = element_blank(),
plot.margin = unit(c(0,0.0,0,0), units="npc")) +
coord_fixed() +
geom_segment(aes(x = x1, y = y1, xend = x2, yend = y1), size = .75) +
geom_segment(aes(x = x1, y = y2, xend = x2, yend = y2), size = .75)
closed_pipe_p <- ggplot(data = df1) +
theme(panel.background = element_rect(fill = "white"),
axis.text = element_blank(),
axis.title = element_blank(),
axis.ticks = element_blank(),
plot.margin = unit(c(0,0.0,0,0), units="npc")) +
coord_fixed() +
geom_segment(aes(x = x1, y = y1, xend = x2, yend = y1), size = .75) +
geom_segment(aes(x = x1, y = y2, xend = x2, yend = y2), size = .75) +
geom_segment(aes(x = x1, y = y1, xend = x1, yend = y2), size = .75) +
xlim(0, 2)
# Draw some sinusoids.
# Parameters of sinusoid.
A <- 1
f <- .5
phi <- pi / 2
# Y values.
y <- A * sin(2 * pi * f * t + phi)
df_sin <- data.frame(cbind(t, y))
# I only need 1 second.
df_sin <- df_sin[df_sin$t <= 1, ]
df_sin$y[df_sin$t > 1] <- NA
open_wave_p <- ggplot(data = df_sin) +
theme(panel.background = element_rect(fill = "white"),
axis.line = element_line(),
axis.text.y = element_blank(),
axis.title = element_blank(),
axis.ticks.y = element_blank(),
plot.margin = unit(c(0,0.0,0,0), units="npc")) +
scale_x_continuous(breaks = seq(0, 1, .2),
expand = c(0, 0)) +
coord_fixed(ratio = .1) +
geom_line(mapping = aes(x = t, y = y)) +
geom_line(mapping = aes(x = t, y = -y))
A <- 1
f <- .25
phi <- 0
y <- A * sin(2 * pi * f * t + phi)
df_sin <- data.frame(cbind(t, y))
closed_wave_p <- ggplot(data = df_sin) +
theme(panel.background = element_rect(fill = "white"),
axis.line = element_line(),
axis.text.y = element_blank(),
axis.title = element_blank(),
axis.ticks.y = element_blank(),
plot.margin = unit(c(0,0.0,0,0), units="npc")) +
scale_x_continuous(breaks = seq(0, 1, .2),
expand = c(0, 0)) +
coord_fixed(ratio = .1) +
geom_line(mapping = aes(x = t, y = y)) +
geom_line(mapping = aes(x = t, y = -y))
# Set up the grid.
grid.newpage()
pushViewport(viewport(layout=grid.layout(
nrow = 2,
ncol = 2,
widths = c(0.333, 0.667),
heights = c(0.25, 0.75))))
print(open_pipe_p, vp=viewport(layout.pos.row=1,layout.pos.col=1))
print(closed_pipe_p, vp=viewport(layout.pos.row=1,layout.pos.col=2))
print(open_wave_p, vp=viewport(layout.pos.row=2,layout.pos.col=1))
print(closed_wave_p, vp=viewport(layout.pos.row=2,layout.pos.col=2))
If you're using something like coord_fixed() then the plots won't automatically expand to fill all available space. Finding a good plot size that will show all the plots without too much whitespace is often a bit of a process of trial and error (although I guess you could do some rough math to figure it out based on the ratio of width to height).
In that case, rather than solving it with code, you can just view the plot in a resizable window (e.g. by clicking "Zoom" in RStudio), and manually resize the window to figure out a good size.
This question is a follow-up to this post: previous post
I have 28 variables, M1, M2, ..., M28, for which I compute certain statistics x and y.
library(ggplot2)
df = data.frame(model = factor(paste("M", 1:28, sep = ""), levels=paste("M", 1:28, sep = "")), a = runif(28, 1, 1.05), b = runif(28, 1, 1.05))
levels = seq(0.8, 1.2, 0.05)
Here is the plot:
ggplot(data=df) +
geom_polygon(aes(x=model, y=a, group=1), color = "black", fill = NA) +
geom_polygon(aes(x=model, y=b, group=1), color = "blue", fill = NA) +
coord_polar() +
scale_y_continuous(limits=range(levels), breaks=levels, labels=levels) +
theme(axis.text.y = element_blank(), axis.ticks = element_blank(), axis.title.x = element_blank(), axis.title.y = element_blank())
I would like to add a point the the plot, with y-value = 1 for M1 (model1). I tried adding:
geom_point(aes(y = 1, x = "M1"), color = "red", cex = 0.5)
but it doesn't work. Any idea what I am doing wrong?
Thanks for your help!
cex is not an argument for geom_point. Try size, e.g.
geom_point(aes(y = 1, x = "M1"), color = "red", size = 10)