Plot multiple variable in the same bar plot - r

With my dataframe that looks like this (I have in total 1322 rows) :
I'd like to make a bar plot with the percentage of rating of the CFS score. It should look similar to this :
With this code, I can make a single bar plot for the column cfs_triage :
ggplot(data = df) +
geom_bar(mapping = aes(x = cfs_triage, y = (..count..)/sum(..count..)))
But I can't find out to make one with the three varaibles next to another.
Thank you in advance to all of you that will help me with making this barplot with the percentage of rating for this three variable !(I'm not sure that my explanations are very clear, but I hope that it's the case :))

Your best bet here is to pivot your data into long format. We don't have your data, but we can reproduce a similar data set like this:
set.seed(1)
df <- data.frame(cfs_triage = sample(10, 1322, TRUE, prob = 1:10),
cfs_silver = sample(10, 1322, TRUE),
cfs_student = sample(10, 1322, TRUE, prob = 10:1))
df[] <- lapply(df, function(x) { x[sample(1322, 300)] <- NA; x})
Now the dummy data set looks a lot like yours:
head(df)
#> cfs_triage cfs_silver cfs_student
#> 1 9 NA 1
#> 2 8 4 2
#> 3 NA 8 NA
#> 4 NA 10 9
#> 5 9 5 NA
#> 6 3 1 NA
If we pivot into long format, then we will end up with two columns: one containing the values, and one containing the column name that the value belonged to in the original data frame:
library(tidyverse)
df_long <- df %>%
pivot_longer(everything())
head(df_long)
#> # A tibble: 6 x 2
#> name value
#> <chr> <int>
#> 1 cfs_triage 9
#> 2 cfs_silver NA
#> 3 cfs_student 1
#> 4 cfs_triage 8
#> 5 cfs_silver 4
#> 6 cfs_student 2
This then allows us to plot with value on the x axis, and we can use name as a grouping / fill variable:
ggplot(df_long, aes(value, fill = name)) +
geom_bar(position = 'dodge') +
scale_fill_grey(name = NULL) +
theme_bw(base_size = 16) +
scale_x_continuous(breaks = 1:10)
#> Warning: Removed 900 rows containing non-finite values (`stat_count()`).
Created on 2022-11-25 with reprex v2.0.2

Maybe you need something like this: The formatting was taken from #Allan Cameron (many Thanks!):
library(tidyverse)
library(scales)
df %>%
mutate(id = row_number()) %>%
pivot_longer(-id) %>%
group_by(id) %>%
mutate(percent = value/sum(value, na.rm = TRUE)) %>%
mutate(percent = ifelse(is.na(percent), 0, percent)) %>%
mutate(my_label = str_trim(paste0(format(100 * percent, digits = 1), "%"))) %>%
ggplot(aes(x = factor(name), y = percent, fill = factor(name), label = my_label))+
geom_col(position = position_dodge())+
geom_text(aes(label = my_label), vjust=-1) +
facet_wrap(. ~ id, nrow=1, strip.position = "bottom")+
scale_fill_grey(name = NULL) +
scale_y_continuous(labels = scales::percent)+
theme_bw(base_size = 16)+
theme(axis.text.x = element_text(angle = 90, vjust = 0.5, hjust=1))

Related

How do I use summarise properly in R for this simple analysis?

