Combined geom_bar and geom_point legend in ggplotly - r

I am trying to get a combined bar + point chart with a legend for both bars different Indicators) and points (a change in the Indicator). I tried to follow along with ggplot2 legend for plot combining geom_bar and geom_point and introduced a shape into my geom_point (without doing that I could not get a legend for points).
library(ggplot2)
library(dplyr)
library(ggthemes)
library(plotly)
set.seed(369)
obs <- 6
values1 <- c(round(100 + rnorm(obs) * 10, 2))
values2 <- c(round(100 + rnorm(obs) * 10, 2))
df <- data.frame(Year = rep(2014:2019, 2*2),
value = c(rep(values1, 2), rep(values2, 2)),
Indicator = rep(c("Indicator1", "Indicator2"), each = obs * 2),
Type = rep(c("Bar", "Point"), each = obs))
p <- ggplot(df, aes(value))
bars <- df %>%
filter(Type == "Bar")
points <- df %>%
filter(Type == "Point")
pl <- p +
geom_bar(data = bars,
aes(fill = Indicator, group = Indicator, x = Year, y = value), stat = "identity", position = "dodge") +
geom_point(data = points, aes(x = Year, y = value, group = Indicator, fill = Indicator, shape = "Change"), position = position_dodge(width = 0.9)) +
theme_tufte()
p
ggplotly(pl, tooltip = c("value"))
ggplotly has the output I want, however the legend has a strange grouping. Is there a way to fix the legend in the chart below?

there's probably a better way, but how's this:
library(tidyverse)
obs <- 6
values1 <- c(round(100 + rnorm(obs) * 10, 2))
values2 <- c(round(100 + rnorm(obs) * 10, 2))
df <- data.frame(Year = rep(2014:2019, 2*2),
value = c(rep(values1, 2), rep(values2, 2)),
Indicator = rep(c("Indicator1", "Indicator2"), each = obs * 2),
Type = rep(c("Bar", "Point"), each = obs))
bars <- df %>% filter(Type == "Bar")
points <- df %>% filter(Type == "Point") %>% mutate(Year =
ifelse(Indicator == "Indicator1", Year - 0.25, Year + 0.25))
p <- ggplot(bars, aes(fill = Indicator, group = Indicator, x = Year, y = value)) +
geom_bar(stat = "identity", position = "dodge", width = 1)
p <- p + geom_point(data = points, mapping = aes(fill = Indicator, x =
Year, y = value), shape = 21) + labs(x = "value") + labs(y = "value")
p

I don't know ggplotly() , but building separate geom_bar() and geom_point() plots, and then using get_legend() to remove each legend, and then building them back with plot_grid with the full plot seems a decent option.
library(tidyverse)
obs <- 6
values1 <- c(round(100 + rnorm(obs) * 10, 2))
values2 <- c(round(100 + rnorm(obs) * 10, 2))
df <- data.frame(Year = rep(2014:2019, 2*2),
value = c(rep(values1, 2), rep(values2, 2)),
Indicator = rep(c("Indicator1", "Indicator2"), each = obs * 2),
Type = rep(c("Bar", "Point"), each = obs))
bars <- df %>% filter(Type == "Bar")
points <- df %>% filter(Type == "Point") %>% mutate(Year =
ifelse(Indicator == "Indicator1", Year - 0.25, Year + 0.25),
IndicatorChange = Indicator)
p1 <- ggplot(points, mapping = aes(fill = IndicatorChange, x = Year, y = value )) + labs(x = "value") + labs(y = "value") +
geom_point(shape = 21)
p1_leg <- get_legend(p1)
p2 <- ggplot(bars, aes(fill = Indicator, group = Indicator, x = Year, y = value)) +
geom_bar(stat = "identity", position = "dodge")
p2_leg <- get_legend(p2)
p_leg <- plot_grid(p1_leg, p2_leg, ncol = 1, nrow = 5) #toggle nrow to get right spacing between legends
p3 <-ggplot(bars, aes(fill = Indicator, group = Indicator, x = Year, y = value)) + geom_bar(stat = "identity", position = "dodge", width = 1)
p3 <- p3 + geom_point(data = points, mapping = aes(fill = Indicator, x = Year, y = value), shape = 21) +
labs(x = "value") + labs(y = "value")
p3 <- p3 + theme(legend.position="none")
p3
p <- plot_grid(p3, p_leg, ncol =2, nrow =2) #more toggling possible
p

