Is it possible to make this graph with ggplot, ordering the graph by the variable "t" in ascending order, distinguishing each "t" according to status (black or white circle, it can be another marker...) and if possible the variable "id " on the ordinate axis.
Id<- c(1,2,3,4)
t<- c(10,5,20,15)
status<- c(0,1,0,1)
df<- data.frame(Id, t, status)
Maybe you want something like this using geom_segment for the lines with geom_vline for the vertical lines. Using shape and fill aesthetics to fill the points with "black" and "white" per status. You can use the following code:
Id<- c(1,2,3,4)
t<- c(10,5,20,15)
status<- c(0,1,0,1)
df<- data.frame(Id, t, status)
library(ggplot2)
library(dplyr)
library(forcats)
df %>%
mutate(Id = as.factor(Id),
status = as.factor(status)) %>%
ggplot(aes(x = t, y = fct_reorder(Id, t, .desc = TRUE), shape = status, fill = status)) +
geom_point() +
geom_segment(aes(x = 0, xend = t, y = Id, yend = Id)) +
geom_vline(xintercept=c(t),linetype="dotted", alpha = 0.4) +
scale_shape_manual(values=c(21, 21), name = "shapes!") +
scale_fill_manual(values=c("black", "white")) +
scale_x_continuous(expand = c(0, 0), limits = c(0, 25)) +
labs(x = "", y = "Id") +
theme_bw() +
theme(panel.grid.major = element_blank(),
panel.grid.minor = element_blank(),
legend.position = "none",
axis.title.y = element_text(angle=0))
Created on 2022-07-25 by the reprex package (v2.0.1)
Related
I'm trying to do a horizontal, stacked bar chart. I want to label each part of the bar with the corresponding number (count). Those labels appear twice and I don't now why. How can I make "92" etc. appear only once?
Code:
library(ggplot2)
library(dplyr)
library(plyr)
data2 <- data.frame(System=rep(c('participants opinion'), each=5),
attitude=rep(c('totally agree','agree somewhat','unsure','disagree somewhat','totally disagree'), times=2),
count=c(92, 83, 22, 17, 6))
data2$attitude = factor(data2$attitude, levels = c('unsure','totally disagree','disagree somewhat','agree somewhat','totally agree'))
data2 = arrange(data2, System, desc(attitude))
data2 = ddply(data2, .(System), transform, pos = (cumsum(count) - 0.5 * count))
cbPalette <- c("#999999", "#2A7AD4", "#5C96D7", "#D3A253", "#D48F1D")
ggplot(data2, aes(x = factor(System), y = count, fill = attitude)) +
geom_bar(stat = "identity", width = .3) +
geom_text(aes(y = pos, label = count), size = 4) +
coord_flip() +
theme(panel.background = element_blank(),
panel.grid.major = element_blank(),
panel.grid.minor = element_blank(),
axis.title.y = element_blank()) +
scale_fill_manual(values=cbPalette)
your data2 object has 2 rows for every count, if you remove one row of each by:
label_data <- data2 |>
split(~count) |>
purrr::map_dfr(~.x |> head(1))
and putting it into:
geom_text(data = label_data, aes(y = pos, label = count), size = 4)
you can avoid that
With ggplot2, I can create a violin plot with overlapping points, and paired points can be connected using geom_line().
library(datasets)
library(ggplot2)
library(dplyr)
iris_edit <- iris %>% group_by(Species) %>%
mutate(paired = seq(1:length(Species))) %>%
filter(Species %in% c("setosa","versicolor"))
ggplot(data = iris_edit,
mapping = aes(x = Species, y = Sepal.Length, fill = Species)) +
geom_violin() +
geom_line(mapping = aes(group = paired),
position = position_dodge(0.1),
alpha = 0.3) +
geom_point(mapping = aes(fill = Species, group = paired),
size = 1.5, shape = 21,
position = position_dodge(0.1)) +
theme_classic() +
theme(legend.position = "none",
axis.text.x = element_text(size = 15),
axis.title.y = element_text(size = 15),
axis.title.x = element_blank(),
axis.text.y = element_text(size = 10))
The see package includes the geom_violindot() function to plot a halved violin plot alongside its constituent points. I've found this function helpful when plotting a large number of points so that the violin is not obscured.
library(see)
ggplot(data = iris_edit,
mapping = aes(x = Species, y = Sepal.Length, fill = Species)) +
geom_violindot(dots_size = 0.8,
position_dots = position_dodge(0.1)) +
theme_classic() +
theme(legend.position = "none",
axis.text.x = element_text(size = 15),
axis.title.y = element_text(size = 15),
axis.title.x = element_blank(),
axis.text.y = element_text(size = 10))
Now, I would like to add geom_line() to geom_violindot() in order to connect paired points, as in the first image. Ideally, I would like the points to be inside and the violins to be outside so that the lines do not intersect the violins. geom_violindot() includes the flip argument, which takes a numeric vector specifying the geoms to be flipped.
ggplot(data = iris_edit,
mapping = aes(x = Species, y = Sepal.Length, fill = Species)) +
geom_violindot(dots_size = 0.8,
position_dots = position_dodge(0.1),
flip = c(1)) +
geom_line(mapping = aes(group = paired),
alpha = 0.3,
position = position_dodge(0.1)) +
theme_classic() +
theme(legend.position = "none",
axis.text.x = element_text(size = 15),
axis.title.y = element_text(size = 15),
axis.title.x = element_blank(),
axis.text.y = element_text(size = 10))
As you can see, invoking flip inverts the violin half, but not the corresponding points. The see documentation does not seem to address this.
Questions
How can you create a geom_violindot() plot with paired points, such that the points and the lines connecting them are "sandwiched" in between the violin halves? I suspect there is a solution that uses David Robinson's GeomFlatViolin function, though I haven't been able to figure it out.
In the last figure, note that the lines are askew relative to the points they connect. What position adjustment function should be supplied to the position_dots and position arguments so that the points and lines are properly aligned?
Not sure about using geom_violindot with see package. But you could use a combo of geom_half_violon and geom_half_dotplot with gghalves package and subsetting the data to specify the orientation:
library(gghalves)
ggplot(data = iris_edit[iris_edit$Species == "setosa",],
mapping = aes(x = Species, y = Sepal.Length, fill = Species)) +
geom_half_violin(side = "l") +
geom_half_dotplot(stackdir = "up") +
geom_half_violin(data = iris_edit[iris_edit$Species == "versicolor",],
aes(x = Species, y = Sepal.Length, fill = Species), side = "r")+
geom_half_dotplot(data = iris_edit[iris_edit$Species == "versicolor",],
aes(x = Species, y = Sepal.Length, fill = Species),stackdir = "down") +
geom_line(data = iris_edit, mapping = aes(group = paired),
alpha = 0.3)
As a note, the lines in the pairing won't properly align because the dotplot is binning each observation then lengthing out the dotline-- the paired lines only correspond to x-value as defined in aes, not where the dot is in the line.
As per comment - this is not a direct answer to your question, but I believe that you might not get the most convincing visualisation when using the "slope graph" optic. This becomes quickly convoluted (so many dots/ lines overlapping) and the message gets lost.
To show change between paired observations (treatment 1 versus treatment 2), you can also (and I think: better) use a scatter plot. You can show each observation and the change becomes immediately clear. To make it more intuitive, you can add a line of equality.
I don't think you need to show the estimated distribution (left plot), but if you want to show this, you could make use of a two-dimensional density estimation, with geom_density2d (right plot)
library(tidyverse)
## patchwork only for demo purpose
library(patchwork)
iris_edit <- iris %>% group_by(Species) %>%
## use seq_along instead
mutate(paired = seq_along(Species)) %>%
filter(Species %in% c("setosa","versicolor")) %>%
## some more modificiations
select(paired, Species, Sepal.Length) %>%
pivot_wider(names_from = Species, values_from = Sepal.Length)
lims <- c(0, 10)
p1 <-
ggplot(data = iris_edit, aes(setosa, versicolor)) +
geom_abline(intercept = 0, slope = 1, lty = 2) +
geom_point(alpha = .7, stroke = 0, size = 2) +
cowplot::theme_minimal_grid() +
coord_equal(xlim = lims, ylim = lims) +
labs(x = "Treatment 1", y = "Treatment 2")
p2 <-
ggplot(data = iris_edit, aes(setosa, versicolor)) +
geom_abline(intercept = 0, slope = 1, lty = 2) +
geom_density2d(color = "Grey") +
geom_point(alpha = .7, stroke = 0, size = 2) +
cowplot::theme_minimal_grid() +
coord_equal(xlim = lims, ylim = lims) +
labs(x = "Treatment 1", y = "Treatment 2")
p1+ p2
Created on 2021-12-18 by the reprex package (v2.0.1)
At Facebook research, I found these beautiful bar charts which are connected by lines to indicate rank changes:
https://research.fb.com/do-jobs-run-in-families/
I would like to create them using ggplot2. The bar-chart-part was easy:
library(ggplot2)
library(ggpubr)
state1 <- data.frame(state=c(rep("ALABAMA",3), rep("CALIFORNIA",3)),
value=c(61,94,27,10,30,77),
type=rep(c("state","local","fed"),2),
cumSum=c(rep(182,3), rep(117,3)))
state2 <- data.frame(state=c(rep("ALABAMA",3), rep("CALIFORNIA",3)),
value=c(10,30,7,61,94,27),
type=rep(c("state","local","fed"),2),
cumSum=c(rep(117,3), rep(182,3)))
fill <- c("#40b8d0", "#b2d183", "#F9756D")
p1 <- ggplot(data = state1) +
geom_bar(aes(x = reorder(state, value), y = value, fill = type), stat="identity") +
theme_bw() +
scale_fill_manual(values=fill) +
labs(x="", y="Total budget in 1M$") +
theme(legend.position="none",
legend.direction="horizontal",
legend.title = element_blank(),
axis.line = element_line(size=1, colour = "black"),
panel.grid.major = element_blank(),
panel.grid.minor = element_blank(),
panel.border = element_blank(), panel.background = element_blank()) +
coord_flip()
p2 <- ggplot(data = state2) +
geom_bar(aes(x = reorder(state, value), y = value, fill = type), stat="identity") +
theme_bw() +
scale_fill_manual(values=fill) + labs(x="", y="Total budget in 1M$") +
theme(legend.position="none",
legend.direction="horizontal",
legend.title = element_blank(),
axis.line = element_line(size=1, colour = "black"),
panel.grid.major = element_blank(),
panel.grid.minor = element_blank(),
panel.border = element_blank(),
panel.background = element_blank()) +
scale_x_discrete(position = "top") +
scale_y_reverse() +
coord_flip()
p3 <- ggarrange(p1, p2, common.legend = TRUE, legend = "bottom")
But I couldn't come up with a solution to the line-part. When adding lines e.g. to the left side by
p3 + geom_segment(aes(x = rep(1:2, each=3), xend = rep(1:10, each=3),
y = cumSum[order(cumSum)], yend=cumSum[order(cumSum)]+10), size = 1.2)
The problem is that the lines will not be able to cross over to the right side.
It looks like this:
Basically, I would like to connect the 'California' bar on the left with the Caifornia bar on the right.
To do that, I think, I have to get access to the superordinate level of the graph somehow. I've looked into viewports and was able to overlay the two bar charts with a chart made out of geom_segment but then I couldn't figure out the right layout for the lines:
subplot <- ggplot(data = state1) +
geom_segment(aes(x = rep(1:2, each=3), xend = rep(1:2, each=3),
y = cumSum[order(cumSum)], yend =cumSum[order(cumSum)]+10),
size = 1.2)
vp <- viewport(width = 1, height = 1, x = 1, y = unit(0.7, "lines"),
just ="right", "bottom"))
print(p3)
print(subplot, vp = vp)
Help or pointers are greatly appreciated.
This is a really interesting problem. I approximated it using the patchwork library, which lets you add ggplots together and gives you an easy way to control their layout—I much prefer it to doing anything grid.arrange-based, and for some things it works better than cowplot.
I expanded on the dataset just to get some more values in the two data frames.
library(tidyverse)
library(patchwork)
set.seed(1017)
state1 <- data_frame(
state = rep(state.name[1:5], each = 3),
value = floor(runif(15, 1, 100)),
type = rep(c("state", "local", "fed"), times = 5)
)
state2 <- data_frame(
state = rep(state.name[1:5], each = 3),
value = floor(runif(15, 1, 100)),
type = rep(c("state", "local", "fed"), times = 5)
)
Then I made a data frame that assigns ranks to each state based on other values in their original data frame (state1 or state2).
ranks <- bind_rows(
state1 %>% mutate(position = 1),
state2 %>% mutate(position = 2)
) %>%
group_by(position, state) %>%
summarise(state_total = sum(value)) %>%
mutate(rank = dense_rank(state_total)) %>%
ungroup()
I made a quick theme to keep things very minimal and drop axis marks:
theme_min <- function(...) theme_minimal(...) +
theme(panel.grid = element_blank(), legend.position = "none", axis.title = element_blank())
The bump chart (the middle one) is based on the ranks data frame, and has no labels. Using factors instead of numeric variables for position and rank gave me a little more control over spacing, and lets the ranks line up with discrete 1 through 5 values in a way that will match the state names in the bar charts.
p_ranks <- ggplot(ranks, aes(x = as.factor(position), y = as.factor(rank), group = state)) +
geom_path() +
scale_x_discrete(breaks = NULL, expand = expand_scale(add = 0.1)) +
scale_y_discrete(breaks = NULL) +
theme_min()
p_ranks
For the left bar chart, I sort the states by value and turn the values negative to point to the left, then give it the same minimal theme:
p_left <- state1 %>%
mutate(state = as.factor(state) %>% fct_reorder(value, sum)) %>%
arrange(state) %>%
mutate(value = value * -1) %>%
ggplot(aes(x = state, y = value, fill = type)) +
geom_col(position = "stack") +
coord_flip() +
scale_y_continuous(breaks = NULL) +
theme_min() +
scale_fill_brewer()
p_left
The right bar chart is pretty much the same, except the values stay positive and I moved the x-axis to the top (becomes right when I flip the coordinates):
p_right <- state2 %>%
mutate(state = as.factor(state) %>% fct_reorder(value, sum)) %>%
arrange(state) %>%
ggplot(aes(x = state, y = value, fill = type)) +
geom_col(position = "stack") +
coord_flip() +
scale_x_discrete(position = "top") +
scale_y_continuous(breaks = NULL) +
theme_min() +
scale_fill_brewer()
Then because I've loaded patchwork, I can add the plots together and specify the layout.
p_left + p_ranks + p_right +
plot_layout(nrow = 1)
You may want to adjust spacing and margins some more, such as with the expand_scale call with the bump chart. I haven't tried this with axis marks along the y-axes (i.e. bottoms after flipping), but I have a feeling things might get thrown out of whack if you don't add a dummy axis to the ranks. Plenty still to mess around with, but it's a cool visualization project you posed!
Here's a pure ggplot2 solution, which combines the underlying data frames into one & plots everything in a single plot:
Data manipulation:
library(dplyr)
bar.width <- 0.9
# combine the two data sources
df <- rbind(state1 %>% mutate(source = "state1"),
state2 %>% mutate(source = "state2")) %>%
# calculate each state's rank within each data source
group_by(source, state) %>%
mutate(state.sum = sum(value)) %>%
ungroup() %>%
group_by(source) %>%
mutate(source.rank = as.integer(factor(state.sum))) %>%
ungroup() %>%
# calculate the dimensions for each bar
group_by(source, state) %>%
arrange(type) %>%
mutate(xmin = lag(cumsum(value), default = 0),
xmax = cumsum(value),
ymin = source.rank - bar.width / 2,
ymax = source.rank + bar.width / 2) %>%
ungroup() %>%
# shift each data source's coordinates away from point of origin,
# in order to create space for plotting lines
mutate(x = ifelse(source == "state1", -max(xmax) / 2, max(xmax) / 2)) %>%
mutate(xmin = ifelse(source == "state1", x - xmin, x + xmin),
xmax = ifelse(source == "state1", x - xmax, x + xmax)) %>%
# calculate label position for each data source
group_by(source) %>%
mutate(label.x = max(abs(xmax))) %>%
ungroup() %>%
mutate(label.x = ifelse(source == "state1", -label.x, label.x),
hjust = ifelse(source == "state1", 1.1, -0.1))
Plot:
ggplot(df,
aes(x = x, y = source.rank,
xmin = xmin, xmax = xmax,
ymin = ymin, ymax = ymax,
fill = type)) +
geom_rect() +
geom_line(aes(group = state)) +
geom_text(aes(x = label.x, label = state, hjust = hjust),
check_overlap = TRUE) +
# allow some space for the labels; this may be changed
# depending on plot dimensions
scale_x_continuous(expand = c(0.2, 0)) +
scale_fill_manual(values = fill) +
theme_void() +
theme(legend.position = "top")
Data source (same as #camille's):
set.seed(1017)
state1 <- data_frame(
state = rep(state.name[1:5], each = 3),
value = floor(runif(15, 1, 100)),
type = rep(c("state", "local", "fed"), times = 5)
)
state2 <- data_frame(
state = rep(state.name[1:5], each = 3),
value = floor(runif(15, 1, 100)),
type = rep(c("state", "local", "fed"), times = 5)
)
I have a matrix with many zero elements. The column names are labeled on the horizontal axis. I'd like to show explictly the nonzero elements as the bias from the vertical line for each column.
So how should construct a figure such as the example using ggplot2?
An example data can be generated as follow:
set.seed(2018)
N <- 5
p <- 40
dat <- matrix(0.0, nrow=p, ncol=N)
dat[2:7, 1] <- 4*rnorm(6)
dat[4:12, 2] <- 2.6*rnorm(9)
dat[25:33, 3] <- 2.1*rnorm(9)
dat[19:26, 4] <- 3.3*rnorm(8)
dat[33:38, 5] <- 2.9*rnorm(6)
colnames(dat) <- letters[1:5]
print(dat)
Here is another option using facet_wrap and geom_col with theme_minimal.
library(tidyverse)
dat %>%
as.data.frame() %>%
rowid_to_column("row") %>%
gather(key, value, -row) %>%
ggplot(aes(x = row, y = value, fill = key)) +
geom_col() +
facet_wrap(~ key, ncol = ncol(dat)) +
coord_flip() +
theme_minimal()
To further increase the aesthetic similarity to the plot in your original post we can
move the facet strips to the bottom,
rotate strip labels,
add "zero lines" in matching colours,
remove the fill legend, and
get rid of the x & y axis ticks/labels/title.
library(tidyverse)
dat %>%
as.data.frame() %>%
rowid_to_column("row") %>%
gather(key, value, -row) %>%
ggplot(aes(x = row, y = value, fill = key)) +
geom_col() +
geom_hline(data = dat %>%
as.data.frame() %>%
gather(key, value) %>%
count(key) %>%
mutate(y = 0),
aes(yintercept = y, colour = key), show.legend = F) +
facet_wrap(~ key, ncol = ncol(dat), strip.position = "bottom") +
coord_flip() +
guides(fill = FALSE) +
theme_minimal() +
theme(
strip.text.x = element_text(angle = 45),
axis.title = element_blank(),
axis.text = element_blank(),
axis.ticks = element_blank())
It would be much easier if you can provide some sample data. Thus I needed to create them and there is no guarantee that this will work for your purpose.
set.seed(123)
# creating some random sample data
df <- data.frame(id = rep(1:100, each = 3),
x = rnorm(300),
group = rep(letters[1:3], each = 100),
bias = sample(0:1, 300, replace = T, prob = c(0.7, 0.3)))
# introducing bias
df$bias <- df$bias*rnorm(nrow(df))
# calculate lower/upper bias for errorbar
df$biaslow <- apply(data.frame(df$bias), 1, function(x){min(0, x)})
df$biasupp <- apply(data.frame(df$bias), 1, function(x){max(0, x)})
Then I used kind of hack to be able to print groups in sufficient distance to make them not overlapped. Based on group I shifted bias variable and also lower and upper bias.
# I want to print groups in sufficient distance
df$bias <- as.numeric(df$group)*5 + df$bias
df$biaslow <- as.numeric(df$group)*5 + df$biaslow
df$biasupp <- as.numeric(df$group)*5 + df$biasupp
And now it is possible to plot it:
library(ggplot2)
ggplot(df, aes(x = x, col = group)) +
geom_errorbar(aes(ymin = biaslow, ymax = biasupp), width = 0) +
coord_flip() +
geom_hline(aes(yintercept = 5, col = "a")) +
geom_hline(aes(yintercept = 10, col = "b")) +
geom_hline(aes(yintercept = 15, col = "c")) +
theme(legend.position = "none") +
scale_y_continuous(breaks = c(5, 10, 15), labels = letters[1:3])
EDIT:
To incorporate special design you can add
theme_bw() +
theme(axis.text.y = element_blank(),
axis.ticks.y = element_blank(),
axis.title.y = element_blank(),
axis.text.x = element_text(angle = 45, vjust = 0.5, hjust = 1),
panel.grid.major = element_blank(),
panel.grid.minor = element_blank())
to your plot.
EDIT2:
To incorporate several horizontal lines, you can create different dataset:
df2 <- data.frame(int = unique(as.numeric(df$group)*5),
gr = levels(df$group))
And use
geom_hline(data = df2, aes(yintercept = int, col = gr))
instead of copy/pasting geom_hline for each group level.
I am trying to produce a heatmap in ggplot. I want each group to have different color gradient, but don't know how to do that. My current code looks like this:
## dummy data -----------------------------------------------------------------------------
data <- data.frame(
group = sample(c("Direct Patient Care", "Indirect Patient Care", "Education", "Rounds", "Handoff", "Misce"), 30, replace = T),
pct = rnorm(30, mean = 50, sd = 8)
)
## generate group id
data <- data %>%
group_by(group) %>%
mutate(id = row_number())
data$grpid <- with(data, ifelse(group == "Direct Patient Care", 1, ifelse(group == "Indirect Patient Care", 2,
ifelse(group == "Education", 3,
ifelse(group == "Rounds", 4,
ifelse(group == "Handoff", 5,6 ))))))
## draw graph ------------------------------------------------------------------------------
library(ggplot2)
p <- ggplot(data, aes(x=id, y=group, fill = pct)) +
theme(panel.background = element_rect(fill = "white", colour = "grey50"), aspect.ratio = 0.4) +
theme(panel.grid.major = element_blank(),
panel.grid.minor = element_blank()
)+
# guides(fill = guide_legend("Time, %")) +
geom_tile() +
scale_x_continuous (name = " ", breaks = seq(1, 8, by = 1)) +
scale_y_discrete(name = " ") +
theme(axis.text.x = element_text(angle = 0,hjust = 1,vjust = 1), plot.title = element_text(hjust = 0.5) ) +
ggtitle("Heatmap of time spent doing activities across 194 shifts")
p + scale_fill_gradient2(low = "white", high = "red", limits = c(0, 80), breaks = c(0, 10, 20, 30, 40, 50, 60, 70), guide = guide_legend("Time, %")) ## change the color theme ##
And the resulting figure looks like this:
How can I change the color theme for each group, like red for 'Rounds', blue for 'Misce', green for 'Handoff' etc...
Many thanks!
You can do this by creating your own rescaled value in your data and then slightly "hacking" the alpha aesthetic combined with the fill aesthetic:
library(tidyverse)
data %>%
group_by(group) %>%
mutate(rescale = scales::rescale(pct)) %>%
ggplot(., aes(x = factor(id), y = group)) +
geom_tile(aes(alpha = rescale, fill = group), color = "white") +
scale_alpha(range = c(0.1, 1))
First we create a new column called rescale which rescales the pct from 0 to 1 then you force the scale_alpha(range = c(0, 1)) [note, in this case I used c(0.1, 1) so that you can still "see" the zero points.
Finally, you probably want to remove the guides:
data %>%
group_by(group) %>%
mutate(rescale = scales::rescale(pct)) %>%
ggplot(., aes(x = factor(id), y = group)) +
geom_tile(aes(alpha = rescale, fill = group), color = "white") +
scale_alpha(range = c(0.1, 1)) +
theme(legend.position = "none")
N.B. by using aes(x = factor(id)... you can get around manually setting your x-axis since in this case it appears you want to treat it as a factor not a numeric scale.
Finally, if you really want to get fancy, you could double-encode the axis.text.y colors to that of the levels of your factor (i.e., data$group) variable:
data %>%
group_by(group) %>%
mutate(rescale = scales::rescale(pct)) %>%
ggplot(., aes(x = factor(id), y = group)) +
geom_tile(aes(alpha = rescale, fill = group), color = "white") +
scale_alpha(range = c(0.1, 1)) +
theme(legend.position = "none",
axis.text.y = element_text(color = scales::hue_pal()(length(levels(data$group)))),
axis.ticks = element_blank()) +
labs(x = "", y = "")