color ggplot using specific pallette - r

How can I color the plots such that -
A1 - Dark blue,
A2 - Light blue,
B1 - Dark red,
B2 - Light red
tbl <- tibble(x = c(rnorm(n = 100, mean = 0, sd = 1),
rnorm(n = 100, mean = 0, sd = 0.5),
rnorm(n = 100, mean = 4, sd = 1),
rnorm(n = 100, mean = 4, sd = 0.5)),
y = c(rep("A1", 100),
rep("A2", 100),
rep("B1", 100),
rep("B2", 100))
)
ggplot(data = tbl,
aes(x = x,
fill = y)) +
geom_histogram(color = "black",
alpha = 0.5) +
theme_bw()

I arbitrarily chose the colors (Dark blue ~ Light Red).
You can change the colors manually using hexcode in sclae_fill_manual.
tbl <- tibble(x = c(rnorm(n = 100, mean = 0, sd = 1),
rnorm(n = 100, mean = 0, sd = 0.5),
rnorm(n = 100, mean = 4, sd = 1),
rnorm(n = 100, mean = 4, sd = 0.5)),
y = c(rep("A1", 100),
rep("A2", 100),
rep("B1", 100),
rep("B2", 100))
)
ggplot(data = tbl,
aes(x = x,
fill = y)) +
geom_histogram(color = "black",
alpha = 0.5) +
scale_fill_manual(values = c('#2C3FF6','#72B5FC','#F62C2C','#F0C3C3'))+
theme_bw()
#> `stat_bin()` using `bins = 30`. Pick better value with `binwidth`.
Created on 2022-05-18 by the reprex package (v2.0.1)

Similar to the answer above but a little more verbose using a named vector of colors.
# Create a named vector of colors
# There is no R color named "light red" therefore I used red instead.
colours <- c(A1= "darkblue", A2="lightblue", B1= "darkred", B2= "red")
ggplot(data = tbl,
aes(x = x,
fill = y)) +
geom_histogram(color = "black",
alpha = 0.5) +
scale_fill_manual(values = colours) +
theme_bw()

Related

Map shape, size and color to the same legend in ggplot2

I am trying to make a figure in ggplot where color, shape and size are mapped to a variable as follows: 0 values are shown as red crosses. Values > 0 are shown as circles with the circle size and color scaled to the variable (i.e. the larger the circle, the higher the value). I want to use a binned viridis scale for the color. The values mapped to color vary randomly, so the scaling should not be hardcoded. Here is the figure:
library(tidyverse)
x <- tibble(x = sample(1:100, 10), y = sample(1:100, 10), z = c(0, sample(1:1e6, 9)))
color_breaks <- sort(unique(c(0, 1, pretty(x$z, n = 5), ceiling(max(x$z)))))
ggplot(x, aes(x = x, y = y, color = z, shape = z == 0, size = z)) +
geom_point(stroke = 1.5) +
scale_shape_manual(values = c(`TRUE` = 3, `FALSE` = 21), guide = "none") +
scale_size(range = c(1, 8),
breaks = color_breaks,
limits = c(0, ceiling(max(x$z)))
) +
binned_scale(aesthetics = "color",
scale_name = "stepsn",
palette = function(x) c("red", viridis::viridis(length(color_breaks) - 3)),
limits = c(0, ceiling(max(x$z))),
breaks = color_breaks,
show.limits = TRUE
) +
guides(color = guide_legend(), size = guide_legend()) +
theme_bw()
Created on 2022-03-31 by the reprex package (v2.0.1)
How do I combine the variables to a single legend, which should look like this (edited in Illustrator)?
You can override the aesthetics inside guides:
x <- tibble(x = sample(1:100, 10), y = sample(1:100, 10), z = c(0, sample(1:1e6, 9)))
color_breaks <- sort(unique(c(0, pretty(x$z, n = 5)[-6], ceiling(max(x$z)) + 1)))
ggplot(x, aes(x = x, y = y, color = z, shape = z == 0, size = z)) +
geom_point(stroke = 1.5) +
scale_shape_manual(values = c(`TRUE` = 3, `FALSE` = 21), guide = "none") +
scale_size(range = c(1, 8),
breaks = color_breaks,
limits = c(-1, ceiling(max(x$z)) + 2)
) +
binned_scale(aesthetics = "color",
scale_name = "stepsn",
palette = function(x) c("red", viridis::viridis(length(color_breaks) - 1)),
limits = c(-1, ceiling(max(x$z)) + 2),
breaks = color_breaks,
show.limits = FALSE
) +
guides(color = guide_legend(),
size = guide_legend(override.aes = list(shape = c(3, rep(16, 5))))) +
theme_bw()