I don't know whether this is what you want(although the font size of the legend should be modified):
library(ggplot2)
library(dplyr)
library(ggthemes)
library(plotly)
set.seed(369)
obs <- 6
values1 <- c(round(100 + rnorm(obs) * 10, 2))
values2 <- c(round(100 + rnorm(obs) * 10, 2))
df <- data.frame(Year = rep(2014:2019, 2*2),
value = c(rep(values1, 2), rep(values2, 2)),
Indicator = rep(c("Indicator1", "Indicator2"), each = obs * 2),
Type = rep(c("Bar", "Point"), each = obs))
p <- ggplot(df, aes(value))
bars <- df %>%
filter(Type == "Bar")
points <- df %>%
filter(Type == "Point")
points$Type1=paste(points$Indicator,"change",sep=",")
pl <- p +
geom_bar(data = bars,
aes(fill = Indicator, group = Indicator, x = Year, y = value), stat = "identity", position = "dodge") +
geom_point(data = points,
aes(x = Year, y = value, group = Indicator, fill = Indicator, shape = "Change"),
position = position_dodge(width = 0.9)) +
theme_tufte()+
theme(legend.position="bottom")
pl <- p +
geom_bar(data = bars,
aes(fill = Indicator, group = Indicator,x = Year, y = value), stat = "identity", position = "dodge") +
geom_point(data = points,
aes(x = Year, y = value,shape = Type1),
position = position_dodge(width = 0.9)) +
theme_tufte()+
theme(legend.position="bottom",
legend.title=element_blank())
p

Related

How to put two mean plots on a single plane with different scale?

I obtained the two separate mean plots. Is there any simple way to combine them on a single plane with different line colours? Tricky part is each has a different scale, so I want to put one (lshare) scale on left hand side of y-axis and the other (va) on right side of y-axis.
p1 <- ggplot(df, aes(x = year, y = lshare)) + stat_summary(geom = "line", fun.y = mean)
p2 <- ggplot(df, aes(x = year, y = va)) + stat_summary(geom = "line", fun.y = mean)
grid.arrange(p1, p2, ncol = 2)
Update2:
Combining all:
library(tidyverse)
mtcars %>%
select(mpg, disp) %>%
mutate(year = 1900:1931) %>%
pivot_longer(
c(mpg, disp)
) %>%
ggplot(aes(x=year, y=value, group=name, color=name))+
stat_summary(fun =mean, geom="line", size=1) +
scale_y_continuous(
name = "my first y axis",
sec.axis = sec_axis(~./10, name="my second y axis")
)
Update: How to add secodn y axis as requested:
library(tidyverse)
mtcars %>%
select(mpg, disp) %>%
mutate(year = 1900:1931) %>%
ggplot(aes(x=year))+
geom_line(aes(y=mpg*10), size=1, color="red")+
geom_line(aes(y=disp), size=1, color="blue") +
scale_y_continuous(
name = "my first y axis",
sec.axis = sec_axis(~./10, name="my second y axis")
)
First answer:
Here is a reproducible example with the mtcars dataset:
library(tidyverse)
mtcars %>%
select(mpg, disp) %>%
mutate(year = 1900:1931) %>%
pivot_longer(
c(mpg, disp)
) %>%
ggplot(aes(x=year, y=value, group=name, color=name))+
stat_summary(fun =mean, geom="line", size=1)
As #jdobres commented, you can use facet_wrap(), like in the following example. Simply introduce a grouping factor to your data.frame.
set.seed(1)
# sample data
year <- 1:20
lshare <- 0.50 - 0.02 * year + rnorm(length(year), sd = 3)
df <- data.frame(year = c(year, year), lshare = c(lshare, lshare))
df$group <- factor(gl(2, length(year)))
# plot
ggplot(df, aes(x = year, y = lshare, colour = group)) +
stat_summary(geom = "line", fun.y = mean, size = 1) +
facet_wrap(~ group)
Addition
As per your edit, which I saw after I posted this answer, facet_wrap() also works when you want to have two different y-axes. You just have to play a bit with the function that is specified within sec_axis().
set.seed(1)
# sample data
year <- 1:20
lshare <- 0.50 - 0.02 * year + rnorm(length(year), sd = 3)
noise <- abs(rnorm(length(lshare), mean = 150, sd = 100))
df <- data.frame(year = c(year, year), lshare = c(lshare, lshare + noise))
df$group <- factor(gl(2, length(year)))
# set two limits
ylim_left <- with(subset(df, group == 1), c(min(lshare), max(lshare)))
ylim_right <- with(subset(df, group == 2), c(min(lshare), max(lshare)))
axis_right <- diff(ylim_left)/diff(ylim_right)
axis_left <- ylim_left[1] - axis_right * ylim_right[1]
# plot
ggplot(df, aes(x = year, y = lshare, colour = group)) +
stat_summary(geom = "line", fun = mean, size = 1) +
facet_wrap(~ group) +
scale_y_continuous(sec.axis = sec_axis(~ (. - axis_left)/axis_right))
Addition 2
If you would like to have the two lines in the same pane, you can use something along the following lines of code. Note, I use the same data as in the first addition (see above).
# set two limits
ylim_left <- with(subset(df, group == 1), c(min(lshare), max(lshare)))
ylim_right <- with(subset(df, group == 2), c(min(lshare), max(lshare)))
axis_right <- diff(ylim_left)/diff(ylim_right)
axis_left <- ylim_left[1] - axis_right * ylim_right[1]
# plot
ggplot(df, aes(colour = group)) +
stat_summary(data = subset(df, group == 1),
mapping = aes(x = year, y = lshare),
geom = "line", fun = mean, size = 1) +
stat_summary(data = subset(df, group == 2),
mapping = aes(x = year, y = lshare),
geom = "line", fun = mean, size = 1) +
scale_y_continuous(sec.axis = sec_axis(~ (. - axis_left)/axis_right)) +
scale_colour_manual(name = 'My_groups',
values = c('1' = "blue4", '2' = "darkorange"),
labels = c('Group 1', 'Group 2'))

