How do you create this gauge chart using ggplot? - r

I'm pretty new to R, and the answers to similar questions I've found out there are going way over my head.
I have a data frame res of survey responses. There is a row for each respondent and a column for each question. I want to visualise responses to a particular question res$Q13 as a gauge chart showing the proportion of respondents who answered "Yes".
The closest thing to what I'm aiming to produce is this: https://pomvlad.files.wordpress.com/2018/05/pomvlad-dials.png
I want a gauge chart that looks just like that one, but I obviously don't need the facet layer, I just need a single gauge chart. I've pared the code (source: https://pomvlad.blog/2018/05/03/gauges-ggplot2/ credit: https://pomvlad.blog/author/pomvlad/) back to the bits I think I need, commenting out the lines I think are unnecessary, and added in some random colours to help me identify which lines of code produce which bits of the chart:
ggplot(res, aes(fill = "violet", ymax = 100, ymin = 0, xmax = 2, xmin = 1)) +
geom_rect(aes(ymax=1, ymin=0, xmax=2, xmin=1), fill = "#ece8bd") +
geom_rect() +
coord_polar(theta = "y", start = -pi/2) + xlim(c(0, 2)) + ylim(c(0, 2)) +
geom_text(aes(x = 0, y = 0, label = "title1", colour = "blue"), size = 6.5) +
geom_text(aes(x = 1.5, y = 1.5, label = "title2"), size = 4.2) +
#facet_wrap(~title, ncol = 5) +
theme_void() +
#scale_fill_manual(values = c("red" = "#C9146C", "orange" = "#DA9112", "green" = "#129188")) +
#scale_colour_manual(values = c("red" = "#C9146C", "orange" = "#DA9112", "green" = "#129188")) +
theme(strip.background = element_blank(),
strip.text.x = element_blank()) +
guides(fill = FALSE) +
guides(colour = FALSE)
All I get is the yellow background of the gauge and the titles. I'm confused about how to make the gauge chart show the percentage of respondents who answered "Yes". Can anyone help? Thank you in advance!

Got it, thanks for the help!
Q13.GaugeChart <- ggplot(res, aes(fill = rag(round(nrow(res[res$Q13 == "Yes",])/nrow(res),2)), ymax = nrow(res[res$Q13 == "Yes",])/nrow(res), ymin = 0, xmax = 2, xmin = 1)) +
geom_rect(aes(ymax=1, ymin=0, xmax=2, xmin=1), fill = "#ece8bd") +
geom_rect() +
coord_polar(theta = "y", start = -pi/2) + xlim(c(0, 2)) + ylim(c(0, 2)) +
geom_text(aes(x = 0, y = 0, label = paste(round(100*nrow(res[res$Q13 == "Yes",])/nrow(res),0),"%", sep = ""), colour = rag(round(nrow(res[res$Q13 == "Yes",])/nrow(res),2)), size = 6.5)) +
geom_text(aes(x = 1, y = 1.5, label = "TITLE"), size = 4.2) +
theme_void() +
theme(legend.position = "none") +
scale_fill_manual(values = c("red" = "#C9146C", "orange" = "#DA9112", "green" = "#129188")) +
scale_colour_manual(values = c("red" = "#C9146C", "orange" = "#DA9112", "green" = "#129188")) +
theme(strip.background = element_blank(),
strip.text.x = element_blank()) +
guides(fill = FALSE) +
guides(colour = FALSE)

Related

How to hide information on graph from the Legend in ggplotly?

I have horizontal dots plot replotted via ggplotly
df <- data.frame (origin = c("A","B","C","D","E","F","G","H","I","J"),
Percentage = c(23,16,32,71,3,60,15,21,44,60),
rate = c(10,12,20,200,-25,12,13,90,-105,23),
change = c(10,12,-5,12,6,8,0.5,-2,5,-2)
library(ggplot2)
plt <- ggplot(df, aes(x = rate, y = factor(origin, rev(origin)))) +
geom_hline(aes(yintercept = origin), color = 'gray') +
geom_vline(xintercept = 0, linetype = 2, color = 'gray') +
geom_point(aes(color = 'Rate'), size = 10) +
geom_text(aes(label = rate), color = 'white') +
geom_point(aes(x = change, color = 'Change'), size = 10) +
geom_text(aes(label = change, x = change)) +
theme_minimal(base_size = 16) +
scale_x_continuous(labels = ~paste0(.x, '%'), name = NULL) +
scale_color_manual(values = c('#aac7c4', '#5f9299')) +
theme(panel.grid = element_blank(),
axis.text.y = element_text(color = 'gray50')) +
labs(color = NULL, y = NULL)
ggplotly(plt)
The only issue is that when I hide one of the dot from the figure, texts are still appeared (see below), so is there way to tackle this issue and hide text with circle by clicking on legend?
P.S
(setting text colour in white color = 'white' is not option for me)
You can use the fill aesthetic for the points (as long as they are shape = 21) and use the color aesthetic for the text. As long as these have the same labels for aesthetic mapping, the interactivity for both points and text will be linked.
One minor annoyance is that this changes the plotly legend labels, even though they are correct in the ggplot version. This requires a little direct manipulation of the plotly object itself:
plt <- ggplot(df, aes(x = rate, y = factor(origin, rev(origin)))) +
geom_segment(aes(x = -100, xend = 200,
y = origin, yend = origin), color = 'gray') +
geom_vline(xintercept = 0, linetype = 2, color = 'gray') +
geom_point(aes(fill = 'Rate'), shape = 21, size = 10, color = NA) +
geom_text(aes(label = rate, color = 'Rate')) +
geom_point(aes(x = change, fill = 'Change'),
color = NA, shape = 21, size = 10) +
geom_text(aes(label = change, x = change, color = "Change")) +
theme_minimal(base_size = 16) +
scale_x_continuous(labels = ~paste0(.x, '%'), name = NULL) +
scale_fill_manual(values = c('#aac7c4', '#5f9299')) +
scale_color_manual(values = c("black", "white")) +
theme(panel.grid = element_blank(),
axis.text.y = element_text(color = 'gray50')) +
labs(color = NULL, y = NULL, fill = NULL)
p <- ggplotly(plt)
p$x$data[[3]]$name <- p$x$data[[3]]$legendgroup <-
p$x$data[[4]]$name <- p$x$data[[4]]$legendgroup <- "Rate"
p$x$data[[5]]$name <- p$x$data[[5]]$legendgroup <-
p$x$data[[6]]$name <- p$x$data[[6]]$legendgroup <- "Change"
p
This gives us the following plot:
Now clicking on Rate we get:
And clicking on Change we get

How to avoid the crossing effect in legend with geom_vline() and geom_hline on the same scatter plot?

I created a scatter plot with geom_hline() and geom_vline(), the plot is good but the legend entries are not how I would like to make them appear. The vline (Restauration) and hline (Threshold) are crossing each other in the legend, making it confusing. I want the restauration legend entry to be an orange vertical line and the Threshold legend entry to be a horizontal black line.
I tried several things suggested in other posts, with guide_legend(override.aes()) or with show.legend = F but either it changed the legend entry for the "Type" section just above (it deleted the lines and kept the coloured circles) or it just deleted that legend entry for one of those lines.
Here is my current code:
ggplot(data = tst_formule[tst_formule$River != "Roya",], aes(x=Year, y = BRI_adi_moy_transect, shape = River, col = Type)) +
geom_point(size = 3) +
geom_errorbar(aes(ymin = BRI_adi_moy_transect - SD_transect, ymax = BRI_adi_moy_transect + SD_transect), width = 0.4) +
scale_shape_manual(values = c(15, 16, 17)) +
scale_colour_manual(values = c("chocolate1", "darkcyan")) +
geom_vline(aes(xintercept = Restauration_year, linetype = "Restoration"), colour = "chocolate1") +
geom_hline(aes(yintercept = 0.004, linetype = "Threshold"), colour= 'black') +
scale_linetype_manual(name = NULL, values = c(4, 5)) +
scale_y_continuous("BRI*", limits = c(min(tst_formule$BRI_adi_moy_transect - tst_formule$SD_transect),
max(tst_formule$BRI_adi_moy_transect + tst_formule$SD_transect))) +
scale_x_continuous(limits = c(min(tst_formule$Year - 1),max(tst_formule$Year + 1)), breaks = scales::breaks_pretty(n = 6)) +
theme_bw() +
facet_wrap(vars(River))
Here's a dput of my data:
structure(list(River = c("Durance", "Durance", "Durance", "Durance",
"Roya", "Var"), Reach = c("La Brillanne", "Les Mées", "La Brillanne",
"Les Mées", "Basse vallée", "Basse vallée"), Type = c("restaured",
"target", "restaured", "target", "witness", "restaured"), Year = c(2017,
2017, 2012, 2012, 2018, 2011), Restauration_year = c(2013, 2013,
2013, 2013, 2000, 2009), BRI_adi_moy_transect = c(0.0028, 0.0017,
0.0033, 0.0018, 0.009, 0.0045), SD_transect = c(0.00128472161839638,
0.000477209421076879, 0.00204050725984513, 0.000472466654940182,
0.00780731734792112, 0.00310039904793707)), row.names = c(NA,
6L), class = "data.frame")
Any idea how I could make it do what I want?
Create two Linetype scales. I have put the vline/hline calls to the bottom for better visibility.
library(tidyverse)
library(ggnewscale)
ggplot(data = tst_formule[tst_formule$River != "Roya",], aes(x=Year, y = BRI_adi_moy_transect, shape = River, col = Type)) +
geom_point(size = 3) +
geom_errorbar(aes(ymin = BRI_adi_moy_transect - SD_transect, ymax = BRI_adi_moy_transect + SD_transect), width = 0.4) +
scale_shape_manual(values = c(15, 16, 17)) +
scale_colour_manual(values = c("chocolate1", "darkcyan")) +
scale_y_continuous("BRI*", limits = c(min(tst_formule$BRI_adi_moy_transect - tst_formule$SD_transect),
max(tst_formule$BRI_adi_moy_transect + tst_formule$SD_transect))) +
scale_x_continuous(limits = c(min(tst_formule$Year - 1),max(tst_formule$Year + 1)), breaks = scales::breaks_pretty(n = 6)) +
theme_bw() +
facet_wrap(vars(River)) +
# here starts the trick
geom_vline(aes(xintercept = Restauration_year, linetype = "Restauration"), colour = "chocolate1") +
scale_linetype_manual(name = NULL, values = 4) +
# ggnewscale is an amazing package
new_scale("linetype") +
# now do the same for geom_hline
geom_hline(aes(yintercept = 0.004, linetype = "Threshold"), colour= 'black') +
scale_linetype_manual(name = NULL, values = 5)
It's a known problem documented in this issue https://github.com/tidyverse/ggplot2/issues/2483
No answers provided there and except of custom drawn legend key I don't think it's possible
I've found an incredibly not-generalisable workaround, but I thought I'd share anyway. The workaround is to write key glyph functions that conditionally output keys depending on the linetype. It is all a bit hardcoded, so I don't know how to generalize this. Here are the two functions:
glyph_vline <- function(data, params, size) {
if (data$linetype == 4) {
draw_key_vline(data, params, size)
} else {
zeroGrob()
}
}
glyph_hline <- function(data, params, size) {
if (data$linetype == 5) {
draw_key_path(data, params, size)
} else {
zeroGrob()
}
}
You'd need to feed these into the key_glyph arguments of the vline/hline layers. Like so:
ggplot(data = tst_formule[tst_formule$River != "Roya",], aes(x=Year, y = BRI_adi_moy_transect, shape = River, col = Type)) +
geom_point(size = 3) +
geom_errorbar(aes(ymin = BRI_adi_moy_transect - SD_transect, ymax = BRI_adi_moy_transect + SD_transect), width = 0.4) +
scale_shape_manual(values = c(15, 16, 17)) +
scale_colour_manual(values = c("chocolate1", "darkcyan")) +
geom_vline(aes(xintercept = Restauration_year, linetype = "Restoration"),
colour = "chocolate1", key_glyph = glyph_vline) +
geom_hline(aes(yintercept = 0.004, linetype = "Threshold"),
colour= 'black', key_glyph = glyph_hline) +
scale_linetype_manual(name = NULL, values = c(4, 5)) +
scale_y_continuous("BRI*", limits = c(min(tst_formule$BRI_adi_moy_transect - tst_formule$SD_transect),
max(tst_formule$BRI_adi_moy_transect + tst_formule$SD_transect))) +
scale_x_continuous(limits = c(min(tst_formule$Year - 1),max(tst_formule$Year + 1)), breaks = scales::breaks_pretty(n = 6)) +
theme_bw() +
facet_wrap(vars(River))

How can I change the colour of selected text within the title of ggplot in R? [duplicate]

I recently saw a line chart in the Economist where the title had colored words to match the colors of the groups used in the line chart. I was wondering how to do this with a ggplot2 object. Here is some code to make a line chart with everything like the econimist article except the colored words in the title. At the bottom I show the desired output.
This question is not about theoretical ways to display this info (like directly labeling or a legend) but rather specifically about coloring individual words in titles.
data <- data.frame(
group = rep(c('affluence', 'poverty'), each = 6),
year = rep(c(1970, 1980, 1990, 2000, 2010, 2012), 2),
concentration = c(.125, .12, .14, .13, .145, .146, .068, .09, .125, .119, .13, .135)
)
library(ggplot2)
ggplot(data, aes(year, concentration, color = group)) +
geom_line(size = 1.5) +
geom_point(size = 4) +
scale_y_continuous(limits = c(0, .15)) +
labs(
x = NULL, y = NULL,
title = 'Concentration of affluence and poverty nationwide'
) +
theme_minimal() +
theme(
legend.position = 'none'
) +
scale_color_manual(values = c('#EEB422', '#238E68'))
Here's a simple and more general way using the ggtext package
produced with:
library(ggtext)
ggplot(iris, aes(Sepal.Length, Sepal.Width, color = Species)) +
geom_point(size = 3) +
scale_color_manual(
name = NULL,
values = c(setosa = "#0072B2", virginica = "#009E73", versicolor = "#D55E00"),
labels = c(
setosa = "<i style='color:#0072B2'>I. setosa</i>",
virginica = "<i style='color:#009E73'>I. virginica</i>",
versicolor = "<i style='color:#D55E00'>I. versicolor</i>")
) +
labs(
title = "**Fisher's *Iris* dataset**
<span style='font-size:11pt'>Sepal width vs. sepal length for
<span style='color:#0072B2;'>setosa</span>,
<span style='color:#D55E00;'>versicolor</span>, and
<span style='color:#009E73;'>virginica</span>
</span>",
x = "Sepal length (cm)", y = "Sepal width (cm)"
) +
theme_minimal() +
theme(
plot.title = element_markdown(lineheight = 1.1),
legend.text = element_markdown(size = 11)
)
This solution is based on Displaying text below the plot generated by ggplot2 and Colorize parts of the title in a plot (credits to the contributors there!).
By using phantom placeholders for text, we avoid (most of the) hardcoding of positions.
# create text grobs, one for each color
library(grid)
t1 <- textGrob(expression("Concentration of " * phantom(bold("affluence")) * "and" * phantom(bold("poverty")) * " nationwide"),
x = 0.5, y = 1.1, gp = gpar(col = "black"))
t2 <- textGrob(expression(phantom("Concentration of ") * bold("affluence") * phantom(" and poverty nationwide")),
x = 0.5, y = 1.1, gp = gpar(col = "#EEB422"))
t3 <- textGrob(expression(phantom("Concentration of affluence and ") * bold("poverty") * phantom(" nationwide")),
x = 0.5, y = 1.1, gp = gpar(col = "#238E68"))
# plot and add grobs with annotation_custom
ggplot(data, aes(year, concentration, color = group)) +
geom_line(size = 1.5) +
geom_point(size = 4) +
annotation_custom(grobTree(t1, t2, t3)) +
scale_y_continuous(limits = c(0, 0.15)) +
scale_color_manual(values = c("#EEB422", "#238E68")) +
coord_cartesian(clip = "off") +
labs(x = NULL, y = NULL) +
theme_minimal() +
theme(legend.position = 'none',
# add some extra margin on top
plot.margin = unit(c(4, 1, 1, 1), "lines"))
With a larger number of colored words, the creation of the different expressions should be done more programmatically. See e.g. the nice multiTitle function in a similar question for base plot: title: words in different colors?, which should be useful in ggplot as well.
A somewhat cumbersome solution with annotation_custom:
ggplot(dat, aes(year, concentration, color = group)) +
geom_line(size = 1.5) +
geom_point(size = 4) +
scale_y_continuous(limits = c(0, 0.16)) +
labs(x = NULL, y = NULL, title = ' ') +
theme_minimal() +
theme(legend.position = 'none') +
scale_color_manual(values = c('#EEB422', '#238E68')) +
annotation_custom(textGrob('Concentration of', gp = gpar(col = 'black')),
xmin = 1972, xmax = 1972, ymin = 0.165, ymax = 0.165) +
annotation_custom(textGrob('affluence', gp = gpar(col = '#EEB422', fontface = 'bold')),
xmin = 1975.7, xmax = 1975.7, ymin = 0.165, ymax = 0.165) +
annotation_custom(textGrob(' and ', gp = gpar(col = 'black')),
xmin = 1977.65, xmax = 1977.65, ymin = 0.165, ymax = 0.165) +
annotation_custom(textGrob('poverty', gp = gpar(col = '#238E68', fontface = 'bold')),
xmin = 1979.35, xmax = 1979.35, ymin = 0.165, ymax = 0.165) +
annotation_custom(textGrob('nationwide', gp = gpar(col = 'black')),
xmin = 1982, xmax = 1982, ymin = 0.165, ymax = 0.165)
which gives:
Main drawback of this approach is that it requires a lot fiddling with the parameters to get the words of the title on the right spots.

How to scale a Geom_bar to be in line with an overlaid line graph in R ggplot

I am trying to overlay a bar chart with a line graph on a single plot with ggplot in R. My line graph works fine but the data are much larger than the data for the bar chart component.
How could I use an additional scale for this bar chart or do something that will get this to look nice all in one graph.
Here is my plot code thus far:
chart <- data.frame("QuantileName" = 1:5, "AvgLoss" = c(100, 500, 1000, 2500, 3000), "AvgFactor" = c(1.0, 1.1, 1.3, 1.4, 1.5))
Plot <- ggplot(chart, aes(x = 1:5)) +
scale_x_continuous(name = "Quintile", limits = c(0, 5 + .5), breaks = seq(1, 5)) +
geom_line(aes(y = AvgLoss, colour = "AvgLoss")) +
geom_bar(aes(y = AvgFactor, colour = "AvgFactor" ), stat = "identity") +
geom_text(aes(y = AvgLoss, label = round(AvgLoss)), position = position_nudge(x = .3)) +
geom_point(aes(y = AvgLoss)) +
ylab("AvgLoss") +
scale_colour_manual("",breaks = c("AvgLoss","AvgFactor"), values = c("AvgLoss" = "red", "AvgFactor" = "grey")) +
ggtitle("Quintile Plot") +
theme(plot.title = element_text(hjust=0.5))
Plot
Thank you for any help!
Essentialy, multiply your AvgFactor variable by a number
+ geom_bar(aes(y = AvgFactor*1000, colour = "AvgFactor" ), stat = "identity")
and set
+ scale_y_continuous(sec.axis = sec_axis(~ ./1000, name = "AvgFactor"))
so your plot code would look like
Plot <- ggplot(chart, aes(x = 1:5)) +
scale_x_continuous(name = "Quintile", limits = c(0, 5 + .5),
breaks = seq(1, 5)) +
geom_bar(aes(y = AvgFactor*1000, colour = "AvgFactor" ),
stat = "identity") +
geom_line(aes(y = AvgLoss, colour = "AvgLoss")) +
geom_text(aes(y = AvgLoss,
label = round(AvgLoss)),
position = position_nudge(x = .3)) +
geom_point(aes(y = AvgLoss)) +
ylab("AvgLoss") +
scale_colour_manual("",breaks = c("AvgLoss","AvgFactor"),
values = c("AvgLoss" = "red", "AvgFactor" = "grey")) +
ggtitle("Quintile Plot") +
theme(plot.title = element_text(hjust=0.5)) +
scale_y_continuous(sec.axis = sec_axis(~ ./1000, name = "AvgFactor"))
However, I think it is probably more elegant to avoid secondary axes whenever possible.
It may be useful to know that geom_col(...) is shorthand for geom_bar(..., stat = 'identity')

r - column wise heatmap using ggplot2

I would really appreciate if anyone could guide me with the following challenge.
I am trying to build column wise heatmap. For each column, I want the lowest value to be green and highest value to be red. The current solution takes a matrix wide approach.
I saw the solution on Heat map per column with ggplot2. As you can see, I implemented the same code but I am not getting the desired result [picture below]
df <- data.frame(
F1 = c(0.66610194649319, 0.666123551800434,
0.666100611954119, 0.665991102703081,
0.665979885730484),
acc_of_pred = c(0.499541627510021, 0.49960260221954,
0.499646067768102, 0.499447308828986,
0.499379552967265),
expected_mean_return = c(2.59756065316356e-07, 2.59799087404167e-07,
2.86466725381146e-07, 2.37977452007967e-07,
2.94242908573705e-07),
win_loss_ratio = c(0.998168189343307, 0.998411671274781,
0.998585272507726, 0.997791676357902,
0.997521287688458),
corr_pearson = c(0.00161443345430616, -0.00248811119331013,
-0.00203407575954095, -0.00496817102369628,
-0.000140531627184482),
corr_spearman = c(0.00214838517340878, -0.000308343671725617,
0.00228492127281917, -0.000359577740835049,
0.000608090759428587),
roc_vec = c(0.517972308828151, 0.51743161463546,
0.518033230192484, 0.518033294993802,
0.517931553535524)
)
combo <- data.frame(combo = c("baseline_120", "baseline_20",
"baseline_60", "baseline_288",
"baseline_5760"))
df.scaled <- scale(df)
df.scaled <- cbind(df.scaled,combo)
df.melt <- melt(df.scaled, id.vars = "combo")
ggplot(df.melt, aes(combo, variable)) +
geom_tile(aes(fill = value), colour = "white") +
scale_fill_gradient(low = "green", high = "red") +
geom_text(aes(label=value)) +
theme_grey(base_size = 9) +
labs(x = "", y = "") + scale_x_discrete(expand = c(0, 0)) +
scale_y_discrete(expand = c(0, 0)) +
theme(legend.position = "none", axis.ticks = element_blank(),
axis.text.x = element_text(size = 9 * 0.8,
angle = 0, hjust = 0, colour = "grey50"))
You are nearly correct. The code you implemented is the same for plotting. But the person who asked the question did one step in data preparation, he added a scaling variable.
If you scale your variable before plotting it and using the scaled factor as fill argument it works (i just added the rescale in scale_fill_gradient in ggplot after calculating it):
df.melt <- melt(df.scaled, id.vars = "combo")
df.melt<- ddply(df.melt, .(combo), transform, rescale = rescale(value))
ggplot(df.melt, aes(combo, variable)) +
geom_tile(aes(fill = rescale), colour = "white") +
scale_fill_gradient( low= "green", high = "red") +
geom_text(aes(label=round(value,4))) +
theme_grey(base_size = 9) +
labs(x = "", y = "") + scale_x_discrete(expand = c(0, 0)) +
scale_y_discrete(expand = c(0, 0)) +
theme(legend.position = "none", axis.ticks = element_blank(),
axis.text.x = element_text(size = 9 * 0.8,
angle = 0, hjust = 0, colour = "grey50"))
giving the plot:

Resources