How to predefine legend colours based on value range using ggplot2 and RColorBrewer?

I have some data from a range of tests that I'm calculating STEN scores for. I'm aiming to visualise this data in the form of a circular bar plot and would like to set the colour gradient based on a STEN score range. For example, a score of 0-2 would be a very light colour, 2.1-4 light, 4.1-6 moderate, 6.1-8 dark and 8.1-10 very dark. My code below uses the RColorBrewer package and the "YlGn" palette, but I'm stuck on how I can predefine the colour scheme based on the example mentioned above and set this in the plot legend. The example below produces a circular bar plot containing a lowest STEN score of 4.8, so I would like this to be reflected as the moderate colour, where currently its the lightest. I essentially want the legend to show all five STEN score ranges irrespective of whether someone's data scores within each range. Hope this makes sense.
library(tidyverse)
library(RColorBrewer)
set.seed(50)
dat <- data.frame(
par = paste("par", 1:15),
test_1 = round(rnorm(15, mean = 30, sd = 5), 1),
test_2 = round(rnorm(15, mean = 30, sd = 5), 1),
test_3 = round_any(rnorm(15, mean = 90, sd = 5), 2.5),
test_4 = round(rnorm(15, mean = 5.4, sd = 0.3), 1),
test_5 = round(rnorm(15, mean = 17, sd = 1.5), 1)
)
sten_dat <- dat %>%
mutate_if(is.numeric, scale) %>%
mutate(across(c(2:6), ~ . * 2 + 5.5)) %>%
mutate(across(where(is.numeric), round, 1)) %>%
pivot_longer(!par, names_to = "test", values_to = "sten") %>%
filter(par == "par 1")
ggplot(sten_dat) +
geom_col(aes(x = str_wrap(test), y = sten, fill = sten),
position = "dodge2", alpha = 0.7, show.legend = TRUE) +
coord_polar() +
scale_y_continuous(limits = c(-1, 11), breaks = seq(0, 10, 2)) +
scale_fill_gradientn(colours = brewer.pal(name = "YlGn", n = 5))`
Simply add limits to your fill scale:
ggplot(sten_dat) +
geom_col(aes(x = str_wrap(test), y = sten, fill = sten),
position = "dodge2", alpha = 0.7, show.legend = TRUE) +
coord_polar() +
scale_y_continuous(limits = c(-1, 11), breaks = seq(0, 10, 2)) +
scale_fill_gradientn(colours = brewer.pal(name = "YlGn", n = 5),
limits = c(0, 10))
If you want the colors to be clearly "binned" in the way you describe, you can use scale_fill_stepn instead of scale_fill_gradientn
ggplot(sten_dat) +
geom_col(aes(x = str_wrap(test), y = sten, fill = sten),
position = "dodge2", alpha = 0.7, show.legend = TRUE) +
scale_y_continuous(limits = c(-1, 11), breaks = seq(0, 10, 2)) +
scale_fill_stepsn(colours = brewer.pal(name = "YlGn", n = 5),
limits = c(0, 10), breaks = 0:5 * 2) +
geomtextpath::coord_curvedpolar() +
theme_minimal() +
theme(axis.text.x = element_text(size = 16, face = 2),
panel.grid.major.x = element_blank())

scales_fill_continuous doesn't work (ggplot2)

I have a data:
df_1 <- data.frame(
x = replicate(
n = 2, expr = rnorm(n = 3000, mean = 100, sd = 10)
),
y = sample(x = 1:3, size = 3000, replace = TRUE)
)
And the follow function:
library(tidyverse)
ggplot(data = df_1, mapping = aes(x = x.1, fill = x.1)) +
geom_histogram(color = 'black', bins = 100) +
scale_fill_continuous(low = 'blue', high = 'red') +
theme_dark()
scale_fill_continuous doesn't work. The graph is black and gray.
Tks.
The problem, I think, is that there are nrow(df_1) values for fill, but only 100 are needed. This could be solved by pre-calculating the bin positions and counts and plotting with geom_col, but a neater solution is to use stat. stat is supposed to be for computed variables (e.g. stat(count) - see ?geom_histogram) but we can give it the vector 1:nbin and it works.
df_1 <- data.frame(
x = replicate(n = 2, expr = rnorm(n = 3000, mean = 100, sd = 10)),
y = sample(x = 1:3, size = 3000, replace = TRUE)
)
library(tidyverse)
nbins <- 100
ggplot(data = df_1, mapping = aes(x = x.1, fill = stat(1:nbins))) +
geom_histogram(bins = nbins) +
scale_fill_continuous(low = "red", high = "blue")
Created on 2020-01-19 by the reprex package (v0.3.0)
The aes fill should be stat(count) rather than x.1
ggplot(data = df_1, mapping = aes(x = x.1, fill = stat(count))) +
geom_histogram(color = 'black', bins = 100) +
scale_fill_continuous(type = "gradient", low = "blue", high = "red") +
theme_dark()

how to ggplot with upper and lower bound as shaded using facet_wrap in R?

I am trying to automate the process of plotting data using ggplot and the facet_wrap functionality. I want a single y-axis label instead individual plot Ob (i.e., A_Ob, B_ob etc) and also a single X-axis not all the plots having label for x-axis such as below. Below is my sample code using gridextra package. However, i would like to do it through facet_wrap as i have many other plots to draw which i think will save me sometime.
graphics.off()
rm(list = ls())
library(tidyverse)
library(gridExtra)
G1 = data.frame(A_Ob = runif(1000, 5, 50), A_Sim = runif(1000, 3,60), A_upper = runif(1000, 10,70), A_lower = runif(1000, 0, 45 ),
B_Ob = runif(1000, 5, 50), B_Sim = runif(1000, 3,60), B_upper = runif(1000, 10,70), B_lower = runif(1000, 0, 45 ),
C_Ob = runif(1000, 5, 50), C_Sim = runif(1000, 3,60), C_upper = runif(1000, 10,70), C_lower = runif(1000, 0, 45 ),
D_Ob = runif(1000, 5, 50), D_Sim = runif(1000, 3,60), D_upper = runif(1000, 10,70), D_lower = runif(1000, 0, 45 ),
Pos = 1:1000)
A1 = ggplot(data = G1, aes(x = Pos))+
geom_line(aes(y = A_Ob), col = "black")+
geom_line(aes(y = A_Sim), col = "blue")+
geom_vline(xintercept = 750, color = "red", size=1.5)+
geom_ribbon(aes(ymin = A_upper, ymax = A_lower), fill = "grey70")
B1 = ggplot(data = G1, aes(x = Pos))+
geom_line(aes(y = B_Ob), col = "black")+
geom_line(aes(y = B_Sim), col = "blue")+
geom_vline(xintercept = 750, color = "red", size=1.5)+
geom_ribbon(aes(ymin = B_upper, ymax = B_lower), fill = "grey70")
C1 = ggplot(data = G1, aes(x = Pos))+
geom_line(aes(y = C_Ob), col = "black")+
geom_line(aes(y = C_Sim), col = "blue")+
geom_vline(xintercept = 750, color = "red", size=1.5)+
geom_ribbon(aes(ymin = C_upper, ymax = C_lower), fill = "grey70")
D1 = ggplot(data = G1, aes(x = Pos))+
geom_line(aes(y = D_Ob), col = "black")+
geom_line(aes(y = D_Sim), col = "blue")+
geom_vline(xintercept = 750, color = "red", size=1.5)+
geom_ribbon(aes(ymin = D_upper, ymax = D_lower), fill = "grey70")
grid.arrange(A1,B1,C1,D1, nrow = 4)
Here is the result of the code
You need to reshape your dataframe into a longer format and separate values for Ob, Sim, upper and lower.
Using the function melt from data.table package can help you to achieve this:
library(data.table)
setDT(G1)
Ob_cols = grep("_Ob",colnames(G1),value = TRUE)
Sim_cols = grep("_Sim",colnames(G1),value = TRUE)
Upper_cols = grep("_upper",colnames(G1), value = TRUE)
Lower_cols = grep("_lower", colnames(G1), value = TRUE)
g.m <- melt(G1, measure = list(Ob_cols,Sim_cols,Upper_cols,Lower_cols), value.name = c("OBS","SIM","UP","LOW"))
levels(g.m$variable) <- c("A","B","C","D")
Pos variable OBS SIM UP LOW
1: 1 A 5.965488 29.167666 26.66783 29.97259
2: 2 A 23.855719 8.570245 43.75830 30.65616
3: 3 A 16.947887 51.201047 15.20758 39.76122
4: 4 A 49.883306 3.715319 34.38066 20.73177
5: 5 A 5.021938 3.102880 30.05036 32.05123
6: 6 A 19.887176 15.400853 53.67156 28.54982
and now, you can plot it:
library(ggplot2)
ggplot(g.m, aes(x = Pos))+
geom_line(aes(y = OBS), color = "black")+
geom_line(aes(y = SIM), color = "blue")+
geom_vline(xintercept = 750,color = "red", size = 1.5)+
geom_ribbon(aes(ymin = UP, ymax = LOW), fill = "grey70")+
facet_grid(variable~.)
EDIT: Adding annotations & renaming labels
To rename and replace facet labels, you can re-define levels of variable and use facet_wrap instead of facet_grid using ncol = 1 as argument.
To add multiple annotations on a single panel, you need to define a dataframe that you will use in geom_text.
Altogether, you have to do:
# renaming names of each facets:
levels(g.m$variable) <- c("M1","M2","M3","M4")
# Defining annotations to add:
df_text <- data.frame(label = c("Calibration", "Validation"),
x = c(740,760),
y = c(65,65),
hjust = c(1,0),
variable = factor("M1", levels = c("M1","M2","M3","M4")))
# Plotting
ggplot(g.m, aes(x = Pos))+
geom_line(aes(y = OBS), color = "black")+
geom_line(aes(y = SIM), color = "blue")+
geom_vline(xintercept = 750,color = "red", size = 1.5)+
geom_ribbon(aes(ymin = UP, ymax = LOW), fill = "grey70")+
facet_wrap(variable~., ncol = 1)+
theme(strip.text.x = element_text(hjust = 0),
strip.background = element_rect(fill = "white"))+
geom_text(data = df_text, aes(x = x, y = y, label = label, hjust = hjust), color = "red")
Does it look what you are expecting ?

shade block between two lines, values vary with facet_wrap

I'm plotting the relationships between speed and time for four different species (each in a different facet). For each species, I have a range of speeds I'm interested in, and would like to shade the area between the min and max values. However, these ranges are different for the 4th species compared to the first three.
#data to plot as points
species <- sample(letters[1:4], 40, replace = TRUE)
time <- runif(40, min = 1, max = 100)
speed <- runif(40, min = 1, max = 20)
df <- data.frame(species, time, speed)
#ranges of key speeds
sp <- letters[1:4]
minspeed <- c(5, 5, 5, 8)
maxspeed <- c(10, 10, 10, 13)
df.range <- data.frame(sp, minspeed, maxspeed)
ggplot() +
geom_hline(data = df.range, aes(yintercept = minspeed),
colour = "red") +
geom_hline(data = df.range, aes(yintercept = maxspeed),
colour = "red") +
geom_point(data=df, aes(time, speed),
shape = 1) +
facet_wrap(~species) +
theme_bw()
How do I:
get geom_hline to only plot the max and min ranges for the correct species, and
shade the area between the two lines?
For the later part, I've tried adding geom_ribbon to my plot, but I keep getting an error message that I'm unsure how to address.
geom_ribbon(data = df,
aes(ymin = minspeed, ymax = maxspeed,
x = c(0.0001, 100)),
fill = "grey",
alpha = 0.5) +
Error: Aesthetics must be either length 1 or the same as the data
(40): x, ymin, ymax
As per my comment, the following should work. Perhaps there are other unobserved differences between your actual use case & the example in your question?
colnames(df.range)[which(colnames(df.range) == "sp")] <- "species"
ggplot() +
geom_hline(data = df.range, aes(yintercept = minspeed),
colour = "red") +
geom_hline(data = df.range, aes(yintercept = maxspeed),
colour = "red") +
geom_point(data = df, aes(time, speed),
shape = 1) +
geom_rect(data = df.range,
aes(xmin = -Inf, xmax = Inf, ymin = minspeed, ymax = maxspeed),
fill = "grey", alpha = 0.5) +
facet_wrap(~species) +
theme_bw()
Data used:
df <- data.frame(species = sample(letters[1:4], 40, replace = TRUE),
time = runif(40, min = 1, max = 100),
speed = runif(40, min = 1, max = 20))
df.range <- data.frame(sp = letters[1:4],
minspeed = c(5, 5, 5, 8),
maxspeed = c(10, 10, 10, 13))

Resources