R: show values in geom_bar(position = 'fill')

I have the following fake data:
n <- 100
set.seed(1)
df <- data.frame(grp = sample(c("A", "B", "C"), size = n, replace = TRUE),
values = sample(1:10, n, replace = TRUE) )
df
My goal is to have a "filled" barplot as follow, but I don't know how to use geom_text() in order to add the values of the percentages for each segment of the bars.
ggplot(df, aes(x = values, fill = grp)) +
geom_bar(position = 'fill') +
geom_text(??)
Can anyone help me please?
Are you looking for something like this?
df2 <- as.data.frame(apply(table(df), 2, function(x) x/sum(x)))
df2$grp <- rownames(df2)
df2 <- reshape2::melt(df2)
ggplot(df2, aes(x = variable, y = value, fill = grp)) +
geom_col(position = "fill") +
geom_text(aes(label = ifelse(value == 0, "", scales::percent(value))),
position = position_fill(vjust = 0.5)) +
scale_y_continuous(labels = scales::percent, name = "Percent") +
labs(x = "Value")

Cumulative plot using ggplot and dplyr

Sample data:
dat <- data.frame(year = as.factor(rep(c(2012:2015),each = 6)),id.2wk = rep(c(18,19,20,21,22,23),times = 4),
value = c(1.8,15.6,32.9,27.5,19.6,2.6,1,8,42,35,11,3,2,7,12,47,26,7,2,13,24,46,12,4))
ggplot(dat %>% group_by(year) %>% mutate(cv=cumsum(value)),
aes(x = id.2wk, y = cv, colour = factor(year))) +
geom_line(size = 1)+
geom_point()
packageVersion("ggplot2")
2.2.1
I was expecting a plot similar to below. What went wrong?
How about using data.table to calculate cumulative sum within group?
library(data.table)
library(ggplot2)
ggplot(setDT(dat)[, cv:= cumsum(value), year],
aes(x = id.2wk, y = cv, colour = factor(year))) +
geom_line(size = 1) +
geom_point()
Sample data:
dat <- data.frame(year = as.factor(rep(c(2012:2015),each = 6)),
id.2wk = rep(c(18,19,20,21,22,23),times = 4),
value = c(1.8,15.6,32.9,27.5,19.6,2.6,1,8,42,35,11,3,2,7,12,47,26,7,2,13,24,46,12,4))

ggplot2:: Facetting plot with the same reference plot in all panels