Haven't used RStudio in a while, so I am quite rusty.
I want to create a bar chart showing the countries shipping the most freight weight in ascending order.
I have made this simple script that does the job:
df_new %>%
filter(!is.na(Freight_weight)) %>%
filter(!is.na(origin_name)) %>%
select(origin_name, Freight_weight) %>%
ggplot(aes(x = reorder(origin_name, Freight_weight, FUN = sum), y = Freight_weight)) +
geom_col() +
labs(x = "") +
theme(axis.text.x = element_text(angle = 90, vjust = 0.5, hjust=1))
However, when I try to do more with it, like adding a top_10 clause to only get the countries with the highest shipments, it doesn't work since it takes the 10 highest individual shipments and not per country.
Instead, I have tried something like this:
df_new %>%
group_by(origin_name) %>%
summarise(n = sum(Freight_weight, na.rm = TRUE)) %>%
ungroup() %>%
mutate(share = n /sum(n) %>% factor() %>% fct_reorder(share)) %>%
ggplot(aes(x = origin_name, y = n)) +
geom_col() +
labs(x = "") +
theme(axis.text.x = element_text(angle = 90, vjust = 0.5, hjust=1))
But here, I can't get the share function to work. What am I doing wrong?
Greatly appreciate your input - if I get this down I should be able to do most of the concurrent analyses!
If you want to find the top 10 countries ordered by their corresponding highest
Freight_weight, one possible solution is,
(Note that, I have created more countries, (denoted by Alphabets) and more data)
Hope this helps.
library(dplyr)
set.seed(123)
df_new <- structure(
list(
Freight_weight = runif(200, min = 1, max = 50),
origin_name = sample(LETTERS[1:15], size = 200, replace = TRUE)
),
row.names = c(NA,-200L),
class = c("tbl_df", "tbl",
"data.frame")
)
df_new %>%
group_by(origin_name) %>%
slice_max(order_by = Freight_weight, n = 1) %>%
ungroup() %>%
arrange(desc(Freight_weight)) %>%
slice(1:10)
#> # A tibble: 10 × 2
#> Freight_weight origin_name
#> <dbl> <chr>
#> 1 49.7 N
#> 2 49.3 I
#> 3 49.2 J
#> 4 49.0 F
#> 5 47.9 M
#> 6 47.8 K
#> 7 47.8 E
#> 8 47.4 O
#> 9 47.1 H
#> 10 46.9 G
Created on 2022-07-06 by the reprex package (v2.0.1)

How to visualize multiple bar plots in one (or splitted) pdf

I'm using the tidyverse-ggplot2 combination to plot multiple bar plots. In one of my comparisons i would like to have even up to 300 single plots. I was wondering if there is a possibility to make sure that the plots will be visible in the pdf file and not look like the attached example
If possible I would prefer to have all the plots in one single pdf file, but if not, also multiple pages will be ok.
The command to plot the bar charts is
common %>%
as_tibble(rownames="gene") %>%
left_join(x= ., y = up[,1:2], by = c("gene" = "ensembl_gene_id") ) %>%
pivot_longer(starts_with("S"), names_to="sample", values_to="counts") %>%
left_join(groups, by="sample") %>%
group_by(mgi_symbol, group, cond, time) %>%
summarize(mean_count=mean(counts)) %>%
ggplot( aes(x = time, y = mean_count, fill=cond)) +
geom_bar(stat = "identity", position = position_dodge(width=0.9) ) +
scale_fill_manual(values=c("darkblue", "lightblue", "black")) +
facet_wrap(~mgi_symbol, scales = "free", ncol = 5) +
theme_bw()
I forgot to add the group table
groups <- tibble(
sample= colnames(normCounts),
group = rep(seq(1, ncol(normCounts)/3), each=3),
cond = rep(c("WT", "GCN2-KO", "GCN1-KO"), each = 12),
time = rep(rep(c("0h", "1h", "4h", "8h"), each=3), times = 3 )
)
thanks
Adding the command with the group_map was as such
common %>%
as_tibble(rownames="gene") %>%
left_join(x= ., y = up[,1:2], by = c("gene" = "ensembl_gene_id") ) %>%
pivot_longer(starts_with("S"), names_to="sample", values_to="counts") %>%
left_join(groups, by="sample") %>%
group_by(mgi_symbol, group, cond, time) %>%
summarize(mean_count=mean(counts)) %>%
group_map(function(g, ...)
ggplot(g, aes(x = time, y = mean_count, fill=cond)) +
geom_bar(stat = "identity", position = position_dodge(width=0.9) ) +
scale_fill_manual(values=c("darkblue", "lightblue", "black")) +
facet_wrap(~mgi_symbol, scales = "free", ncol = 5) +
theme_bw()
)
EDIT
This is how the data looks like in the input table (after summarizing the means)
df <-
common %>%
as_tibble(rownames="gene") %>%
left_join(x= ., y = up[,1:2], by = c("gene" = "ensembl_gene_id") ) %>%
pivot_longer(starts_with("S"), names_to="sample", values_to="counts") %>%
left_join(groups, by="sample") %>%
group_by(mgi_symbol, group, cond, time) %>%
summarize(mean_count=mean(counts)) %>%
ungroup()
df
#>`summarise()` regrouping output by 'mgi_symbol', 'group', 'cond' (override with `.groups` argument)
#> # A tibble: 1,212 x 5
#> mgi_symbol group cond time mean_count
#> <chr> <int> <chr> <chr> <dbl>
#> 1 0610031O16Rik 1 WT 0h 14.4
#> 2 0610031O16Rik 2 WT 1h 30.9
#> 3 0610031O16Rik 3 WT 4h 45.5
#> 4 0610031O16Rik 4 WT 8h 56.0
#> 5 0610031O16Rik 5 GCN2-KO 0h 18.9
#> 6 0610031O16Rik 6 GCN2-KO 1h 39.4
#> 7 0610031O16Rik 7 GCN2-KO 4h 13.9
#> 8 0610031O16Rik 8 GCN2-KO 8h 13.3
#> 9 0610031O16Rik 9 GCN1-KO 0h 12.3
#> 10 0610031O16Rik 10 GCN1-KO 1h 25.3
#> # … with 1,202 more rows
Start with some dummy data. This is the data after you've finished running left_join, pivot_longer, group_by, summarize.
library(tidyverse)
df <- tibble(
time = 1:5,
mean_count = 1:5,
cond = "x"
) %>%
expand_grid(mgi_symbol = c(letters, LETTERS))
Create a column group which represents what page the mgi_symbol belongs on.
plots_per_page <- 20
df <-
df %>%
mutate(group = (dense_rank(mgi_symbol) - 1) %/% plots_per_page)
Create all the plots with group_map.
plots <-
df %>%
group_by(group) %>%
group_map(function(g, ...) {
ggplot(g, aes(x = time, y = mean_count, fill=cond)) +
geom_bar(stat = "identity", position = position_dodge(width=0.9) ) +
scale_fill_manual(values=c("darkblue", "lightblue", "black")) +
facet_wrap(~mgi_symbol, scales = "free", ncol = 5) +
theme_bw()
})
Save as multiple pages using ggpubr
ggpubr::ggexport(
ggpubr::ggarrange(plotlist = plots, nrow = 1, ncol = 1),
filename = "plots.pdf"
)

