I would like to add jpeg picture in a place of 'ao' in the following figure
library(ggplot2)
da <- data.frame(x = seq(0, 100, 1), y = seq(0, 1, 0.01))
ao <- ggplot()
a1 <- ggplot(aes(x = x, y = y), data = da) + geom_line()
a2 <- ggplot(aes(x = x, y = y), data = da) + geom_point()
a3 <- ggplot(aes(x = x, y = y), data = da) + geom_line(lty = 2)
library(cowplot)
plot_grid(ao, a1, a2, a3, labels=c("a)", "c)", "b)", "d)"), ncol = 2, nrow = 2)
I am not restricted to ´cowplot´ library. anything that works is fine.
Ok, I finally solved it like that
library(ggplot2)
ao <- ggplot()
image <- load.image("FIGURE/xxxx.png")
library(magick)
a0 <- ggdraw(a0) + draw_image(image)
da <- data.frame(x = seq(0, 100, 1), y = seq(0, 1, 0.01))
a1 <- ggplot(aes(x = x, y = y), data = da) + geom_line()
a2 <- ggplot(aes(x = x, y = y), data = da) + geom_point()
a3 <- ggplot(aes(x = x, y = y), data = da) + geom_line(lty = 2)
library(cowplot)
plot_grid(ao, a1, a2, a3, labels=c("a)", "c)", "b)", "d)"), ncol = 2, nrow = 2)
Related
library(ggplot2)
set.seed(1)
dataset <- data.frame(X = rnorm(1000))
dfun <- function(x, a, b) 1/(sqrt(2*pi)*b)*exp(-0.5*((x-a)^2/(2*b^2)))
ggplot(dataset, aes(x = X)) +
geom_histogram(aes(y = ..density..), binwidth = 0.5)+
stat_function(fun = dfun,
args = list(a = , b = ))
How can I calculate suitable values of a and b in case like this?
You can compute values for the arguments a and b with nls. Something like the following.
dens <- density(dataset$X, n = nrow(dataset))
df_dens <- data.frame(x = dens$x, y = dens$y)
a0 <- mean(dataset$X)
b0 <- sd(dataset$X)
fit <- nls(y ~ dfun(x, a, b), data = df_dens, start = list(a = a0, b = b0))
coef(fit)
# a b
#-0.007006625 0.97518478
Now plot the histogram and the function with these values for a and b.
ggplot(dataset, aes(x = X)) +
geom_histogram(aes(y = ..density..), binwidth = 0.5)+
stat_function(fun = dfun,
args = list(a = coef(fit)[1], b = coef(fit)[2]))
I'd like to change the color of the contour curve from z variable. My MWE can be seen below.
library(ggplot2)
library(tidyverse)
rosenbrock <- function(x){
d <- length(x)
out <- 0
for(i in 1 : (d - 1)){
out <- out + 100 * ( x[i]^2 - x[i + 1] )^2 + (x[i] - 1)^2
}
out
}
set.seed(1)
coord <- matrix(runif(2000, -50, 50), byrow = TRUE, ncol = 2)
graph <- apply(coord, 1, rosenbrock)
results <- data.frame(x = coord[, 1], y = coord[, 2], z = graph) %>%
arrange(x, y)
set.seed(2020)
n <- 5
x1 <- matrix(c(round(rnorm(n, -12, 5), 2), 0, round(rnorm(n, -6, 5), 2), 0), byrow = F, ncol = 2)
y1 <- apply(x1, 1, function(x) rosenbrock(x))
test_points <- data.frame(x = x1[, 1], y = x1[, 2],
z = y1)
results %>%
ggplot(aes(x = x, y = y, z = z)) +
stat_density2d() +
geom_point(data = test_points, aes(colour = z), size = 2.0, shape = 19) +
scale_colour_gradientn(colours=rainbow(4)) +
theme_light() +
labs(colour = 'Fitness')
Something like this?
results %>%
ggplot(aes(x = x, y = y, z = z)) +
stat_density2d(aes(fill = stat(level)), geom = "polygon") +
geom_point(data = test_points, aes(colour = z), size = 2.0, shape = 19) +
scale_colour_gradientn(colours=rainbow(4)) +
theme_light() +
labs(colour = 'Fitness')
The last few examples at https://ggplot2.tidyverse.org/reference/geom_density_2d.html might be what you're looking for
I am trying to get two contours in the same plot using ggplot2 in R.
Here is a reproducible example:
library(MASS)
library(ggplot2)
# first contour
m <- c(.0, -.0)
sigma <- matrix(c(1,.5,.5,1), nrow=2)
data.grid <- expand.grid(s.1 = seq(-3, 3, length.out=200), s.2 = seq(-3, 3, length.out=200))
q.samp <- cbind(data.grid, prob = mvtnorm::dmvnorm(data.grid, mean = m, sigma = sigma))
plot1 <- ggplot(q.samp, aes(x = s.1, y = s.2, z = prob)) +
stat_contour(color = 'green')
# second contour
m1 <- c(1, 1)
sigma1 <- matrix(c(1,-.5,-.5,1), nrow=2)
set.seed(10)
data.grid1 <- expand.grid(s.1 = seq(-3, 3, length.out=200), s.2 = seq(-3, 3, length.out=200))
q.samp1 <- cbind(data.grid1, prob = mvtnorm::dmvnorm(data.grid1, mean = m1, sigma = sigma1))
plot2 <- ggplot(q.samp1, aes(x = s.1, y = s.2, z = prob)) +
stat_contour(color = 'red')
However, trying plot1 + plot2 also does not work. Is there a way to get the two contours on the same plot.
What about including another stat_contour with different data?
ggplot(q.samp1, aes(x = s.1, y = s.2, z = prob)) +
stat_contour(color = 'red') +
stat_contour(data = q.samp, aes(x = s.1, y = s.2, z = prob), color = 'green')
I am trying to use a log-modulus transformation in my plot. It was working fine...
library(tidyverse)
library(scales)
log_modulus_trans <- function()
trans_new(name = "log_modulus",
transform = function(x) sign(x) * log(abs(x) + 1),
inverse = function(x) sign(x) * ( exp(abs(x)) - 1 ))
# fake data
set.seed(1)
d <- data_frame(
tt = rep(1:10, 3),
cc = rep(LETTERS[1:3], each = 10),
xx = c(rnorm(10, mean = 100, sd = 10),
rnorm(10, mean = 0, sd = 10),
rnorm(10, mean = -100, sd = 10)))
ggplot(data = d,
mapping = aes(x = tt, y = xx, group = cc)) +
geom_line() +
coord_trans(y = "log_modulus")
When I tried to add a geom_vline() things got weird...
ggplot(data = d,
mapping = aes(x = tt, y = xx, group = cc)) +
geom_line() +
coord_trans(y = "log_modulus") +
geom_vline(xintercept = 5)
Any idea how to get geom_vline() to go from the top to the bottom of the plot window... or a work around hack?
Here is a solution using geom_segment
ggplot(data = d,
mapping = aes(x = tt, y = xx, group = cc)) +
geom_line() +
geom_segment(x = 5, xend = 5, y = -150, yend = 150) +
coord_trans(y = "log_modulus")
I used alphahull package to delineate dots on a map.
I plot the contours with a geom_segment.
My question is : how to fill the delineation given by the segment with a color ?
Here is a reproducible example :
set.seed(2)
dat <- data.frame(x = rnorm(20, 10, 5), y = rnorm(20, 20, 5), z = c(rep(1, 6), rep(2, 4)))
library(ggplot2)
library(alphahull)
alpha <- 100
alphashape1 <- ashape(dat[which(dat$z==1), c("x", "y")], alpha = alpha)
alphashape2 <- ashape(dat[which(dat$z==2), c("x", "y")], alpha = alpha)
map <- ggplot(dat, aes(x = x, y = y)) +
geom_point(data = dat, aes(x = x, y = y, colour = as.factor(dat$z))) +
geom_segment(data = data.frame(alphashape1$edges), aes(x = x1, y = y1, xend = x2, yend = y2, colour = levels(as.factor(dat$z))[1])) +
geom_segment(data = data.frame(alphashape2$edges), aes(x = x1, y = y1, xend = x2, yend = y2, colour = levels(as.factor(dat$z))[2]))
map
I believe this works w/o the need for graph ops:
fortify.ashape <- function(ashape_res) {
xdf <- data.frame(ashape_res$edges)
xdf <- do.call(
rbind,
lapply(1:nrow(xdf), function(i) {
rbind(
data.frame(x=xdf$x1[i], y=xdf$y1[i]),
data.frame(x=xdf$x2[i], y=xdf$y2[i])
)
})
)
xdf <- xdf[order(-1 * atan2(
xdf$y - mean(range(xdf$y)),
xdf$x - mean(range(xdf$x)))), c("x", "y")]
xdf <- rbind.data.frame(xdf[nrow(xdf),], xdf[1:(nrow(xdf)-1),])
xdf
}
alphashape1 <- ashape(dat[which(dat$z == 1), c("x", "y")], alpha = 15)
alphashape2 <- ashape(dat[which(dat$z == 2), c("x", "y")], alpha = 15)
ggplot() +
geom_point(data = dat, aes(x = x, y = y, colour = as.factor(dat$z))) +
geom_polygon(data=alphashape1, aes(x, y), fill="red", alpha=2/3) +
geom_polygon(data=alphashape2, aes(x, y), fill="blue", alpha=2/3)
This is because the ashape function only returns segments, not in any order.
The only way I found to reconstruct the order was by using the node information to form a graph and then find the shortest path along that graph.
A detailed example is here: https://rpubs.com/geospacedman/alphasimple - the code needs wrapping into a single function, which should be fairly easy to do. Once you have that order sorted, geom_polygon will draw it with filled shading in ggplot2.
Based on Spacedman's answer, I ordered separately the two sets of points and came up with this solution.
It could be optimized with a function that does it for each group automatically.
set.seed(2)
dat <- data.frame(x = rnorm(20, 10, 5), y = rnorm(20, 20, 5), z = c(rep(1, 6), rep(2, 4)))
library(ggplot2)
library(alphahull)
alpha <- 100
alphashape1 <- ashape(dat[which(dat$z==1), c("x", "y")], alpha = alpha)
alphashape2 <- ashape(dat[which(dat$z==2), c("x", "y")], alpha = alpha)
map <- ggplot(dat, aes(x = x, y = y)) +
geom_point(data = dat, aes(x = x, y = y, colour = as.factor(dat$z))) +
geom_segment(data = data.frame(alphashape1$edges), aes(x = x1, y = y1, xend = x2, yend = y2, colour = levels(as.factor(dat$z))[1])) +
geom_segment(data = data.frame(alphashape2$edges), aes(x = x1, y = y1, xend = x2, yend = y2, colour = levels(as.factor(dat$z))[2]))
map
alpha <- 15 # transparency argument
# First contour
alphashape1 <- ashape(dat[which(dat$z == 1), c("x", "y")], alpha = alpha)
alphashape1_ind <- alphashape1$edges[, c("ind1", "ind2")]
class(alphashape1_ind) = "character"
alphashape1_graph <- graph.edgelist(alphashape1_ind, directed = FALSE)
cut_graph1 <- alphashape1_graph - E(alphashape1_graph)[1] # Cut the first edge
ends1 <- names(which(degree(cut_graph1) == 1)) # Get two nodes with degree = 1
path1 <- get.shortest.paths(cut_graph1, ends1[1], ends1[2])$vpath[[1]]
path_nodes1 <- as.numeric(V(alphashape1_graph)[path1]$name)
# Second contour
alphashape2 <- ashape(dat[which(dat$z == 2), c("x", "y")], alpha = alpha)
alphashape2_ind <- alphashape2$edges[, c("ind1", "ind2")]
class(alphashape2_ind) = "character"
alphashape2_graph <- graph.edgelist(alphashape2_ind, directed = FALSE)
cut_graph2 <- alphashape2_graph - E(alphashape2_graph)[1] # Cut the first edge
ends2 <- names(which(degree(cut_graph2) == 1)) # Get two nodes with degree = 1
path2 <- get.shortest.paths(cut_graph2, ends2[1], ends2[2])$vpath[[1]]
path_nodes2 <- as.numeric(V(alphashape2_graph)[path2]$name)
# Updating of previous plot (see question)
map +
geom_polygon(data = dat[which(dat$z == 1), c("x", "y")][path_nodes1, ], aes(x = x, y = y),
fill = "red", colour = "red", size = 0.5, alpha = 0.3) +
geom_polygon(data = dat[which(dat$z == 2), c("x", "y")][path_nodes2, ],
aes(x = x, y = y), colour = "blue", fill = "blue", size = 0.5, alpha = 0.3)