i'm fairly new to R so please excuse me for the noob question.
I have a dataframe that looks like this:
gene ctrl treated
gene_1 100 37.5
gene_2 100 20.2
... ... ...
For each row (ie each gene) in the df, I want to plot the values in such a way that ctrl and treated are one next to the other.
The code below gives something close to what i want, but the output is not grouped as it should: the bars for controls are plotted before the ones for treated samples.
barplot(height = df$df.ctrl1, df$df.avg_treated), names.arg = df$df.gene)
I know there are many similar questions, but i've gone through them with no success.
Anyone can help me understand what am i doing wrong?
Second (optional) question: what if i want to color-code the bars according to the gene id?
Many thanks.
I would use ggplot for this. Let's start with a slightly expanded example:
df <- data.frame(genes = c("gene_1", "gene_2", "gene_3", "gene_4"),
ctrl = c(50, 60, 70, 80),
treated = c(55, 64, 75, 83))
df
#> genes ctrl treated
#> 1 gene_1 50 55
#> 2 gene_2 60 64
#> 3 gene_3 70 75
#> 4 gene_4 80 83
The first thing we need to do is switch the dataframe to long format using tidyr::pivot_longer to put all your values in one column, and the labels of "ctrl" and "treatment" in another column. Then we can use ggplot to build our output:
library(tidyr)
library(ggplot2)
df %>%
pivot_longer(cols = c("ctrl", "treated")) %>%
ggplot(aes(name, value, fill = genes, alpha = name)) +
geom_col(position = position_dodge(), color = "black") +
scale_alpha_manual(values = c(0.5, 1), guide = guide_none()) +
facet_grid(~genes, scales = "free_x", switch = "x") +
theme(strip.placement = "outside",
panel.spacing = unit(0, "points"),
strip.background = element_blank(),
strip.text = element_text(face = "bold", size = 12)) +
labs(x = "Gene")
Created on 2020-08-22 by the reprex package (v0.3.0)
Consider transposing your data, converting into matrix with dimnames. Then run barplot with legend. Below demonstrates with random data. Note: ylim is adjusted for pretty range limit.
set.seed(92220)
df <- data.frame(gene = paste("gene", 1:30),
ctrl = runif(30, 50, 100),
treated = runif(30, 50, 100))
head(df)
# gene ctrl treated
# 1 gene 1 75.74607 76.15832
# 2 gene 2 61.73860 70.19874
# 3 gene 3 56.57906 63.67602
# 4 gene 4 60.23045 80.21108
# 5 gene 5 62.52773 60.86909
# 6 gene 6 85.71849 61.25974
# TRANSPOSE INTO MATRIX WITH DIMNAMES
dat <- `dimnames<-`(t(as.matrix(df[c("ctrl", "treated")])),
list(c("ctrl", "treated"), df$gene))
barplot(dat, beside=TRUE, col=c("blue", "red"), las=3,
main="Control Vs. Treatment",
ylim=range(pretty(c(0, dat*1.05))))
legend("top", legend=row.names(dat),
fill=c("blue", "red"), ncol=2, cex=0.75)
Related
I'm aiming to reproduce an animated figure by Ed Hawkins on climate change in R with gganimate. The figure is called climate spiral. While a static ggplot figure shows the correct order of lines by year (the most recent data on top), the animated plot with transition_reveal() results in a wrong order of the lines.
Here is a reproducible example code with synthetic data:
library(tidyverse)
library(lubridate)
library(gganimate)
library(RColorBrewer)
# Create monthly data from 1950 to 2020 (and a component for rising values with time)
df <- tibble(year = rep(1950:2020, each = 12),
month = rep(month.abb, 2020-1950+1)) %>%
mutate(date = dmy(paste("01",month,year)),
value = rnorm(n(), 0, 2) + row_number()*0.005) %>%
with_groups(year, mutate, value_yr = mean(value))
temp <- df %>%
ggplot(aes(x = month(date, label=T), y = value, color = value_yr)) +
geom_line(size = 0.6, aes(group = year)) +
geom_hline(yintercept = 0, color = "white") +
geom_hline(yintercept = c(-4,4), color = c("skyblue3","red1"), size = 0.2) +
geom_vline(xintercept = 1:12, color = "white", size = 0.2) +
annotate("label", x = 12.5, y = c(-4,0,4), label = c("-4°C","0°C","+4°C"),
color = c("skyblue3","white","red1"), size = 2.5, fill = "#464950",
label.size = NA, label.padding = unit(0.1, "lines"),) +
geom_point(x = 1, y = -11, size = 15, color = "#464950") +
geom_label(aes(x = 1, y = -11, label = year),
color = "white", size = 4,
fill = "#464950", label.size = NA) +
coord_polar(start = 0) +
scale_color_gradientn(colors = rev(brewer.pal(n=11, name = "RdBu")),
limits = range(df$value_yr)) +
labs(x = "", y = "") +
theme_bw() +
theme(panel.background = element_blank(),
panel.border = element_blank(),
panel.grid.major = element_blank(),
plot.background=element_rect(fill="#464950", color="#464950"),
axis.text.x = element_text(margin = margin(t = -20, unit = "pt"),
color = "white"),
axis.text.y = element_blank(),
axis.ticks = element_blank(),
legend.position = "none")
Now, we can either save the plot as PNG or animate and save as GIF:
ggsave(temp, filename = "test.png", width = 5, height = 5, dpi = 320)
# Animate by date:
anim <- temp +
transition_reveal(date) +
ease_aes('linear')
output <- animate(anim, nframes = 100, end_pause = 30,
height = 5, width = 5, units = "in", res = 300)
anim_save("test.gif", output)
Let's see the results!
Static PNG:
Animated GIF:
At first glance, the results look equal, however, the detail shows differences (for instance, the marked blue line).
In this example code with synthetic data, the differences are minor. But with real data, the figures look pretty different as many red lines (recent data points with high temperatures) disappear in the background. So, how can you retain the order in transition_reveal() by date? Any help appreciated, thanks a lot!
This isn't the answer per se. This is the why. You'll have to tell me what you prefer given this information for me to give you a solution.
I tried a few things—each of which I was just sure would work but did not. So, I wanted to see what was happening in ggplot. My hunch proved correct. Your data is in order of value_yr in the png, not year.
I repeat this question at the end:
Either you can put the animation in order of value_yr or you can put the color in ggplot in order by year. Which would you prefer?
How do I know? I extracted the assigned colors in the object.
tellMe <- ggplot_build(temp)$data[[1]]
head(tellMe)
# colour x y group PANEL flipped_aes size linetype alpha
# 1 #1E60A4 1 -1.75990067 1 1 FALSE 0.6 1 NA
# 2 #1E60A4 2 -0.08968196 1 1 FALSE 0.6 1 NA
# 3 #1E60A4 3 -0.69657130 1 1 FALSE 0.6 1 NA
# 4 #1E60A4 4 -0.10777727 1 1 FALSE 0.6 1 NA
# 5 #1E60A4 5 1.57710505 1 1 FALSE 0.6 1 NA
# 6 #1E60A4 6 1.63277369 1 1 FALSE 0.6 1 NA
gimme <- tellMe %>% group_by(group) %>%
summarise(color = unique(colour)) %>%
print(n = 100) # there are less than 100, I just want them all
head(gimme)
# # A tibble: 6 × 2
# group color
# <int> <chr>
# 1 1 #1E60A4
# 2 2 #114781
# 3 3 #175290
# 4 4 #053061
# 5 5 #1C5C9E
# 6 6 #3E8BBF
To me, this indicated that the colors weren't in group order, so I wanted to see the colors to visualize the order.
I used this function. I know it came from a demo, but I don't remember which one. I looked just so I could include that here, but I didn't find it.
# this is from a demo (not sure which one anymore!
showCols <- function(cl=colors(), bg = "lightgrey",
cex = .75, rot = 20) {
m <- ceiling(sqrt(n <-length(cl)))
length(cl) <- m*m; cm <- matrix(cl, m)
require("grid")
grid.newpage(); vp <- viewport(w = .92, h = .92)
grid.rect(gp=gpar(fill=bg))
grid.text(cm, x = col(cm)/m, y = rev(row(cm))/m, rot = rot,
vp=vp, gp=gpar(cex = cex, col = cm))
}
showCols(gimme$color)
The top left color is the oldest year, the value below it is the following year, and so on. The most recent year is the bottom value in the right-most column.
df %>% group_by(yr) %>% summarise(value_yr = unique(value_yr))
# they are in 'value_yr' order in ggplot, not year
# # A tibble: 71 × 2
# yr value_yr
# <int> <dbl>
# 1 1950 0.0380
# 2 1951 -0.215
# 3 1952 -0.101
# 4 1953 -0.459
# 5 1954 -0.00130
# 6 1955 0.559
# 7 1956 -0.457
# 8 1957 -0.251
# 9 1958 1.10
# 10 1959 0.282
# # … with 61 more rows
Either you can put the animation in order of value_yr or you can put the color in ggplot in order by year. Which would you prefer?
Update
You won't use transition_reveal to group and transition by the same element. Unfortunately, I can't tell you why, but it seems to get stuck at 1958!
To make this gif on the left match that ggplot png on the right:
First, I modified the calls to ggplot and geom_line
ggplot(aes(x = month(date, label = T), y = value,
group = yr, color = yr)) +
geom_line(size = .6)
Then I tried to use transition_reveal but noticed that subsequent years were layered underneath other years. I can't account for that odd behavior. When I ran showCol after changing temp, the colors were in order. That ruled out what I had thought the problem was initially.
I modified the object anim, using transition_manual to force the order of the plot layers.
anim <- temp +
transition_manual(yr, cumulative = T) +
ease_aes('linear')
That's it. Now the layers match.
As to whether this would have worked before you changed the color assignment: original plot with manual transitions of the year on the left, ggplot png on the right:
It looks like that would've have worked, as well. So, my original drawn-out explanation wasn't nearly as useful as I thought, but at least you have a working solution now. (Sigh.)
I would like to plot a legend with two axes. Specifically, I have combined two spatial objects that have been classified, the first showing intensity of an event and the second showing the probability of the event at that location. I want to create a legend that shows where the pixels of the combined raster fall in each category. The legend I'd like to create would look something like this:
Legend with two axes.
The normal legend of the classified data looks like this: Original legend
Here is a reproducible example of the type of data I'm using:
library(raster)
library(rasterVis)
# setseed
set.seed(999)
# create raster (example of what would be the outcome of combining intensity and probability rasters)
plot.me<- raster(xmn=-110, xmx=-90, ymn=40, ymx=60, ncols=40, nrows=40)
val <- c(100:104, 200:204, 300:304, 400:404)
plot.me<- setValues(plot.me, sample(val,ncell(plot.me),replace=T))
###### Plotting
plot.me <- ratify(plot.me)
levelplot(plot.me,att="ID" ,
col.regions=c("#beffff","#73dfff","#d0ff73","#55ff00",
"#73b2ff","#0070ff","#70a800","#267300",
"#f5f57a","#ffff00","#e8beff","#df73ff",
"#f5ca7a","#ffaa00","#e600a9","#a80084"))
Plot output from above
The easiest way would be to create the plot and add the legend later in a graphics editor.... but I'm sure there must be a way to do this in R itself! I'm currently plotting with the rasterVis package, but if there are answers in ggplot or base R, these are equally welcome.
If it would be more useful to have a reproducible example of the intermediate steps (ie with the intensity/ probability rasters) let me know and I can produce those.
One solution will be to make two plots and combine them using grid.arrange function from gridExtra package for example
First, I convert your rasterLayer into a tibble by using the function posted on this post: Overlay raster layer on map in ggplot2 in R?
(PS: I modified your val object in order to make only 16 different colors matching the color pattern you provided. In your example, val has 20 different values)
val <- c(101:104, 201:204, 301:304, 401:404) # correction from OP's question to match 16 different values
library(raster)
gplot_data <- function(x, maxpixels = 50000) {
x <- raster::sampleRegular(x, maxpixels, asRaster = TRUE)
coords <- raster::xyFromCell(x, seq_len(raster::ncell(x)))
## Extract values
dat <- utils::stack(as.data.frame(raster::getValues(x)))
names(dat) <- c('value', 'variable')
dat <- dplyr::as.tbl(data.frame(coords, dat))
if (!is.null(levels(x))) {
dat <- dplyr::left_join(dat, levels(x)[[1]],
by = c("value" = "ID"))
}
dat
}
df <- gplot_data(plot.me)
Then, I create the fist plot, the heatmap using geom_tile:
library(ggplot2)
plot <- ggplot(df, aes(x = x, y = y, fill = as.factor(value)))+
geom_tile(show.legend = FALSE)+
coord_fixed(ratio = 20/20)+
scale_fill_manual(values = c("#beffff","#73dfff","#d0ff73","#55ff00",
"#73b2ff","#0070ff","#70a800","#267300",
"#f5f57a","#ffff00","#e8beff","#df73ff",
"#f5ca7a","#ffaa00","#e600a9","#a80084"))+
scale_y_continuous(name = "Latitude",labels = paste(c(40,45,50,55,60),"°N"))+
scale_x_continuous(name = "Longitude",labels = paste(c(-110,-105,-100,-95,-90),"°W"))+
theme_linedraw()+
theme(panel.border = element_rect(size = 2),
axis.text = element_text(size = 10),
axis.title = element_text(size = 10),
panel.grid.major = element_blank(),
panel.grid.minor = element_blank())
Then, I create a separate dataframe for the legend:
library(tidyverse)
df_legend <- data.frame(value = unique(df$value))
df_legend <- df_legend %>% rowwise() %>%
mutate(Dim1 = unlist(strsplit(as.character(value),""))[1],
Dim3 = unlist(strsplit(as.character(value),""))[3])
Source: local data frame [16 x 3]
Groups: <by row>
# A tibble: 16 x 3
value Dim1 Dim3
<int> <chr> <chr>
1 404 4 4
2 204 2 4
3 304 3 4
4 104 1 4
5 202 2 2
6 302 3 2
7 203 2 3
8 301 3 1
9 402 4 2
10 401 4 1
11 303 3 3
12 102 1 2
13 201 2 1
14 103 1 3
15 403 4 3
16 101 1 1
Now, I made the plot for the legend:
legend <- ggplot(df_legend, aes(x = as.factor(Dim1), y = as.factor(Dim3), fill = as.factor(value)))+
geom_tile(show.legend = FALSE, color = "black")+
coord_fixed(ratio = 1)+
scale_fill_manual(values = c("#beffff","#73dfff","#d0ff73","#55ff00",
"#73b2ff","#0070ff","#70a800","#267300",
"#f5f57a","#ffff00","#e8beff","#df73ff",
"#f5ca7a","#ffaa00","#e600a9","#a80084"))+
theme_linedraw()+
labs(x = "Dim1", y = "Dim3")+
theme(panel.border = element_rect(size = 2),
axis.text = element_text(size = 10),
axis.title = element_text(size = 10))
And finally, I combine them:
library(gridExtra)
grid.arrange(plot, legend, layout_matrix = rbind(c(1,1,2),c(1,1,3)))
Does it look what you are trying to get ?
NB: You can probably plot directly your raster object into ggplot2 but I was not sure of the exact procedure. Also, you can play with the layout of grid.arrange in order to make the plot look exactly what you want
how can you make a ladder plot in R, please.
Here is a data example:
d <- data.frame("Subject" = 1:10,
"Group" = c(rep(1, 6), rep(2, 4)),
"Gender" = c(rep("male" ,2), rep("female", 6), rep("male", 2)),
"Y1" = rnorm(10, 100, 30),
"Y2" = rnorm(10, 3000, 1000))
in this ladderplot:
Need to show those with high Y1 also have high Y2
display the correlations for the "Group" and "Gender" factors
show the Y axis ticks on the left for Y1 and on the right for Y2
The two variables (Y1 and Y2) are to be connected for each subject with solid lines for Group 1 and dotted lines for Group 2, red for males and blue for females.
There is something about package plotrix but I cant seem to find details.
The ggplot2 library is so flexible, I'd use that, instead of looking for a canned routine. Here's code that has the basics of the ladder graph. Look at the existing documentation for things like secondary axes, and changing the scales of color & linetype. I'm leaving this so your post feels like it's asking a focused question (and won't be flagged as a request for a code writing service).
The important step below actually comes before the graphing call. Change your 'wide' format to 'long.
library(magrittr)
library(ggplot2)
set.seed(100)
d <- data.frame(
Subject = 1:10,
Group = c(rep(1, 6), rep(2, 4)),
Gender = c(rep("male" ,2), rep("female", 6), rep("male", 2)),
Y1 = rnorm(10, 100, 30),
Y2 = rnorm(10, 3000, 1000)
)
d_long <- d %>%
tidyr::gather(key=Time, value=Score, -Subject, -Group, -Gender) %>%
dplyr::mutate(
Group = factor(Group)
)
ggplot(d_long, aes(x=Time, y=Score, group=Subject, linetype=Group, color=Gender)) +
geom_line()
Results
> head(d_long)
Subject Group Gender Time Score
1 1 1 male Y1 84.93423
2 2 1 male Y1 103.94593
3 3 1 female Y1 97.63249
4 4 1 female Y1 126.60354
5 5 1 female Y1 103.50914
6 6 1 female Y1 109.55890
Thank you wibeasley for your input! it was greatly helpful. I used however the following code to generate my results.
# Melt dataset for plot:
library(reshape)
melted_data<-melt(d, id.vars=c("Subject","Group","Sex"),measure.vars= c("Y1","Y2"))
melted_data$Group<-as.factor(melted_data$Group)
# calcuate R2 per Group and Sex combination
require(plyr)
func <- function(xx)
{ return(data.frame(R2 = round (cor(xx$Y1, xx$Y2),6)))}
CorrDataset<-ddply(d, .(Group,Sex), func)
# plot:
library(gridExtra)
library(ggplot2)
set.seed(1)
p <-ggplot(melted_data, aes(x=variable, y=value, group=Subject, linetype=Group, color=Sex)) +
geom_line(size=1)
#p <- p + scale_y_continuous(sec.axis = sec_axis(~ scale(.), name = "Y2"))
p+theme(legend.position="top",
axis.line.x = element_line(color="black", size = 2),
axis.line.y = element_line(color="black", size = 2),
panel.grid.major = element_blank(),
panel.grid.minor = element_blank(),
panel.border = element_blank(),
panel.background = element_blank())+
annotation_custom(tableGrob(CorrDataset,rows = rownames(CorrDataset)), ymin=4000, ymax=4000)
Please note: For the second Y axis, its commented out in the code above.
I am using hline from ggplot to construct an axis for a data set I am looking out. Essentially I want to selectively color this axis based on a dataframe. This dataframe consists of an array of (7684, 7685,...,7853) and each corresponds to a letter "a", "b", "c", and "d". I would like to correspond each letter with a color used to color that interval on the axis.
For example row 1 of this data frame is: (7684, "c") so I would want to color the interval on the axis from 7684 to 7685 the color of "c" which could be red for instance. I have yet to think of a straightforward solution to this, I am not sure if hline would be the way to go with this.
> df
p nucleotide
1 c 7684
2 c 7685
3 t 7686
4 t 7687
5 a 7688
6 c 7689
7 a 7690
8 t 7691
9 a 7692
10 c 7693
Small snippet of what I am talking about. Basically want to associate df$p with colors. And color the interval of the corresponding df$nucleotide
You never use a for loop in ggplot and you should never use df$.. in an aesthetic.
library(dplyr)
library(ggplot2)
ggplot(df) +
geom_segment(aes(x = nucleotide, xend = lead(nucleotide), y = 1, yend = 1, color = p), size = 4)
#> Warning: Removed 1 rows containing missing values (geom_segment).
This takes us half the way. What is does is draw a segment from x to xend. x is mapped to the nucleotide value, xend is mapped to lead(nucleotide), meaning the next value. This of course lead to leaving out the last line, as it does not have a next value.
The following code takes care of that, admittedly in a hackish way, adding a row to the df, and then limiting scale_x . It may be not generalizable.
It also add some graphical embellishment.
df %>%
add_row(p = '', nucleotide = max(.$nucleotide) + 1) %>%
ggplot() +
geom_segment(aes(x = nucleotide, xend = lead(nucleotide), y = 1, yend = 1, color = p), size = 4) +
geom_text(aes(x = nucleotide, y = 1, label = nucleotide), nudge_x = .5, size = 3) +
scale_x_continuous(breaks = NULL, limits = c(min(df$nucleotide), max(df$nucleotide) + 1)) +
scale_color_brewer(palette = 'Dark2', limits = c('a', 'c', 't'), direction = 1) +
theme(aspect.ratio = .2,
panel.background = element_blank(),
axis.text.y = element_blank(),
axis.ticks.y = element_blank(),
axis.title.y = element_blank())
#> Warning: Removed 1 rows containing missing values (geom_segment).
#> Warning: Removed 1 rows containing missing values (geom_text).
Data
df <- read.table(text = ' p nucleotide
1 c 7684
2 c 7685
3 t 7686
4 t 7687
5 a 7688
6 c 7689
7 a 7690
8 t 7691
9 a 7692
10 c 7693', header = T)
Essentially, I have a dataset in which I have 4 columns containing the following information: individuals ("Ind"), the geographic population to which those individuals belong ("Pop"), the proportion of their genome that belongs to cluster1 and the proportion of their genome that belongs to cluster2 (these last two add up to 1).
Example:
Ind <- c(1:20)
Pop <- rep(1:2, each = 10)
set.seed(234)
Cluster1 <- runif(20, 0.0, 1.0)
Cluster2 <- 1-Cluster1
df <- data.frame(Ind, Pop, Cluster1, Cluster2)
Data:
Ind Pop Cluster1 Cluster2
1 1 1 0.745619998 0.25438000
2 2 1 0.781712425 0.21828758
3 3 1 0.020037114 0.97996289
4 4 1 0.776085387 0.22391461
5 5 1 0.066910093 0.93308991
6 6 1 0.644795124 0.35520488
7 7 1 0.929385959 0.07061404
8 8 1 0.717642189 0.28235781
9 9 1 0.927736510 0.07226349
10 10 1 0.284230120 0.71576988
11 11 2 0.555724930 0.44427507
12 12 2 0.547701653 0.45229835
13 13 2 0.582847855 0.41715215
14 14 2 0.582989913 0.41701009
15 15 2 0.001198341 0.99880166
16 16 2 0.441117854 0.55888215
17 17 2 0.313152501 0.68684750
18 18 2 0.740014466 0.25998553
19 19 2 0.138326844 0.86167316
20 20 2 0.871777777 0.12822222
I want to try and produce a plot using ggplot2 that resembles the "A" panel in this figure. In this figure, each individual is a bar with the proportion of each cluster, but the x ticks are the populations and the vertical grids separate these populations. I know that I can easily produce a stacked histogram if I ignore Pop and use melt(). But I would like to know how to incorporate Pop to produce elegant an elegant plot such as the one in the link above.
Thanks!
How about melting with both Ind and Pop as id variables and graphing it with a facet_grid? It's not 100% like the plot you were looking for but gets pretty close with a few theme adjustments:
dfm <- melt(df, id = c("Ind", "Pop"))
ggplot(dfm, aes(Ind, value, fill = variable)) +
geom_bar(stat="identity", width = 1) +
facet_grid(~Pop, scales = "free_x") +
scale_y_continuous(name = "", expand = c(0, 0)) +
scale_x_continuous(name = "", expand = c(0, 0), breaks = dfm$Ind) +
theme(
panel.border = element_rect(colour = "black", size = 1, fill = NA),
strip.background = element_rect(colour = "black", size = 1),
panel.margin = unit(0, "cm"),
axis.text.x = element_blank()
)
UPDATE: my example fails to cover the more complex case of multiple populations with uneven numbers of individuals. Quick amendment to deal with this case using the spaces = "free_x" attribute, complete code for example:
require(ggplot2)
require(reshape2)
require(grid)
Ind <- c(1:30)
Pop <- rep(paste("Pop", 1:3), times = c(5, 15, 10))
set.seed(234)
Cluster1 <- runif(30, 0.0, 1.0)
Cluster2 <- 1-Cluster1
df <- data.frame(Ind, Pop, Cluster1, Cluster2)
dfm <- melt(df, id = c("Ind", "Pop"))
ggplot(dfm, aes(Ind, value, fill = variable)) +
geom_bar(stat="identity", width = 1) +
facet_grid(~Pop, scales = "free_x", space = "free_x") +
scale_y_continuous(name = "", expand = c(0, 0)) +
scale_x_continuous(name = "", expand = c(0, 0), breaks = dfm$Ind) +
theme(
panel.border = element_rect(colour = "black", size = 1, fill = NA),
strip.background = element_rect(colour = "black", size = 1),
panel.margin = unit(0, "cm"),
axis.text.x = element_blank()
)