Ghost geom_text in gganimate

I am playing around with gganimate and I do believe it is acting slightly funky when it comes to labels (I've basically followed this example).
I am generating the following .gif with this code snippet (you can find the data here, didn't want post length to explode).
library(gganimate)
library(dplyr)
df <- read.csv("https://pastebin.com/raw/QvhdVqwM", stringsAsFactors = FALSE) %>%
mutate(date = as.Date(date))
countries_anim <- df %>%
filter(country_code == "de") %>%
ggplot(aes(date, value, colour = city_name)) +
geom_line() +
geom_segment(aes(xend = max(date) - 30, yend = value), linetype = 2,
colour = "grey") +
geom_text(aes(x = max(date) - 29, label = city_name), hjust = 0) +
theme(legend.position = "bottom") +
guides(colour = guide_legend(title.position = "top")) +
transition_reveal(date)
n_days <- as.integer(max(df$date) - min(df$date))
anim <- animate(plot = countries_anim, duration = 10,
renderer = gifski_renderer(file = 'figures/de.gif'))
Everything works pretty well except one minor annoyance: at the very beginning of the animation, some annotations (which are supposed to follow time series trend) get permanently printed in the plot area. I've tried to change renderer but the issue seems to be completely uncorrelated.
I am not that versed on gganimate internals and I'm wondering how I could go debugging the issue.
Been struggling in debugging this for a few hours but I seem to have found a solution. Apparently animated annotations are affected by how data is ordered; as you can see in the example below, my dataset was arranged in descending order (by date). Changing the order seems to help annotations to behave better:
library(dplyr)
library(gganimate)
library(ggplot2)
df <- read.csv("https://pastebin.com/raw/QvhdVqwM", stringsAsFactors = FALSE) %>%
mutate(date = as.Date(date))
# Dates are in descending order
df %>%
filter(country_code == "de") %>%
head %>%
as_tibble()
#> # A tibble: 6 x 10
#> big_change change_from_pre… date type region_id value city_name
#> <lgl> <int> <date> <chr> <chr> <int> <chr>
#> 1 FALSE -3 2020-05-28 one_… de-berlin 28 Berlin
#> 2 FALSE 3 2020-05-28 one_… de-hambu… 32 Hamburg
#> 3 FALSE 2 2020-05-28 one_… de-rhine… 31 Rhine-Ru…
#> 4 FALSE 2 2020-05-27 one_… de-berlin 32 Berlin
#> 5 FALSE -3 2020-05-27 one_… de-hambu… 28 Hamburg
#> 6 FALSE 3 2020-05-27 one_… de-rhine… 28 Rhine-Ru…
#> # … with 3 more variables: country_code <chr>, note <chr>, country <chr>
countries_anim <- df %>%
filter(country_code == "de") %>%
arrange(date) %>% # arranging by date solves the problem.
ggplot(aes(date, value, colour = city_name)) +
geom_line() +
geom_segment(aes(xend = max(date) - 30, yend = value), linetype = 2,
colour = "grey") +
geom_text(aes(x = max(date) - 29, label = city_name), hjust = 0) +
theme(legend.position = "bottom") +
guides(colour = guide_legend(title.position = "top")) +
transition_reveal(date)
country_anim <- animate(plot = countries_anim, duration = 10,
renderer = gifski_renderer(file = 'figures/countries.gif'))
I am not quite sure why this happens as data order doesn't really upset gpplot2.

R - (ggplot2 library) - Legends not showing on graphs

What I'm doing
I'm using a library for R called ggplot2, which allows for a lot of different options for creating graphics and other things. I'm using that to display two different data sets on one graph with different colours for each set of data I want to display.
The Problem
I'm also trying to get a legend to to show up in my graph that will tell the user which set of data corresponds to which colour. So far, I've not been able to get it to show.
What I've tried
I've set it to have a position at the top/bottom/left/right to make sure nothing was making it's position to none by default, which would've hidden it.
The Code
# PDF/Plot generation
pdf("activity-plot.pdf")
ggplot(data.frame("Time"=times), aes(x=Time)) +
#Data Set 1
geom_density(fill = "#1A3552", colour = "#4271AE", alpha = 0.8) +
geom_text(x=mean(times)-1, y=max(density(times)$y/2), label="Mean {1} Activity", angle=90, size = 4) +
geom_vline(aes(xintercept=mean(times)), color="cyan", linetype="dashed", size=1, alpha = 0.5) +
# Data Set 2
geom_density(data=data.frame("Time"=timesSec), fill = "gray", colour = "orange", alpha = 0.8) +
geom_text(x=mean(timesSec)-1, y=max(density(timesSec)$y/2), label="Mean {2} Activity", angle=90, size = 4) +
geom_vline(aes(xintercept=mean(timesSec)), color="orange", linetype="dashed", size=1, alpha = 0.5) +
# Main Graph Info
labs(title="Activity in the past 48 hours", subtitle="From {DATE 1} to {DATE 2}", caption="{LOCATION}") +
scale_x_continuous(name = "Time of Day", breaks=seq(c(0:23))) +
scale_y_continuous(name = "Activity") +
theme(legend.position="top")
dev.off()
Result
As pointed out by #Ben, you should pass the color into an aes in order to get the legend being displayed.
However, a better way to get a ggplot is to merge your two values "Time" and "Timesec" into a single dataframe and reshape your dataframe into a longer format. Here, to illustrate this, I created this dummy dataframe:
Time = sample(1:24, 200, replace = TRUE)
Timesec = sample(1:24, 200, replace = TRUE)
df <- data.frame(Time, Timesec)
Time Timesec
1 22 23
2 21 9
3 19 9
4 10 6
5 7 24
6 15 9
... ... ...
So, the first step is to reshape your dataframe into a longer format. Here, I'm using pivot_longer function from tidyr package:
library(tidyr)
library(dplyr)
df %>% pivot_longer(everything(), names_to = "var",values_to = "val")
# A tibble: 400 x 2
var val
<chr> <int>
1 Time 22
2 Timesec 23
3 Time 21
4 Timesec 9
5 Time 19
6 Timesec 9
7 Time 10
8 Timesec 6
9 Time 7
10 Timesec 24
# … with 390 more rows
To add geom_vline and geom_text based on the mean of your values, a nice way of doing it easily is to create a second dataframe gathering the mean and the maximal density values needed to be plot:
library(tidyr)
library(dplyr)
df_lab <- df %>% pivot_longer(everything(), names_to = "var",values_to = "val") %>%
group_by(var) %>%
summarise(Mean = mean(val),
Density = max(density(val)$y))
# A tibble: 2 x 3
var Mean Density
<chr> <dbl> <dbl>
1 Time 11.6 0.0555
2 Timesec 12.1 0.0517
So, using df and df_lab, you can generate your entire plot. Here, we passed color and fill arguments into the aes and use scale_color_manual and scale_fill_manual to set appropriate colors:
library(dplyr)
library(tidyr)
library(ggplot2)
df %>% pivot_longer(everything(), names_to = "var",values_to = "val") %>%
ggplot(aes(x = val, fill = var, colour = var))+
geom_density(alpha = 0.8)+
scale_color_manual(values = c("#4271AE", "orange"))+
scale_fill_manual(values = c("#1A3552", "gray"))+
geom_vline(inherit.aes = FALSE, data = df_lab,
aes(xintercept = Mean, color = var), linetype = "dashed", size = 1,
show.legend = FALSE)+
geom_text(inherit.aes = FALSE, data = df_lab,
aes(x = Mean-0.5, y = Density/2, label = var, color = var), angle = 90,
show.legend = FALSE)+
labs(title="Activity in the past 48 hours", subtitle="From {DATE 1} to {DATE 2}", caption="{LOCATION}") +
scale_x_continuous(name = "Time of Day", breaks=seq(c(0:23))) +
scale_y_continuous(name = "Activity") +
theme(legend.position="top")
Does it answer your question ?

Mean across each element of a tibble list-column by group with purrr and dplyr

I'm trying to get used to using tidyverse. I don't know if my data is well suited for using functions like map(). I like the organization of list-columns so I am wondering how to use a combination of group_by(), summarize(), map(), and other functions to get this to work. I know how to use these functions with vector-columns but do not know how to approach this in the case of list-columns.
Sample data:
library(tidyverse)
set.seed(3949)
myList <- replicate(12, sample(1:20, size = 10), simplify = FALSE)
tibble(
group = rep(c("A", "B"), each = 6),
data = myList
)
Each vector in the list-column has ten elements which are values for a given trial. What I would like to do is group the tibble by group and then find the "column" mean and se of the expanded lists. In other words, it's like I'm treating the list columns as a matrix with each row of the tibble bound together. The output will have columns for the group and trials as well so it is in the correct format for ggplot2.
mean se group trial
1 6.000000 1.6329932 A 1
2 12.666667 2.3333333 A 2
3 12.333333 2.8007935 A 3
4 13.833333 1.8150605 A 4
5 8.166667 3.1028661 A 5
6 11.500000 2.9410882 A 6
7 13.666667 2.3758040 A 7
8 6.833333 1.7779514 A 8
9 11.833333 2.3009660 A 9
10 8.666667 1.7061979 A 10
11 8.333333 1.6865481 B 1
12 12.166667 2.6002137 B 2
13 10.000000 2.7080128 B 3
14 11.833333 3.1242777 B 4
15 4.666667 1.2823589 B 5
16 12.500000 3.0413813 B 6
17 6.000000 1.5055453 B 7
18 8.166667 1.6616591 B 8
19 11.000000 2.6708301 B 9
20 13.166667 0.9457507 B 10
Here is how I would normally do something like this:
set.seed(3949)
data.frame(group = rep(c("A", "B"), each = 6)) %>%
cbind(replicate(12, sample(1:20, size = 10)) %>% t()) %>%
split(.$group) %>%
lapply(function(x) data.frame(mean = colMeans(x[ ,2:11]),
se = apply(x[ ,2:11], 2, se))) %>%
do.call(rbind,.) %>%
mutate(group = substr(row.names(.), 1,1),
trial = rep(1:10, 2)) %>%
ggplot(aes(x = trial, y = mean)) +
geom_point() +
geom_line() +
facet_grid(~ group) +
scale_x_continuous(limits = c(1,10), breaks = seq(1, 10, 1)) +
geom_errorbar(aes(ymin = mean-se, ymax = mean+se), color = "black") +
theme_bw()
Is there are cleaner way to do this with the tidyverse functions?
I think that another way is to use nest() and map().
library(tidyverse)
library(plotrix) #For the std.error
# Your second sample dataset
set.seed(3949)
df <- data.frame(group = rep(c("A", "B"), each = 6)) %>%
cbind(replicate(12, sample(1:20, size = 10)) %>% t())
df %>%
nest(-group) %>%
mutate(mean = map(data, ~rowMeans(.)),
se = map(data, ~ plotrix::std.error(t(.))),
trial = map(data, ~ seq(1, nrow(.)))) %>%
unnest(mean, se, trial) %>%
ggplot(aes(x = trial, y = mean)) +
geom_point() +
geom_line() +
facet_grid(~ group) +
geom_errorbar(aes(ymin = mean-se, ymax = mean+se), color = "black") +
theme_bw()

Resources