Extend geom_voronoi past its limits with scale_*_continuous - r

the task I have set for myself is to make a voronoi diagram of the www.politicalcompass.org chart of the currently running democratic candidates. I have coded their positions and combined points that overlap into single observations. I have used two separate ggplot extensions that create voronoi diagrams.
The problem is that politicalcompass.org's chart goes from -10 to +10 on both axes. When I try to plot the voronoi diagrams, they only extend to their original limits and not to the full range of -10 to 10 that I intend to plot. Examples and code below:
https://github.com/McCartneyAC/average_of_polls/blob/master/stupid_voronoi_one.png?raw=true
https://github.com/McCartneyAC/average_of_polls/blob/master/stupid_voronoi_two.png?raw=true
library(tidyverse)
library(ggrepel)
candidates_list_voronoi <- tribble(
~candidate,~party,~economic,~authoritarian,
"Bennet","Democratic",8.5,6,
"Biden","Democratic",5.5,3.5,
"Booker","Democratic",4,2.5,
"Buttigieg/Castro","Democratic",6.5,4.5,
"Delaney","Democratic",4,3.5,
"Gabbard","Democratic",-1.5,-1.5,
"Harris","Democratic",5,4,
"Bullock/Klobuchar","Democratic",5,5,
"Sanders","Democratic",-1.5,-1,
"Sestak","Democratic",5.5,2,
"Warren","Democratic",0.5,1,
"Williamson","Democratic",2,-1.5,
"Yang","Democratic",7,1,
"Hawkins","Green",-5,-3,
"Vohra","Libertarian",10,1.5,
"Corker/Pence","Republican",10,8.5,
"Hogan","Republican",10,8,
"Kasich","Republican",8,9,
"Trump","Republican",8.5,8.5,
"Weld","Republican",9.5,4.5
)
library(ggvoronoi)
candidates_list_voronoi %>%
ggplot(aes(economic, authoritarian, label = candidate, fill = candidate)) +
geom_voronoi(color = "black") +
geom_label_repel(fill = "#FFFFFF") +
scale_x_continuous(limits = c(-10,10))+
scale_y_continuous(limits = c(-10,10))
library(ggforce)
candidates_list_voronoi %>%
ggplot(aes(economic, authoritarian)) +
geom_voronoi_tile(aes(fill = candidate, group = -1L)) +
geom_voronoi_segment() +
geom_label_repel(aes(label = candidate)) +
scale_x_continuous(limits = c(-10,10))+
scale_y_continuous(limits = c(-10,10))

