I have a dataframe like this:
set.seed(3467)
df<- data.frame(method= c(rep("A", 1000), rep("B", 1000), rep("C", 1000)),
beta=c(rnorm(1000, mean=0, sd=1),rnorm(1000, mean=2, sd=1.4),rnorm(1000, mean=0, sd=0.5)))
I wish to create a ridgeline plot similar to this:
library(ggplot2)
library(ggridges)
ggplot() +
geom_rect(data = data.frame(x = 1),
xmin = -0.391, xmax = 0.549, ymin = -Inf, ymax = Inf,
alpha = 0.5, fill = "gray") +
geom_density_ridges(data = df, aes(x = beta, y = method, color = method, fill = method),
size=0.75)+
xlim(-5,5)+
scale_fill_manual(values = c("#483d8b50", "#0072B250","#228b2250")) +
scale_color_manual(values = c("#483d8b", "#0072B2", "#228b22"), guide = "none") +
stat_density_ridges(data = df, aes(x = beta, y = method, color = method, fill = method),
quantile_lines = TRUE, quantiles = c(0.025, 0.5, 0.975), alpha = 0.6, size=0.75)+
scale_y_discrete(expand = expand_scale(add = c(0.1, 0.9)))
However, I wish to order the y-axis in the order of method= "B", "C", "A" not method= "A", "B", "C"
I have tried the following method, without success, to reorder the density plots:
library(dplyr)
df %>%
mutate(method = fct_relevel(method,
"B", "C", "A"))%>%
ggplot() +
geom_rect(data = data.frame(x = 1),
xmin = -0.391, xmax = 0.549, ymin = -Inf, ymax = Inf,
alpha = 0.5, fill = "gray") +
geom_density_ridges(data = df, aes(x = beta, y = method, color = method, fill = method),
size=0.75)+
xlim(-5,5)+
scale_fill_manual(values = c("#483d8b50", "#0072B250","#228b2250")) +
scale_color_manual(values = c("#483d8b", "#0072B2", "#228b22"), guide = "none") +
stat_density_ridges(data = df, aes(x = beta, y = method, color = method, fill = method),
quantile_lines = TRUE, quantiles = c(0.025, 0.5, 0.975), alpha = 0.6, size=0.75)+
scale_y_discrete(expand = expand_scale(add = c(0.1, 0.9)))
You were nearly there. - You need to specify the levels argument within fct_relevel. (See ?fct_relevel: there is no levels argument, but ..., you have to specify its name!)
library(tidyverse)
library(ggridges)
set.seed(3467)
df<- data.frame(method= c(rep("A", 1000), rep("B", 1000), rep("C", 1000)),
beta=c(rnorm(1000, mean=0, sd=1),rnorm(1000, mean=2, sd=1.4),rnorm(1000, mean=0, sd=0.5)))
# here is the main change:
df <- df %>%
mutate(method = fct_relevel(method, levels = "B", "C", "A"))
ggplot(df) +
geom_density_ridges(data = df, aes(x = beta, y = method, color = method, fill = method))
#> Picking joint bandwidth of 0.225
Created on 2020-02-17 by the reprex package (v0.3.0)
If you change the method column to ordered factor, it should work:
df$method <- factor(df$method, levels = c("C", "A", "B"), ordered = TRUE)
Related
First of all, some data similar to what I am working with.
rawdata <- data.frame(Score = rnorm(1000, seq(1, 0, length.out = 10), sd = 1),
Group = rep(LETTERS[1:3], 10000))
rawdata$Score <- ifelse(rawdata$Group == "A", rawdata$Score+2,rawdata$Score)
rawdata$Score <- ifelse(rawdata$Group == "C", rawdata$Score-2,rawdata$Score)
stdev <- c(10.78,10.51,9.42)
col <- c("#004d8d", "#cc2701", "#e5b400")
Now, the code of my geom_density_ridges with quantile lines, which in this case they will be white.
p <- ggplot(rawdata, aes(x = Score, y = Group)) +
scale_y_discrete() +
geom_rect(inherit.aes = FALSE, mapping = aes(ymin = 0, ymax = Inf, xmin = -0.1 * min(stdev), xmax = 0.1 * max(stdev)),
fill = "grey", alpha = 0.5) +
geom_density_ridges(scale = -0.5, size = 1, alpha=0.5, show.legend = FALSE,
quantile_lines = TRUE, quantiles = c(0.025, 0.975),
vline_color = "white", aes(fill = Group)) +
scale_color_manual(values = col) +
scale_fill_manual(values = col) +
labs(title="Toy Graph", y="Group", x="Value") +
coord_flip(xlim = c(-8, 8), ylim = NULL, expand = TRUE, clip = "on")
p
An we obtain the following plot, which is perfectly adjusted to expectation.
Now I was wondering if there was a way to make only this little white quantile line transparent to the background. I tried first to set the vline_color = "transparent" and leaving the aes(fill = Group) at the end of geom_density_ridges at the logic that options where drew in order but it gets transparent not to the different shades of grey background but to the density fill (so the quantile line disappears), which is not what I am trying to achieve.
Thanks in advance for your ideas!
Colors can be modified with scales::alpha. This can be passed to your color argument.
library(ggridges)
library(ggplot2)
rawdata <- data.frame(Score = rnorm(1000, seq(1, 0, length.out = 10), sd = 1),
Group = rep(LETTERS[1:3], 10000))
rawdata$Score <- ifelse(rawdata$Group == "A", rawdata$Score+2,rawdata$Score)
rawdata$Score <- ifelse(rawdata$Group == "C", rawdata$Score-2,rawdata$Score)
stdev <- c(10.78,10.51,9.42)
col <- c("#004d8d", "#cc2701", "#e5b400")
ggplot(rawdata, aes(x = Score, y = Group)) +
scale_y_discrete() +
geom_rect(inherit.aes = FALSE, mapping = aes(ymin = 0, ymax = Inf, xmin = -0.1 * min(stdev), xmax = 0.1 * max(stdev)),
fill = "grey", alpha = 0.5) +
geom_density_ridges(scale = -0.5, size = 1, alpha=0.5, show.legend = FALSE,
quantile_lines = TRUE, quantiles = c(0.025, 0.975),
### The only change is here
vline_color = alpha("white", .5), aes(fill = Group)) +
scale_color_manual(values = col) +
scale_fill_manual(values = col) +
labs(title="Toy Graph", y="Group", x="Value") +
coord_flip(xlim = c(-8, 8), ylim = NULL, expand = TRUE, clip = "on")
#> Picking joint bandwidth of 0.148
#> Warning: Using the `size` aesthietic with geom_segment was deprecated in ggplot2 3.4.0.
#> ℹ Please use the `linewidth` aesthetic instead.
Created on 2022-11-14 with reprex v2.0.2
No, if you make something transparent you will see what's underneath, which is the density plot.
However, you can replicate the visual effect of "seeing through to the background" by simply setting the line colour to the same as the background.
Your grey rectangle is currently plotted underneath the density plots, therefore the "background" doesn't have a single colour. This can be solved by plotting it on top instead. Instead of a 50% grey with 50% alpha, you can replicate the same effect with a 0% grey (aka black) with a 25% alpha. Move the geom_rect later than the density plots and it will be layered on top.
Finally, your geom_rect is being called once for each row of raw_data, since it inherits the same data as the main plot. You probably don't want that, so specify a (dummy) data source instead.
ggplot(rawdata, aes(x = Score, y = Group)) +
scale_y_discrete() +
geom_density_ridges(scale = -0.5, size = 1, alpha=0.5, show.legend = FALSE,
quantile_lines = TRUE, quantiles = c(0.025, 0.975),
vline_color = "grey90", aes(fill = Group)) +
scale_color_manual(values = col) +
scale_fill_manual(values = col) +
labs(title="Toy Graph", y="Group", x="Value") +
geom_rect(data=data.frame(), inherit.aes = FALSE, mapping = aes(
ymin = 0, ymax = Inf, xmin = -0.1 * min(stdev), xmax = 0.1 * max(stdev)
), fill = "black", alpha = 0.25) +
coord_flip(xlim = c(-8, 8), ylim = NULL, expand = TRUE, clip = "on")
Note: I'm not sure the background colour is really "grey90", I've eyeballed it. You may want to specify it explicitly with theme if you want to be exact.
If you want literal see-through portions of your density curves, you will need to make the gaps yourself:
library(tidyverse)
rawdata %>%
mutate(GroupNum = as.numeric(as.factor(Group))) %>%
group_by(GroupNum, Group) %>%
summarise(yval = first(GroupNum) - density(Score)$y,
xval = density(Score)$x,
q025 = quantile(Score, 0.025),
q975 = quantile(Score, 0.975)) %>%
mutate(Q = ifelse(xval < q025, 'low', ifelse(xval > q975, 'hi', 'mid'))) %>%
ggplot(aes(xval, yval, group = interaction(Group, Q))) +
geom_line(size = 1) +
geom_ribbon(aes(ymax = GroupNum, ymin = yval, fill = Group),
color = NA, alpha = 0.5, outline.type = 'full',
data = . %>% filter(abs(q025 - xval) > 0.03 &
abs(q975 - xval) > 0.03)) +
coord_flip() +
scale_fill_manual(values = col) +
scale_y_continuous(breaks = 1:3, labels = levels(factor(rawdata$Group)),
name = 'Group') +
labs(x = 'Score')
This question already has answers here:
Create a split violin plot with paired points and proper orientation
(2 answers)
Closed 10 months ago.
This post was edited and submitted for review 10 months ago and failed to reopen the post:
Original close reason(s) were not resolved
In this article: https://www.nature.com/articles/s41591-022-01744-z.epdf
I noticed an interesting plot:
2
Is there a simple way to do this in R?
EDIT: I am aware there are similar questions but none deal with the color-coding scheme that marks the improved / worsened cases.
The see package has a half violin geom like that:
ggplot(data = data.frame(id = rep(1:10, 2),
time = rep(c("A", "B"), each = 10),
value = runif(20)),
aes(time, value)) +
see::geom_violinhalf(aes(group = time, fill = time),
trim = FALSE, flip = 1, alpha = 0.2) +
geom_point(aes(color = time)) +
geom_line(aes(group = id))
You can get arbitrarily close to a chosen chart using ggplot:
ggplot(df, aes(xval, modularity, color = group)) +
geom_polygon(data = densdf, aes( x = y, y = x, fill = group), colour = NA) +
scale_fill_manual(values = c('#c2c2c2', '#fbc5b4')) +
scale_color_manual(values = c('#676767', '#ef453e')) +
geom_path(data = densdf, aes(x = y, y = x), size = 2) +
geom_segment(color = '#c2c2c2', inherit.aes = FALSE, size = 1.5,
data = df2[df2$`Post-treatment` > df2$Baseline,], alpha = 0.8,
aes(x = 1, xend = 2, y = Baseline, yend = `Post-treatment`)) +
geom_segment(color = '#ef453e', inherit.aes = FALSE, size = 1.5, alpha = 0.8,
data = df2[df2$`Post-treatment` < df2$Baseline,],
aes(x = 1, xend = 2, y = Baseline, yend = `Post-treatment`)) +
geom_point(size = 3) +
theme_classic() +
scale_x_continuous(breaks = 1:2, labels = c('Baseline', 'Post-treatment'),
name = '', expand = c(0.3, 0)) +
theme(legend.position = 'none',
text = element_text(size = 18, face = 2),
panel.background = element_rect(fill = NA, color = 'black', size = 1.5))
As long as you are prepared to do some work getting your data into the right format:
set.seed(4)
mod <- c(rnorm(16, 2.5, 0.25))
df <- data.frame(modularity = c(mod, mod + rnorm(16, -0.25, 0.2)),
xval = rep(c(1, 2), each = 16),
group = rep(c('Baseline', 'Post-treatment'), each = 16),
id = factor(rep(1:16, 2)))
df2 <- df %>% tidyr::pivot_wider(id_cols = id, names_from = group,
values_from = modularity)
BLdens <- as.data.frame(density(df$modularity[1:16])[c('x', 'y')])
PTdens <- as.data.frame(density(df$modularity[17:32])[c('x', 'y')])
BLdens$y <- 1 - 0.25 * BLdens$y
PTdens$y <- 2 + 0.25 * PTdens$y
densdf <- rbind(BLdens, PTdens)
densdf$group <- rep(c('Baseline', 'Post-treatment'), each = nrow(BLdens))
This question builds off of enter link description here but is in the context of faceted boxplots.
So, I have the following code:
set.seed(20210714)
dd <- data.frame(Method = rep(c("A", "B", "C"), each = 60), Pattern = rep(c("X", "Y", "Z"), times = 30), X1 = runif(180), Complexity = rep(c("High", "Low"), times = 90), nsim = rep(rep(1:10, times = 9), each = 2), n = 10)
dd1 <- data.frame(Method = rep(c("A", "B", "C"), each = 60), Pattern = rep(c("X", "Y", "Z"), times = 30), X1 = runif(180), Complexity = rep(c("High", "Low"), times = 90), nsim = rep(rep(1:10, times = 9), each = 2), n = 5)
dd <- rbind(dd, dd1)
library(ggplot2)
# create dummy dataframe.
dummy.df <- dd
dummy.df[nrow(dd) + 1:2,"Pattern"] <- unique(dd$Pattern)[-3]
dummy.df[nrow(dd) + 1:2,"Method"] <- "ZZZ"
dummy.df[nrow(dd) + 1:2,"Complexity"] <- c("High","Low")
dummy.df$dummy <- interaction(dummy.df$Method,dummy.df$Pattern)
ggplot(dummy.df, aes(x = dummy, y = X1, fill = Method)) +
geom_boxplot(aes(fill = Method)) +
facet_grid(~Complexity) +
theme_light() +
theme(legend.position = 'bottom') +
guides(fill = guide_legend(nrow=1)) +
geom_line(aes(x = dummy,
group=interaction(Pattern,nsim)),
size = 0.35, alpha = 0.35, colour = I("#525252")) +
geom_point(aes(x = dummy,
group=interaction(Pattern,nsim)),
size = 0.35, alpha = 0.25, colour = I("#525252")) +
scale_x_discrete(labels = c("","X", "", "", "", "Y", "", "", "", "Z","","")) +
xlab("Pattern") +
scale_fill_brewer(breaks=c("A", "B", "C"), type="qual", palette="Paired")
dummy.df <- dd
dummy.df[nrow(dd) + 1:2,"Pattern"] <- unique(dd$Pattern)[-3]
dummy.df[nrow(dd) + 1:2,"Method"] <- "ZZZ"
dummy.df[nrow(dd) + 1:2,"Complexity"] <- c("High","Low")
dummy.df$dummy <- interaction(dummy.df$Method,dummy.df$Pattern)
dummy.df$fill <- interaction(dummy.df$Method, dummy.df$n)
dummy.df$dummy <- interaction(dummy.df$fill, dummy.df$Pattern)
dummy.df$dummy <- factor(dummy.df$dummy, levels = levels(dummy.df$dummy)[-c(4, 12, 20, 24)])
dummy.df$dummy[361:362] <- "A.10.Z" ## dummy variables to get rid of NAs
theme_set(theme_bw(base_size = 14))
ggplot(dummy.df, aes(x = dummy, y = X1, fill = fill)) +
geom_boxplot(aes(fill = fill),lwd=0.1,outlier.size = 0.01) +
facet_grid(~Complexity) +
theme(legend.position = 'bottom') +
guides(fill = guide_legend(nrow=1)) +
geom_line(aes(x = dummy,
group=interaction(Pattern,nsim,n)),
size = 0.35, alpha = 0.35, colour = I("#525252")) +
geom_point(aes(x = dummy,
group=interaction(Pattern,nsim,n)),
size = 0.35, alpha = 0.25, colour = I("#525252")) +
scale_x_discrete(labels = c("X", "Y", "Z"), breaks = paste("A.10.", c("X", "Y", "Z"), sep = ""),drop=FALSE) +
xlab("Pattern") +
scale_fill_brewer(breaks= levels(dummy.df$fill)[-c(4,8)], type="qual", palette="Paired")
This yields the following plot.
All is well, except with the legend. I would like the following: the dark colors to be in the First group titled "n=5" on the left, with "A", "B", "C" for the three dark colors, and the light colors to be to the right, in a Second group titled "n=10" on the right, with "A", "B", "C" for the three light colors. Sort of like in the link enter link description here above.
What I can not figure out is how to call the boxplot twice to mimic the solution there.
Is there a way to do this? Please feel free to let me know if the question is not clear.
Thanks again, in advance, for any help!
Adapting my answer on your former question this could be achieved like so:
library(ggplot2)
fill <- levels(dummy.df$fill)[-c(4,8)]
fill <- sort(fill)
labels <- gsub("\\.\\d+", "", fill)
labels <- setNames(labels, fill)
colors <- scales::brewer_pal(type="qual", palette="Paired")(6)
colors <- setNames(colors, fill)
library(ggnewscale)
ggplot(dummy.df, aes(x = dummy, y = X1, fill = fill)) +
geom_boxplot(aes(fill = fill), lwd=0.1,outlier.size = 0.01) +
scale_fill_manual(name = "n = 5", breaks= fill[grepl("5$", fill)], labels = labels[grepl("5$", fill)], values = colors,
guide = guide_legend(title.position = "left", order = 1)) +
new_scale_fill() +
geom_boxplot(aes(fill = fill), lwd=0.1,outlier.size = 0.01) +
scale_fill_manual(name = "n = 10", breaks = fill[grepl("10$", fill)], labels = labels[grepl("10$", fill)], values = colors,
guide = guide_legend(title.position = "left", order = 2)) +
facet_grid(~Complexity) +
theme(legend.position = 'bottom') +
guides(fill = guide_legend(nrow=1)) +
geom_line(aes(x = dummy,
group=interaction(Pattern,nsim,n)),
size = 0.35, alpha = 0.35, colour = I("#525252")) +
geom_point(aes(x = dummy,
group=interaction(Pattern,nsim,n)),
size = 0.35, alpha = 0.25, colour = I("#525252")) +
scale_x_discrete(labels = c("X", "Y", "Z"), breaks = paste("A.10.", c("X", "Y", "Z"), sep = ""),drop=FALSE) +
xlab("Pattern")
#> Warning: Removed 2 rows containing non-finite values (new_stat_boxplot).
I am trying to automate the process of plotting data using ggplot and the facet_wrap functionality. I want a single y-axis label instead individual plot Ob (i.e., A_Ob, B_ob etc) and also a single X-axis not all the plots having label for x-axis such as below. Below is my sample code using gridextra package. However, i would like to do it through facet_wrap as i have many other plots to draw which i think will save me sometime.
graphics.off()
rm(list = ls())
library(tidyverse)
library(gridExtra)
G1 = data.frame(A_Ob = runif(1000, 5, 50), A_Sim = runif(1000, 3,60), A_upper = runif(1000, 10,70), A_lower = runif(1000, 0, 45 ),
B_Ob = runif(1000, 5, 50), B_Sim = runif(1000, 3,60), B_upper = runif(1000, 10,70), B_lower = runif(1000, 0, 45 ),
C_Ob = runif(1000, 5, 50), C_Sim = runif(1000, 3,60), C_upper = runif(1000, 10,70), C_lower = runif(1000, 0, 45 ),
D_Ob = runif(1000, 5, 50), D_Sim = runif(1000, 3,60), D_upper = runif(1000, 10,70), D_lower = runif(1000, 0, 45 ),
Pos = 1:1000)
A1 = ggplot(data = G1, aes(x = Pos))+
geom_line(aes(y = A_Ob), col = "black")+
geom_line(aes(y = A_Sim), col = "blue")+
geom_vline(xintercept = 750, color = "red", size=1.5)+
geom_ribbon(aes(ymin = A_upper, ymax = A_lower), fill = "grey70")
B1 = ggplot(data = G1, aes(x = Pos))+
geom_line(aes(y = B_Ob), col = "black")+
geom_line(aes(y = B_Sim), col = "blue")+
geom_vline(xintercept = 750, color = "red", size=1.5)+
geom_ribbon(aes(ymin = B_upper, ymax = B_lower), fill = "grey70")
C1 = ggplot(data = G1, aes(x = Pos))+
geom_line(aes(y = C_Ob), col = "black")+
geom_line(aes(y = C_Sim), col = "blue")+
geom_vline(xintercept = 750, color = "red", size=1.5)+
geom_ribbon(aes(ymin = C_upper, ymax = C_lower), fill = "grey70")
D1 = ggplot(data = G1, aes(x = Pos))+
geom_line(aes(y = D_Ob), col = "black")+
geom_line(aes(y = D_Sim), col = "blue")+
geom_vline(xintercept = 750, color = "red", size=1.5)+
geom_ribbon(aes(ymin = D_upper, ymax = D_lower), fill = "grey70")
grid.arrange(A1,B1,C1,D1, nrow = 4)
Here is the result of the code
You need to reshape your dataframe into a longer format and separate values for Ob, Sim, upper and lower.
Using the function melt from data.table package can help you to achieve this:
library(data.table)
setDT(G1)
Ob_cols = grep("_Ob",colnames(G1),value = TRUE)
Sim_cols = grep("_Sim",colnames(G1),value = TRUE)
Upper_cols = grep("_upper",colnames(G1), value = TRUE)
Lower_cols = grep("_lower", colnames(G1), value = TRUE)
g.m <- melt(G1, measure = list(Ob_cols,Sim_cols,Upper_cols,Lower_cols), value.name = c("OBS","SIM","UP","LOW"))
levels(g.m$variable) <- c("A","B","C","D")
Pos variable OBS SIM UP LOW
1: 1 A 5.965488 29.167666 26.66783 29.97259
2: 2 A 23.855719 8.570245 43.75830 30.65616
3: 3 A 16.947887 51.201047 15.20758 39.76122
4: 4 A 49.883306 3.715319 34.38066 20.73177
5: 5 A 5.021938 3.102880 30.05036 32.05123
6: 6 A 19.887176 15.400853 53.67156 28.54982
and now, you can plot it:
library(ggplot2)
ggplot(g.m, aes(x = Pos))+
geom_line(aes(y = OBS), color = "black")+
geom_line(aes(y = SIM), color = "blue")+
geom_vline(xintercept = 750,color = "red", size = 1.5)+
geom_ribbon(aes(ymin = UP, ymax = LOW), fill = "grey70")+
facet_grid(variable~.)
EDIT: Adding annotations & renaming labels
To rename and replace facet labels, you can re-define levels of variable and use facet_wrap instead of facet_grid using ncol = 1 as argument.
To add multiple annotations on a single panel, you need to define a dataframe that you will use in geom_text.
Altogether, you have to do:
# renaming names of each facets:
levels(g.m$variable) <- c("M1","M2","M3","M4")
# Defining annotations to add:
df_text <- data.frame(label = c("Calibration", "Validation"),
x = c(740,760),
y = c(65,65),
hjust = c(1,0),
variable = factor("M1", levels = c("M1","M2","M3","M4")))
# Plotting
ggplot(g.m, aes(x = Pos))+
geom_line(aes(y = OBS), color = "black")+
geom_line(aes(y = SIM), color = "blue")+
geom_vline(xintercept = 750,color = "red", size = 1.5)+
geom_ribbon(aes(ymin = UP, ymax = LOW), fill = "grey70")+
facet_wrap(variable~., ncol = 1)+
theme(strip.text.x = element_text(hjust = 0),
strip.background = element_rect(fill = "white"))+
geom_text(data = df_text, aes(x = x, y = y, label = label, hjust = hjust), color = "red")
Does it look what you are expecting ?
I read in this stack overflow question a clever way to simulate setting an aesthetic to panel background using geom_rect.
Conditionally change panel background with facet_grid?
Unfortunately, it doesn't work if you want to put other colors in the plot. The colors mix and the legend gets polluted. Instead, I would prefer that the color only applies to the background and doesn't get mixed. My other question is: is there an approach that would work in polar coordinates?
For a reproducible example, see the code below:
pies <- data_frame(pie = c(rep("hawaiian", 3), rep("pepperoni", 2)),
fraction = c(c(0.3, 0.2, 0.5), c(0.4, 0.6)),
ingredient = c("cheese", "pineapple", "ham",
"peperroni", "cheese"),
deepdish = c(rep(TRUE, 3), rep(FALSE, 2)))
p <- pies %>%
ggplot() +
geom_bar(aes(x = factor(1),
y = fraction,
fill = ingredient),
width = 0.6,
stat = "identity",
position = "fill") +
facet_wrap(~ pie) +
geom_rect(mapping = aes(fill = deepdish),
alpha = 0.1,
xmin = -Inf, xmax = Inf,
ymin=-Inf, ymax=Inf,
show.legend = FALSE)
p
p + coord_polar(theta = "y")
pies <- data_frame(pie = c(rep("hawaiian", 3), rep("pepperoni", 2)),
fraction = c(c(0.3, 0.2, 0.5), c(0.4, 0.6)),
ingredient = c("cheese", "pineapple", "ham",
"peperroni", "cheese"),
deepdish = c(rep(TRUE, 3), rep(FALSE, 2)))
library(ggplot2)
library(dplyr)
p <- pies %>%
ggplot() +
geom_bar(aes(x = factor(1), y = fraction, fill = ingredient),
width = 0.6, stat = "identity", position = "fill") +
facet_wrap(~ pie) + coord_polar(theta = "y")
g <- ggplotGrob(p)
# Set manually the background color for each panel
g$grobs[[2]]$children[[1]]$children[[1]]$gp$fill <- "#88334466"
g$grobs[[3]]$children[[1]]$children[[1]]$gp$fill <- "#44338866"
library(grid)
grid.draw(g)
library(egg)
library(grid)
pies <- data.frame(pie = c(rep("hawaiian", 3), rep("pepperoni", 2)),
fraction = c(c(0.3, 0.2, 0.5), c(0.4, 0.6)),
ingredient = c("cheese", "pineapple", "ham",
"peperroni", "cheese"))
dummy <- data.frame(x = 0, y = 0,
pie = c("hawaiian","pepperoni"),
deepdish = c("green","yellow"), stringsAsFactors = FALSE)
p <- ggplot(pies) +
facet_wrap(~ pie) +
geom_custom(data= dummy, mapping = aes(x = factor(0),
y = y,
data = deepdish),
grob_fun = function(x) rectGrob(gp=gpar(fill=x,col=NA)), inherit.aes = TRUE) +
geom_bar(aes(x = factor(1),
y = fraction,
fill = ingredient),
width = 0.6,
stat = "identity",
position = "fill")
p + coord_polar(theta = "y")