I'd like to plot a specific number of points of z in the contour curve, for example, 8 or 10 points. Below I show an example, but with all points.
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(2020)
coord <- matrix(runif(2000, -100, 100), ncol = 2)
graph <- apply(coord, 1, rosenbrock)
results <- data.frame(x = coord[, 1], y = coord[, 2], z = graph)
results <- results %>% arrange(desc(z))
results %>%
ggplot(aes(x = x, y = y, z = z)) +
geom_point(aes(colour = z)) +
stat_density2d() +
theme_light()
You can set the alpha to equal zero when you originally plot the points, and then filter the data to include the points that you want (here, I just took a random sample):
results %>%
ggplot(aes(x = x, y = y, z = z)) +
geom_point(aes(colour = z), alpha=0) +
stat_density2d() +
geom_point(data = sample_n(results, 10), aes(colour = z)) +
theme_light()
Related
I am trying to create Bland-Altman plots between 2 sets of percentages with a custom function that uses ggplot within it to generate the plot.
Perc1 <- sample(1:100, 100)
Perc2 <- sample(1:100, 100)
d <- data.frame(Perc1, Perc2)
bland <- function(dat, x, y){
df <- subset(dat[ ,c(x, y)])
df$avg <- rowMeans(df)
df$diff <- df[[1]] - df[[2]]
mean_diff <- mean(df$diff)
lower <- mean_diff - 1.96 * sd(df$diff)
upper <- mean_diff + 1.96 * sd(df$diff)
p <- ggplot(df, aes(x = avg, y = diff)) +
geom_point(size=2) +
geom_hline(yintercept = mean_diff) +
geom_hline(yintercept = lower, color = "red", linetype="dashed") +
geom_hline(yintercept = upper, color = "red", linetype="dashed") +
ggtitle("Bland-Altman Plot") +
ylab("Difference Between Measurements") +
xlab("Average Measurement")
plot(p)
}
bland(d, Perc1, Perc2)
However, when I run the function none of the lines are produced with the graph, but the title and x/y labels are. If anyone can explain why this is that would be great, thanks in advance.
Try this:
(Note also, the p <- and plot(p) are not needed as the function anyway returns the last object.)
library(tidyverse)
Perc1 <- sample(1:100, 100)
Perc2 <- sample(1:100, 100)
bland <- function(x, y){
df <- data.frame(x, y)
df$avg <- rowMeans(df)
df$diff <- df[[1]] - df[[2]]
mean_diff <- mean(df$diff)
lower <- mean_diff - 1.96 * sd(df$diff)
upper <- mean_diff + 1.96 * sd(df$diff)
p <- ggplot(df, aes(x = avg, y = diff)) +
geom_point(size=2) +
geom_hline(yintercept = mean_diff) +
geom_hline(yintercept = lower, color = "red", linetype="dashed") +
geom_hline(yintercept = upper, color = "red", linetype="dashed") +
ggtitle("Bland-Altman Plot") +
ylab("Difference Between Measurements") +
xlab("Average Measurement")
plot(p)
}
bland(Perc1, Perc2)
Created on 2022-05-17 by the reprex package (v2.0.1)
I'm trying to create a normal hexbin plot but instead of coloring the plot by count, the default, I would like to have it colored by the average value of a third variable. In my particular case, I cannot use the stat_summary_hex function.
library(ggplot2)
library(hexbin)
x <- rnorm(1e4, 0, 5)
y <- rnorm(1e4, 0, 10)
z <- rnorm(1e4, 20, 1)
data.frame(x, y, z) %>%
ggplot(mapping = aes(x = x, y = y, z = z)) +
geom_hex(bins = 20)
You can use the following code:
library(ggplot2)
library(hexbin)
library(ggraph)
x <- rnorm(1e4, 0, 5)
y <- rnorm(1e4, 0, 10)
z <- rnorm(1e4, 20, 1)
data.frame(x, y, z) %>%
ggplot(aes(x, y, z=z)) +
stat_summary_hex(fun = function(x) mean(x), bins = 20) +
scale_fill_viridis_c(option = "magma")
ggplotly()
Output:
This is tricky. You need to assign the fill value after the stat is computed. You can do this by precalculating the hexbins that the stat is going to produce, and using hexTapply to get the average of z in each cell.
hb <- hexbin(x, y, bins = 30)
data.frame(x, y, z) %>%
ggplot(mapping = aes(x = x, y = y, weight = z)) +
geom_hex(aes(fill = after_stat(hexTapply(hb, z, mean))), bins = 30) +
scale_fill_viridis_c(option = "magma")
I want to summary table next to the scatterplot in the final figure. The summary table should come next to the plot. Here is the sample code.
How can we do that?
Thanks
library(tidyverse)
library(cowplot)
# data
x <- runif(10000)
y <- runif(10000)
z <- c(rep(0, 5000), rep(1, 5000))
tbl <- tibble(x, y, z)
# plot
scatterplot <- ggplot(tbl,
aes(x = x,
y = y)) +
geom_point(alpha = 0.7,
size = 2) +
facet_grid(. ~ z) +
theme_bw() +
theme(aspect.ratio = 1) +
ggtitle("Scatter plot")
# add summary table
summary_tbl <- tbl %>%
group_by(z) %>%
summarise(count = n(),
x_mean = mean(x),
y_mean = mean(y))
# TASK
# to create a final plot with scatterplot and summary table in single row grid
plot_grid(scatterplot, summary_tbl,
nol = 2)
I would suggest using patchwork:
library(tidyverse)
library(cowplot)
library(patchwork)
# data
x <- runif(10000)
y <- runif(10000)
z <- c(rep(0, 5000), rep(1, 5000))
tbl <- tibble(x, y, z)
# plot
scatterplot <- ggplot(tbl,
aes(x = x,
y = y)) +
geom_point(alpha = 0.7,
size = 2) +
facet_grid(. ~ z) +
theme_bw() +
theme(aspect.ratio = 1) +
ggtitle("Scatter plot")
# add summary table
summary_tbl <- tbl %>%
group_by(z) %>%
summarise(count = n(),
x_mean = mean(x),
y_mean = mean(y))
# TASK
G <- scatterplot + gridExtra::tableGrob(summary_tbl)
Output:
You can wrap your table using gridExtra::tableGrob()
Try this for colors and order:
# TASK 2
my_table_theme <- gridExtra::ttheme_default(core=list(bg_params = list(fill = 'white', col=NA)))
#Plot
G <- scatterplot / gridExtra::tableGrob(summary_tbl,
rows = NULL,theme=my_table_theme)
Output:
I have data where I think that y^2 ~ x.
So, I want to plot y as a function of x with some transformed scaled for y.
N <- 100
ggplot(data_frame(x = runif(N), y = 20 * sqrt(x) + rnorm(N)), aes(x, y)) +
geom_point()
+ scale_y_square??
You need to make a new transformation with scales::trans_new and to use it with coord_trans:
N <- 100
ggplot(data_frame(x = runif(N), y = 20 * sqrt(x) + rnorm(N)), aes(x, y)) +
geom_point() +
coord_trans(y = scales::trans_new("square", function(x) x^2, "sqrt"))
I created a plot with several geom_area according to the following code :
library(ggplot2)
set.seed(1)
dat <- data.frame(matrix(rnorm(100, 10, 2), 100, 1))
dat_density <- data.frame(density(dat[, 1])[c("x", "y")])
quant <- quantile(dat[, 1], probs = seq(0, 1, 0.10))
library(RColorBrewer)
color_pal <- brewer.pal(length(quant)-1, "RdYlBu")
dens <- ggplot(data = dat_density, aes(x = x, y = y)) +
geom_line(size = 2)
for(i in 1:(length(color_pal))){
dens <- dens +
geom_area(data = subset(dat_density, x > quant[[i]] & x < quant[[i + 1]]), fill = color_pal[i])
}
dens
How can I add a common legend with each color of the color_pal vector (corresponding to all the 10% area of data) ?
The easiest way is to define the groups in your dataset
dat_density$quant <- cut(dat_density$x, breaks = c(-Inf, quant, Inf))
ggplot(data = dat_density, aes(x = x, y = y, fill = quant)) +
geom_line(size = 2) +
geom_area() +
scale_fill_brewer(palette = "RdYlBu")