You can specify the bounding box in the outline argument in geom_voronoi (see vignette example here).
outline.df <- data.frame(x = c(-10, 10, 10, -10),
y = c(-10, -10, 10, 10))
candidates_list_voronoi %>%
ggplot(aes(economic, authoritarian, fill = candidate)) +
geom_voronoi(outline = outline.df,
color = "black")
(Leaving out the labels part since it's not critical to the question.)

Related

combining land-only maps and contour plots using ggplot

I have developed a genetic algorithm for estimating the probability of observing an animal, given its genotype, across a regular grid of locations, here in south-east England. Using ggplot2 I can easily generate either a probability contour plot or a land-only (polygon-filled) map, but what I want is a map where the contour plot is restricted to land:
()
The desired outcome is generated by adding a black mask to the contour plot in Powerpoint, a tedious procedure that is impractical for generating the hundreds I need. I am sure there must be a simple way to do this.
I generate the contour plot using:
v <- ggplot(data, aes(Lat, Lng, z = P))
v + geom_contour(bins = 20)
and the map using:
ggplot(data = world) +
geom_sf(color = "black", fill = "gray") +
coord_sf(xlim = c(-2.3, 1.9), ylim = c(50.9, 53.5), expand = FALSE)
my input file comprises all locations in 0.05 increments of longitude and latitude in the intervals specified. It is large but I would happily add it if this helps. I have looked online and cannot see any examples that match what I want.
I have tried adding one component to the other as an extra layer but I struggle to understand what is needed and what the syntax are. For example:
layer(geom = "contour", stat = "identity", data = data, mapping = aes(Lng,Lat,P))
Error: Attempted to create layer with no position.
but even if this works it does not mask the sea area.
Here's a worked example with some made-up data:
library(rnaturalearth)
library(ggplot2)
sea <- ne_download(scale = 10, type = 'ocean', category = "physical",
returnclass = "sf")
ggplot(data) +
geom_contour_filled(aes(Lng, Lat, z = P), bins = 20, color = "black") +
guides(fill = "none") +
geom_sf(data = sea, fill = "black") +
coord_sf(ylim = c(51, 53.5), xlim = c(-2.2, 1.8), expand = FALSE)
Data used
set.seed(1)
a <- MASS::kde2d(rnorm(100), rnorm(100, 53), n = 100,
lims = c(-2.2, 1.8, 51, 53.5))
b <- MASS::kde2d(rnorm(25, 0.5), rnorm(25, 52), n = 100,
lims = c(-2.2, 1.8, 51, 53.5))
a$z <- b$z - a$z + max(a$z)
data <- cbind(expand.grid(Lng = a$x, Lat = a$y), P = c(a$z))
Created on 2023-01-02 with reprex v2.0.2

Problem with colouring a GG Plot Histogram

I`ve got an issue with colouring a ggplot2 histogram.
R-Junk
ggplot(Hospital, aes(x=BodyTemperature)) +
geom_histogram(aes(fill = factor(BodyTemperature))) +
scale_x_continuous(breaks = seq(0, 100, by = 10)) +
ylab("prevalence") +
xlab("BodyTemperature") +
ggtitle("Temperature vs. prevalence")
So the histogram should plot the information (x-axis), that as higher the temperature gets, the worse it is. So for example „temperature“ at 36°C should be green, 38°C yellow, 40° red - going from left to right on the x-axis.
Y-Axis should provide how often these temperatures ocures in the Patientdata of the Hospital. The Data "BodyTemperature" is a list of 200+ Data like: "35.3" or "37.4" etc.
How can this chunk be fixed to provide the color changes? For a non-ggplot version ive already written this r-junk positiv:
```{r, fig.width=8}
color1 <- rep(brewer.pal(1, "Greens"))
color2 <- rep("#57c4fa", 0)
color3 <- brewer.pal(8, "Reds")
hist(Hospital$BodyTemperature[-357],
breaks = seq(from = 0, to = 100, by = 10),
main = "Temperature vs. prevalence",
ylab = "prevalence",
xlab = "Temperature",
col = c(color1, color2, color3))
```
The key is to make sure the bin intervals used for the fill scale match those used for the x axis. You can do this by setting the binwidth argument to geom_histogram(), and using ggplot2::cut_width() to break BodyTemperature into the same bins for the fill scale:
set.seed(13)
library(ggplot2)
# example data
Hospital <- data.frame(BodyTemperature = 36.5 + rchisq(100, 2))
ggplot(Hospital, aes(BodyTemperature)) +
geom_histogram(
aes(fill = cut_width(BodyTemperature, width = 1)),
binwidth = 1,
show.legend = FALSE
) +
scale_fill_brewer(palette = "RdYlGn", direction = -1) +
labs(
title = "Temperature vs. Prevalence",
x = "Body Temperature (°C)",
y = "Prevalence"
) +
theme_minimal()
Created on 2022-10-24 with reprex v2.0.2

When using a color transformation in ggplot2, change the legend gradient instead of the legend break positions

Suppose I have a raster plot where the fill color gradient isn't used very efficiently because the values are skewed, like this:
library(ggplot2)
set.seed(20)
d = expand.grid(x = seq(0, 10, len = 100), y = seq(0, 10, len = 100))
d = transform(d, z =
1e-4 * ((x - 2)^2 + (2*y - 4)^2 + 10*rnorm(nrow(d)))^2)
ggplot(d) +
geom_raster(aes(x, y, fill = z)) +
scale_fill_distiller(palette = "Spectral",
limits = c(0, 12), breaks = 0 : 12) +
theme(legend.key.height = unit(20, "mm"))
I can quantile-transform the color scale like this:
ggplot(d) +
geom_raster(aes(x, y, fill = z)) +
scale_fill_distiller(palette = "Spectral",
limits = c(0, 12), breaks = 0 : 12,
trans = scales::trans_new("q",
function(x) ecdf(d$z)(x),
function(x) unname(quantile(d$z, x)))) +
theme(legend.key.height = unit(20, "mm"))
I like what this does for the main part of the plot, but not the legend. The legend uses the same gradient as the original, while moving the breaks according to the transformation. I'd prefer to keep the breaks where they are, while transforming the gradient instead. Also, I'd like to avoid the floating-point noise that's been added to the break labels. How can I accomplish these changes?
I had a very similar idea to chemdork123, but wanted to stay a bit closer to the quantile idea. The idea is to set an exact palette of colours (i.e., one colour for every value) and space this out such that it follows the data.
library(ggplot2)
library(scales)
#> Warning: package 'scales' was built under R version 4.0.3
set.seed(20)
d = expand.grid(x = seq(0, 10, len = 100), y = seq(0, 10, len = 100))
d = transform(d, z =
1e-4 * ((x - 2)^2 + (2*y - 4)^2 + 10*rnorm(nrow(d)))^2)
# The 'distiller' palette outside of the scale,
# we need this to generate `length(d$z)` number of colours.
pal <- gradient_n_pal(brewer_pal(palette = "Spectral", direction = -1)(7))
ggplot(d) +
geom_raster(aes(x, y, fill = z)) +
scale_fill_gradientn(
colours = pal(c(0, rescale(seq_along(d$z)), 1)), # <- extra 0, 1 for out-of-bounds
limits = c(0, 12), breaks = 0:12,
values = c(0, rescale(sort(d$z), from = c(0, 12)), 1) # <- extra 0, 1 again
) +
theme(legend.key.height = unit(10, "mm"))
Created on 2021-03-31 by the reprex package (v1.0.0)
You can use the values argument for the scale_fill_distiller() function. The distiller scales extend brewer to continuous scales by interpolating 7 colors from any palette. By default, the scaling is linearly applied from 0 (lowest value on the scale) to 1 (highest value on the scale). You can recreate this mapping via: scales::rescale(1:7). If you supply a new vector to the values argument, you can remap each of the 7 colors to a new location. You do not have to supply 7 values - the rest are interpolated linearly - just as long as you specify the max at 1 (or you'll cut the scale).
Best way is to play around with it - I've tried mapping to specific functions before, but honestly it tends to work for me the best when I just mess with the numbers until I get something I like:
ggplot(d) +
geom_raster(aes(x, y, fill = z)) +
scale_fill_distiller(palette = "Spectral", values = c(0,0.05,0.1, 0.5,1)) +
theme(legend.key.height = unit(20, "mm"))

divide the y axis to make part with a score <25 occupies the majority in ggplot

I want to divide the y axis for the attached figure to take part with a score <25 occupies the majority of the figure while the remaining represent a minor upper part.
I browsed that and I am aware that I should use scale_y_discrete(limits .I used this p<- p+scale_y_continuous(breaks = 1:20, labels = c(1:20,"//",40:100)) but it doesn't work yet.
I used the attached data and this is my code
Code
p<-ggscatter(data, x = "Year" , y = "Score" ,
color = "grey", shape = 21, size = 3, # Points color, shape and size
add.params = list(color = "blue", fill = "lightgray"), # Customize reg. line
add = "loess", #reg.line
conf.int = T,
cor.coef = F, cor.method = "pearson",
xlab = "Year" , ylab= "Score")
p<-p+ coord_cartesian(xlim = c(1980, 2020));p
Here is as close as I could get getting a fake axis break and resizing the upper area of the plot. I still think it's a bad idea and if this were my plot I'd much prefer a more straightforward axis transform.
First, we'd need a function that generates a transform that squeezes all values above some threshold:
library(ggplot2)
library(scales)
# Define new transform
my_transform <- function(threshold = 25, squeeze_factor = 10) {
force(threshold)
force(squeeze_factor)
my_transform <- trans_new(
name = "trans_squeeze",
transform = function(x) {
ifelse(x > threshold,
((x - threshold) * (1 / squeeze_factor)) + threshold,
x)
},
inverse = function(x) {
ifelse(x > threshold,
((x - threshold) * squeeze_factor) + threshold,
x)
}
)
return(my_transform)
}
Next we apply that transformation to the y-axis and add a fake axis break. I've used vanilla ggplot2 code as I find the ggscatter() approach confusing.
ggplot(data, aes(Year, Score)) +
geom_point(color = "grey", shape = 21, size = 3) +
geom_smooth(method = "loess", fill = "lightgray") +
# Add fake axis lines
annotate("segment", x = -Inf, xend = -Inf,
y = c(-Inf, Inf), yend = c(24.5, 25.5)) +
# Apply transform to y-axis
scale_y_continuous(trans = my_transform(25, 10),
breaks = seq(0, 80, by = 10)) +
scale_x_continuous(limits = c(1980, 2020), oob = oob_keep) +
theme_classic() +
# Turn real y-axis line off
theme(axis.line.y = element_blank())
You might find it informative to read Hadley Wickham's view on discontinuous axes. People sometimes mock weird y-axes.

Fix legend title when using superscript in more than two lines - R ggplot2

I am plotting a map of my study area and I am having problems to edit the legend title.
I need it to be "Projected fruit productivity in fallows in 40 yrs (fruits ha^-1) written in four lines. I could use bquote() to plot the -1 as a superscript. But it created an extra space that I cannot figure it out how to take it off. The extra space only appears when the title is divided into multiple lines.
Also, expression(atop()) creates the superscript but once I tried to divide it into more than two lines it does not show lines three and four.
This is the Map with the extra space using bquote()
This is the Map with the four line title using expression(atop())
I did try different solutions found on the internet, including this post. But they all plot the fourth line with the extra space or only plot the first or second line.
Bellow is the code I am using. Any help is welcomed.
The comments are different tries.
Data = spatial_dist_fallows.csv
library(sf) #sf = simple feature
library(ggplot2)
library(dplyr)
PAECM_fallows <-read.csv("spatial_dist_fallows.csv")
PAECM_fallows_sp <- st_as_sf(PAECM_fallows,coords = c("X", "Y"),crs = "+proj=longlat +datum=WGS84 +no_defs")
custom_bins_fruit = c(0,60,120,180,240,1400)
PAECM_fallows_fruit <- PAECM_fallows_sp %>%
mutate(prod_cat_fallow = cut(prod_40, breaks= custom_bins_fruit),
age_cat_fallow = cut(age, breaks = c(11,17,22,29,60)))
prod_map_PAECM_fruit<-ggplot()+
geom_sf(data = PAECM_fallows_fruit,aes(size = prod_cat_fallow), shape = 18, show.legend = "point")+
scale_size_manual(values= c(2,3,4,5,6),
# name = "Projected fruit\nproductivity in\nfallows in 40 yrs \n(fruits ha^-1)",
name = bquote("Projected fruit\nproductivity in\nfallows in 40 yrs \n( fruits"*ha^-1*")"),
# name = expression(paste("Projected fruit productivity\nin fallows in 40 yrs\n"),bquote(paste("("*fruits~ha^-1*")"))),#(Fruits/ha)
name = expression(atop("Projected fruit",
"productivity in",
"fallows in 40 yrs",
"( fruits ha"^-1,")")),
breaks= c(NA,"(0,60]","(60,120]","(120,180]","(180,240]","(240,1.4e+03]"),
labels= c("NA","\u2264 60","60 - 120","120 - 180","180 - 240","> 240"),
guide = guide_legend(override.aes = list(linetype = "blank", shape = 18, fill = NA)))+
# labs(size = expression(atop("Projected fruit\nproductivity in\nfallows in 40 yrs\n(fruits"*ha^-1*")", sep="")))+ #comment name line at the scale_size_manual
# labs(size = bquote("Projected fruit productivity \nin fallows in 40 yrs \n( fruits"*ha^-1*")"))+ #comment name line at the scale_size_manual
ggplot2::theme_minimal()+
ggplot2::theme(legend.text.align=0.5,
legend.title.align = 0.5,
plot.background = element_blank(),
panel.grid = element_line(colour = "white"),
panel.background = element_rect(fill = "grey87", color = "white"))+#,
coord_sf(xlim = c(-68.45,-68.2), ylim = c(-11.05,-10.8))
prod_map_PAECM_fruit
Extra question. Once I started to use the bquote I could not align the title text using theme(legend.title.align = 0.5), any other ideas?
After some other tries, I did come up with the following solution for the legend title.
name = expression(atop("",
atop(textstyle("Projected fruit"),
atop(textstyle("productivity in"),
atop(textstyle("fallows in 40 yrs"),
atop(textstyle("(fruits ha"^-1*")"))))))),
I used textstyle() to plot all text with the same size, otherwise it would be plotted smaller every time atop() was called. Atop() creates a space between the first and second line, that is why the first line of the code is atop("", so the first line will be a blank.
This is the final code with the map below.
library(sf) #sf = simple feature
library(ggplot2)
library(dplyr)
PAECM_fallows <-read.csv("spatial_dist_fallows.csv")
PAECM_fallows_sp <- st_as_sf(PAECM_fallows,coords = c("X", "Y"),crs = "+proj=longlat +datum=WGS84 +no_defs")
custom_bins_fruit = c(0,60,120,180,240,1400)
PAECM_fallows_fruit <- PAECM_fallows_sp %>%
mutate(prod_cat_fallow = cut(prod_40, breaks= custom_bins_fruit),
age_cat_fallow = cut(age, breaks = c(11,17,22,29,60)))
prod_map_PAECM_fruit_legend_test<-ggplot()+
geom_sf(data = PAECM_fallows_fruit,aes(size = prod_cat_fallow), shape = 18, show.legend = "point")+
scale_size_manual(values= c(2,3,4,5,6),
name = expression(atop("",
atop(textstyle("Projected fruit"),
atop(textstyle("productivity in"),
atop(textstyle("fallows in 40 yrs"),
atop(textstyle("(fruits ha"^-1*")"))))))),
breaks= c(NA,"(0,60]","(60,120]","(120,180]","(180,240]","(240,1.4e+03]"),
labels= c("NA","\u2264 60","60 - 120","120 - 180","180 - 240","> 240"),
guide = guide_legend(override.aes = list(linetype = "blank", shape = 18, fill = NA)))+
ggplot2::theme_minimal()+
ggplot2::theme(legend.text.align=0.5,
legend.title.align = 0.5,
plot.background = element_blank(),
panel.grid = element_line(colour = "white"),
panel.background = element_rect(fill = "grey87", color = "white"))+#,
coord_sf(xlim = c(-68.45,-68.2), ylim = c(-11.05,-10.8))
prod_map_PAECM_fruit_legend_test
Alternatively, you could use the annotation functions cowplot::draw_label() or ggplot2::annotation_custom(). I think that the explanations about these approaches given in ggplot2 two-line label with expression are helpful here as well.
1) Solution with cowplot::draw_label()
library(ggplot2)
library(cowplot)
#> Warning: package 'cowplot' was built under R version 3.5.2
#>
#> Attaching package: 'cowplot'
#> The following object is masked from 'package:ggplot2':
#>
#> ggsave
# If needed, revert to default theme (cowplot modifies the theme);
theme_set(theme_grey())
# Build a simple plot as example
p <- ggplot(mtcars, aes(x = wt, y = mpg, size = factor(gear))) +
geom_point() +
labs(size = element_blank()) + # remove default legend title
# Make enough space for the custom legend title by tweaking the right margin
theme(legend.margin = margin(t = 0, r = 26, b = 0, l = 0, unit = "mm"))
# Adjust further theme elements if needed, like text size, font, etc
# The lines of text and expression that constitute your custom legend title
lines <- list(
"Projected fruit",
"productivity in",
"fallows in 40 yrs",
expression("(fruits ha" ^-1 ~ ")")
)
# Using relative coordinates ranging from 0 to 1 (relative to the entire canvas).
# There is some guesswork with the coordinates until we get them right.
min_y <- 0.6
step <- 0.04 # dictates the line spacing; need to play with it until you get it right
ys <- seq(from = min_y + step * 4, to = min_y, by = -step)
x <- 0.87
# Add the annotations that will actually constitute the legend title.
gg <- ggdraw(p)
#> Warning: Using size for a discrete variable is not advised.
# Neglect the warning in this example.
for (i in 1:4){
gg <- gg + draw_label(lines[[i]], x = x, y = ys[i])
}
gg
Note that, cowplot::draw_label() can also be used in combination with setting the clipping off, coord_cartesian(clip = "off"), which allows plotting anywhere on the canvas (see next example with ggplot2::annotation_custom()). In such a case, we do not use the relative coordinates anymore, but the ones from the plot/data (the absolute coordinates).
2) Solution with ggplot2::annotation_custom()
Note that, cowplot::draw_label() uses ggplot2::annotation_custom() under the hood, so it is more or less the same annotation technique, but bit more verbose. We need to set clipping off. This time we do not use the relative coordinates anymore, but the ones from the plot/data (the absolute coordinates).
Building upon the p plot example from above:
min_y <- 24
step <- 1 # dictates the line spacing; need to play with it until you get it right
ys <- seq(from = min_y + step * 4, to = min_y, by = -step)
x <- 6.2
# set clipping off - allows plotting anywhere on the canvas
pp <- p + coord_cartesian(clip = "off")
for (i in 1:4){
pp <- pp + annotation_custom(grid::textGrob(lines[[i]]),
xmin = x, xmax = x, ymin = ys[i], ymax = ys[i])
}
pp
#> Warning: Using size for a discrete variable is not advised.
Created on 2019-01-15 by the reprex package (v0.2.1)

Resources