I have 2 ggplots generated by below codes
library(dplyr)
library(ggplot2)
library(ggdist)
set.seed(1)
DF1 = rbind(data.frame('Label' = 'A', val = rnorm(200, 5)), data.frame('Label' = 'B', val = rnorm(500, 10)))
DF2 = rbind(data.frame('Label' = 'A', val = rt(200, 2)), data.frame('Label' = 'B', val = rt(700, 3)))
Plot1 = ggplot(DF1, aes(x = Label, y = val, fill = 'red')) + stat_dotsinterval(position = 'dodge')
Plot2 = ggplot(DF2, aes(x = Label, y = val, fill = 'green')) + stat_dotsinterval(position = 'dodge')
Plot1
Plot2
Those are individual plots, however I want to combine them into just one ggplot with appropriate legend.
Is there any way to do this for above case?
Any pointer will be highly appreciated.
Similar to eipi10's comment:
library(dplyr); library(ggplot2)
bind_rows(DF1, DF2, .id = "src") %>%
mutate(name = if_else(src == "1", "red", "green")) %>%
ggplot(aes(x=Label, y=val, colour=name, fill=name)) +
stat_dotsinterval() +
scale_color_identity(aesthetics = c("fill", "color"), guide = "legend") +
theme(legend.position = "top")
Related
I have the following data:
library(ggplot2)
library(gganimate)
library(tidyverse)
createData<- function(vintage, id){#create data
# Generate a sequence of dates from 2010-01-01 to 2025-12-31 with a quarterly frequency
Dates <- seq(from = as.Date("2010-01-01"), to = as.Date("2025-12-31"), by = "quarter")
RLG<- cumsum(sample(c(-1, 1), 64, TRUE))
df<- data.frame( Dates,RLG, vintage,id)
return(df)
}
#createData
df<- createData("2018-01-01",1) %>%
rbind(createData("2019-01-01",2))%>%
rbind(createData("2020-01-01",3)) %>%
rbind(createData("2021-01-01",4))%>%
rbind(createData("2022-01-01",5))%>%
rbind(createData("2023-01-01",6))%>%
rbind(createData("2024-01-01",7))%>%
rbind(createData("2025-01-01",8))
Which I use to make the following chart:
options(gganimate.nframes = 8*length(unique(df$vintage)), gganimate.res = 30)
p<- ggplot(df) +
aes(x = Dates, y = RLG, group = as.Date(vintage), colour = "RLG") +
geom_line()+
scale_y_continuous(labels = \(x) paste0(x, "%"))+
theme(axis.title = element_blank(),legend.position="none")+
transition_time(id)+
exit_fade(alpha = 0.5)+
shadow_mark(alpha = 0.2)
animate(p, end_pause = 30)
I would like to add a geom_rect which goes from vintage to max(Dates). At each frame, vintage will increase, so the geom_rect will shrink slightly. How can I do this without interfering with the shadow_mark and exit_fades which I am applying to the lines?
If you mean something like a progress bar you could do it like so:
create an DF for the geom which is a subset of the original
df_geom <- df |>
mutate(vintage = as.Date(vintage)) |>
group_by(id) |>
slice(n())
Use geom_segment with the DF from above.
If you want to leave shadow_mark in you can do shadow_mark(exclude_layer = 2).
p <- ggplot(df) +
aes(x = Dates, y = RLG, group = as.Date(vintage), colour = RLG) +
geom_line()+
scale_y_continuous(labels = \(x) paste0(x, "%"))+
theme(axis.title = element_blank(),legend.position="none") +
geom_segment(
data = df_geom,
mapping = aes(x=vintage, xend=Dates,
y = 18, yend = 18),
size = 10, alpha =.4, color ='lightblue'
) +
transition_time(id)+
exit_fade(alpha = 0.5)
# shadow_mark(alpha = 0.2)
animate(p)
I'm trying to combine two heatmaps. I want var_a and var_x on the y axis with for example: var_a first and then var_x. I don't know if I should do this by changing the dataframe or combining them, or if I can do this in ggplot.
Below I have some example code and a drawing of what I want (since I don't know if I explained it right).
I hope someone has ideas how I can do this either in the dataframe or in ggplot!
Example code:
df_one <- data.frame(
vars = c("var_a", "var_b", "var_c"),
corresponding_vars = c("var_x", "var_y", "var_z"),
expression_organ_1_vars = c(5, 10, 20),
expression_organ_2_vars = c(50, 2, 10),
expression_organ_3_vars = c(5, 10, 3)
)
df_one_long <- pivot_longer(df_one,
cols=3:5,
names_to = "tissueType",
values_to = "Expression")
expression.df_one <- ggplot(df_one_long,
mapping = aes(y=tissueType, x=vars, fill = Expression)) +
geom_tile()
expression.df_one
df_two <- data.frame(
corresponding_vars = c("var_x", "var_y", "var_z"),
expression_organ_1_corresponding_vars = c(100, 320, 120),
expression_organ_2_corresponding_vars = c(23, 30, 150),
expression_organ_3_corresponding_vars = c(89, 7, 200)
)
df_two_long <- pivot_longer(df_one,
cols=3:5,
names_to = "tissueType",
values_to = "Expression")
expression.df_two <- ggplot(df_two_long,
mapping = aes(y=tissueType, x=vars, fill = Expression)) +
geom_tile()
expression.df_two
Drawing:
You can bind your data frames together and pivot into a longer format so that vars and corresponding vars are in the same column, but retain a grouping variable to facet by:
df_two %>%
mutate(cor = corresponding_vars) %>%
rename_with(~sub('corresponding_', '', .x)) %>%
bind_rows(df_one %>% rename(cor = corresponding_vars)) %>%
pivot_longer(contains('expression'), names_to = 'organ') %>%
mutate(organ = gsub('expression_|_vars', '', organ)) %>%
group_by(cor) %>%
summarize(vars = vars, organ = organ, value = value,
cor = paste(sort(unique(vars)), collapse = ' cor ')) %>%
ggplot(aes(vars, organ, fill = value)) +
geom_tile(color = 'white', linewidth = 1) +
facet_grid(.~cor, scales = 'free_x', switch = 'x') +
scale_fill_viridis_c() +
coord_cartesian(clip = 'off') +
scale_x_discrete(expand = c(0, 0)) +
theme_minimal(base_size = 16) +
theme(strip.placement = 'outside',
axis.text.x = element_blank(),
axis.ticks.x.bottom = element_line(),
panel.spacing.x = unit(3, 'mm'))
Okay, so I solved the issue for my own project, which is to convert it to a scatter plot. I combined both datasets and then used a simple scatterplot.
df.combined <- dplyr::full_join(df_two_long, df_one_long,
by = c("vars", "corresponding_vars", "tissueType"))
ggplot(df.combined,
aes(x=vars, y=tissueType, colour=Expression.x, size = Expression.y)) +
geom_point()
It's not a solution with heatmaps, but I don't know how to do that at the moment.
I have below ggplot:
library(ggplot2)
data = rbind(data.frame('val' = c(10, 30, 15), 'name' = c('A', 'B', 'C'), group = 'gr1'), data.frame('val' = c(30, 40, 12), 'name' = c('A', 'B', 'C'), group = 'gr2'))
ggplot(data, # Draw barplot with grouping & stacking
aes(x = group,
y = val,
fill = name)) +
geom_bar(stat = "identity",
position = "stack", width = .1)
With this, I am getting below plot
However, I want to connect these bars with a curved area where the area would be equal to the value of the corresponding bar-component. A close example could be like,
Is there any way to achieve this with ggplot?
Any pointer will be very helpful.
This is something like an alluvial plot. There are various extension packages that could help you create such a plot, but it is possible to do it in ggplot directly using a bit of data manipulation.
library(tidyverse)
alluvia <- data %>%
group_by(name) %>%
summarize(x = seq(1, 2, 0.01),
val = pnorm(x, 1.5, 0.15) * diff(val) + first(val))
ggplot(data,
aes(x = as.numeric(factor(group)),
y = val,
fill = name)) +
geom_bar(stat = "identity",
position = "stack", width = .1) +
geom_area(data = alluvia, aes(x = x), position = "stack", alpha = 0.5) +
scale_x_continuous(breaks = 1:2, labels = levels(factor(data$group)),
name = "Group", expand = c(0.25, 0.25)) +
scale_fill_brewer(palette = "Set2") +
theme_light(base_size = 20)
EDIT
A more generalized solution for more than 2 groups would be
library(tidyverse)
alluvia <- data %>%
mutate(group = as.numeric(factor(group)),
name = factor(name)) %>%
arrange(group) %>%
group_by(name) %>%
mutate(next_group = lead(group),
next_val = lead(val)) %>%
filter(!is.na(next_val)) %>%
group_by(name, group) %>%
summarise(x = seq(group + 0.01, next_group - 0.01, 0.01),
val = (next_val - val) * pnorm(x, group + 0.5, 0.15) + val)
ggplot(data,
aes(x = as.numeric(factor(group)),
y = val,
fill = name)) +
geom_bar(stat = "identity",
position = "stack", width = .1) +
geom_area(data = alluvia, aes(x = x), position = "stack", alpha = 0.5) +
scale_x_continuous(breaks = seq(length(unique(data$group))),
labels = levels(factor(data$group)),
name = "Group", expand = c(0.25, 0.25)) +
scale_fill_brewer(palette = "Set2") +
theme_light(base_size = 20)
I am trying to achieve the attached hand drawn figure using the code below but its showing white spaces for all the years that i do not have data for. Any help would be appreciated.
library(lubridate)
library(tidyverse)
set.seed(123)
D1 <- data.frame(Date = seq(as.Date("2001-07-14"), to= as.Date("2001-07-21"), by="day"),
A = runif(8, 0,10),
D = runif(8,5,15)) %>%
gather(-Date, key = "Variable", value = "Value")
D2 <- data.frame(Date = seq(as.Date("1998-07-14"), to= as.Date("1998-08-30"), by="day"),
A = runif(48, 0,10),
D = runif(48,5,15)) %>%
gather(-Date, key = "Variable", value = "Value")
D <- bind_rows(D1,D2) %>% mutate(Year = year(Date))
my_linetype <- setNames(c("dashed", "solid"), unique(D$Year))
ggplot(data = D, aes(x = Date, y = Value, color = as.factor(Year), linetype = as.factor(Year)))+
geom_line(size = 1.1)+ facet_wrap(~Variable, scales = "free_y", nrow=2)
Desired Out
You can make a dummy Date variable in your data.frame where the year is equal among different groups. In the example below this added in the mutate() statement under the Unyear variable.
D <- bind_rows(D1,D2) %>% mutate(Year = year(Date),
Unyear = {year(Date) <- 0; Date})
my_linetype <- setNames(c("dashed", "solid"), unique(D$Year))
ggplot(data = D, aes(x = Unyear, y = Value, color = as.factor(Year), linetype = as.factor(Year)))+
geom_line(size = 1.1)+ facet_wrap(~Variable, scales = "free_y", nrow=2)
Consider this simple example
library(lubridate)
library(lattice)
library(latticeExtra)
library(tibble)
library(dplyr)
mydf <- tibble(time = c(ymd('2019-01-01'),
ymd('2019-01-02'),
ymd('2019-01-03'),
ymd('2019-01-04'),
ymd('2019-01-05')),
var1 = c(2,2,2,2,1),
var2 = c(2,1,1,4,5),
var3 = c(200, 200, 400, 500, 230))
Now this works
p1 <- mydf %>%
barchart(var1 + var2 ~ time,
data = .,
stack = TRUE,
horiz = FALSE,
par.settings = simpleTheme(col = c('red', 'blue'),
fill = c('red', 'blue'),
alpha = c(0.2)),
auto.key = TRUE)
and this works as well
p2 <- mydf %>%
xyplot(var3 ~ time, data = ., type = 'l')
However, combining them with latticeExtra::doubleYscale() does not work. The line is invisible (see below)
latticeExtra::doubleYScale(p1, p2, use.style = FALSE)
Strangely enough, the dual y scale is there, but the line is missing. Any ideas?
Thanks!!
I simplified your data a bit.
Using as.layer (also from latticeExtra) rather than doubleYScale:
library(lattice)
library(latticeExtra)
mydf <- data.frame(t=1:5,x=c(2,2,2,2,1),
y=c(2,1,1,4,5),z=c(200,200,400,500,230))
p1 <- barchart(x+y~t,mydf,stack=TRUE,horiz=FALSE,
par.settings = simpleTheme(col = c('red', 'blue'),
fill = c('red', 'blue'),
alpha = c(0.2)),
auto.key = TRUE)
p2 <- xyplot(z~t,mydf,type="l")
p1+as.layer(p2,x.same=TRUE,y.same=FALSE,outside=TRUE)
I trust it also works with lubridated objects and tibbles.
EDIT: to clarify as.layer is also in latticeExtra package and add the plot.
Using ggplot2, you could do:
library(tidyr)
library(ggplot2)
df1 <- mydf %>%
select(-var3) %>%
pivot_longer(
cols = c(var1, var2),
names_to = "type",
values_to = "value"
)
df2 <- mydf %>%
select(time, var3)
ggplot(df1) +
geom_col(aes(x = time, y = value, fill = type)) +
geom_line(data = df2, aes(x = time, y = var3/100), size = 2) +
ylab("var1, var2") +
scale_y_continuous(sec.axis = sec_axis(~.*100, name = "var3"))