I would like to facet a plot, but with a reference plot in each panel. Let me try to show with pictures what I want to achieve: My example data_frame:
require(dplyr)
df <- data_frame( id = c(rep('ctr',40), rep('pat',80)),
class = c(rep('ctr',40), rep(c('a','b'), each = 40)),
rank = rep (1:20,6),
mean = c(rep(seq(3,-3, length.out = 20),2),
rep(seq(1,-4, length.out = 20),2),
rep(seq(-2,-8, length.out = 20),2)),
sd = rep(seq(1.2,0.8, length.out = 20), times = 6),
exam = rep(c('blue','red'), each = 20, times = 3))
My plot:
# first, create reference plot of the 'controls'
require(ggplot2)
p_ctr <- ggplot() +
geom_line(data = filter(df, id == 'ctr'),
aes(x=rank, y=mean, color=exam), linetype=1) +
geom_ribbon(data = filter(df, id == 'ctr'),
aes(x = rank, ymax = mean+sd, ymin = mean-sd,
fill = exam), alpha = .1) +
scale_colour_manual(values = c("#00b6eb","#eb0041")) +
scale_fill_manual(values = c("#00b6eb","#eb0041"))
# then, overlay with plot of 'patients'
p_ctr + geom_line(data = filter(df, id == 'pat'),
aes(x=rank, y=mean, linetype = class)) +
geom_ribbon(data = filter(df, id == 'pat'),
aes(x = rank, ymax = mean+sd, ymin = mean-sd,
group = class),
alpha = .1) +
facet_wrap(~exam)
That is halfway there:
Ideally, however, I would like to plot the different "classes" in separate panels, but with the control plot as a reference in each panel:
Expected result:
I have tried different combinations of facetting, without good result. I guess, there must be a simple solution?
Maybe like so.
library(dplyr)
library(ggplot2)
df1 <- filter(df, id == 'ctr')
df2 <- filter(df, id == 'pat')
df2 <- dplyr::rename(df2, class_2 = class)
p_ctr <- ggplot() +
geom_line(data = df1, aes(x=rank, y=mean, color=exam)) +
geom_ribbon(data = df1,
aes(x = rank, ymax = mean+sd, ymin = mean-sd, fill = exam),
alpha = .1) +
scale_colour_manual(values = c("#00b6eb","#eb0041")) +
scale_fill_manual(values = c("#00b6eb","#eb0041")) +
geom_line(data = df2,
aes(x=rank, y=mean)) +
geom_ribbon(data = df2,
aes(x = rank, ymax = mean+sd, ymin = mean-sd),
alpha = .1) +
facet_grid(class_2 ~ exam)
p_ctr
Using facet_wrap gives me the following error:
error in gList(list(x = 0.5, y = 0.5, width = 1, height = 1, just = "centre", :
only 'grobs' allowed in "gList"
You probably came across this plot while looking for the solution.
p_ctr + geom_line(data = filter(df, id == 'pat'),
aes(x=rank, y=mean)) +
geom_ribbon(data = filter(df, id == 'pat'),
aes(x = rank, ymax = mean+sd, ymin = mean-sd),
alpha = .1) +
# facet_wrap(~exam) +
facet_grid(class ~ exam)
This is basically your reference plot and its overlay, without the linetype and group arguments. Additionally I faceted by class ~ exam. From this plot you see that 'the problem' is that class contains three unique elements: a, b and ctr. That's why I renamed the variable class in df2 to be class_2 which has only two unique elements: a and b. Faceting by class_2 ~ exam then gives the desired output.
I hope this helps.

Combining position_dodge and position_fill in ggplot2

What I would like to do is use both the position = "fill" and the position = "dodge" arguments of geom_bar() at the same time somehow. Using some sample data
set.seed(1234)
df <- data.frame(
Id = rep(1:10, each = 12),
Month = rep(1:12, times = 10),
Value = sample(1:2, 10 * 12, replace = TRUE)
)
I'm able to create the following graph
df.plot <- ggplot(df, aes(x = as.factor(Month), fill = as.factor(Value))) +
geom_bar(position = "fill") +
scale_x_discrete(breaks = 1:12) +
scale_y_continuous(labels = percent) +
labs(x = "Month", y = "Value")
I like the scaling and labeling of this graph but I want to be able to unstack it. However when I do the following
df.plot2 <- ggplot(df, aes(x = as.factor(Month), fill = as.factor(Value))) +
geom_bar(position = "dodge", aes(y = (..count..)/sum(..count..))) +
scale_x_discrete(breaks = 1:12) +
scale_y_continuous(labels = percent) +
labs(x = "Month", y = "Value")
The bars are in the position and scaling that I want but the y-axis labels represent the percentage of each bar relative to the total count, not the count within each month.
All in all I want the visuals of the second graph with the labeling of the first graph. Is there a relatively easy way to automate this?
Expanding on my comment:
library(ggplot2)
library(dplyr)
library(tidyr)
library(scales)
df1 <- df %>%
group_by(Month) %>%
summarise(Value1 = sum(Value == 1) / n(),
Value2 = sum(Value == 2) / n()) %>%
gather(key = Group,value = Val,Value1:Value2)
df.plot2 <- ggplot(df1, aes(x = as.factor(Month),
y = Val,
fill = as.factor(Group))) +
geom_bar(position = "dodge",stat = "identity") +
scale_y_continuous(labels = percent_format()) +
scale_x_discrete(breaks = 1:12) +
labs(x = "Month", y = "Value")

Resources