R Windrose percent label on figure - r

I am using the windrose function posted here: Wind rose with ggplot (R)?
I need to have the percents on the figure showing on the individual lines (rather than on the left side), but so far I have not been able to figure out how. (see figure below for depiction of goal)
Here is the code that makes the figure:
p.windrose <- ggplot(data = data,
aes(x = dir.binned,y = (..count..)/sum(..count..),
fill = spd.binned)) +
geom_bar()+
scale_y_continuous(breaks = ybreaks.prct,labels=percent)+
ylab("")+
scale_x_discrete(drop = FALSE,
labels = waiver()) +
xlab("")+
coord_polar(start = -((dirres/2)/360) * 2*pi) +
scale_fill_manual(name = "Wind Speed (m/s)",
values = spd.colors,
drop = FALSE)+
theme_bw(base_size = 12, base_family = "Helvetica")
I marked up the figure I have so far with what I am trying to do! It'd be neat if the labels either auto-picked the location with the least wind in that direction, or if it had a tag for the placement so that it could be changed.
I tried using geom_text, but I get an error saying that "aesthetics must be valid data columns".
Thanks for your help!

One of the things you could do is to make an extra data.frame that you use for the labels. Since the data isn't available from your question, I'll illustrate with mock data below:
library(ggplot2)
# Mock data
df <- data.frame(
x = 1:360,
y = runif(360, 0, 0.20)
)
labels <- data.frame(
x = 90,
y = scales::extended_breaks()(range(df$y))
)
ggplot(data = df,
aes(x = as.factor(x), y = y)) +
geom_point() +
geom_text(data = labels,
aes(label = scales::percent(y, 1))) +
scale_x_discrete(breaks = seq(0, 1, length.out = 9) * 360) +
coord_polar() +
theme(axis.ticks.y = element_blank(), # Disables default y-axis
axis.text.y = element_blank())

#teunbrand answer got me very close! I wanted to add the code I used to get everything just right in case anyone in the future has a similar problem.
# Create the labels:
x_location <- pi # x location of the labels
# Get the percentage
T_data <- data %>%
dplyr::group_by(dir.binned) %>%
dplyr::summarise(count= n()) %>%
dplyr::mutate(y = count/sum(count))
labels <- data.frame(x = x_location,
y = scales::extended_breaks()(range(T_data$y)))
# Create figure
p.windrose <- ggplot() +
geom_bar(data = data,
aes(x = dir.binned, y = (..count..)/sum(..count..),
fill = spd.binned))+
geom_text(data = labels,
aes(x=x, y=y, label = scales::percent(y, 1))) +
scale_y_continuous(breaks = waiver(),labels=NULL)+
scale_x_discrete(drop = FALSE,
labels = waiver()) +
ylab("")+xlab("")+
coord_polar(start = -((dirres/2)/360) * 2*pi) +
scale_fill_manual(name = "Wind Speed (m/s)",
values = spd.colors,
drop = FALSE)+
theme_bw(base_size = 12, base_family = "Helvetica") +
theme(axis.ticks.y = element_blank(), # Disables default y-axis
axis.text.y = element_blank())

Related

Ordering y axis by another variable in a ggolot bar plot

I have a swimlane plot which I want to order by a group variable. I was also wondering if it is possible to label the groups on the ggplot.
Here is the code to create the data set and plot the data
dataset <- data.frame(subject = c("1002", "1002", "1002", "1002", "10034","10034","10034","10034","10054","10054","10054","1003","1003","1003","1003"),
exdose = c(5,10,20,5,5,10,20,20,5,10,20,5,20,10,5),
p= c(1,2,3,4,1,2,3,4,1,2,3,1,2,3,4),
diff = c(3,3,9,7,3,3,4,5,3,5,6,3,5,6,7),
group =c("grp1","grp1","grp1","grp1","grp2","grp2","grp2","grp2","grp1","grp1","grp1","grp2","grp2","grp2","grp2")
)
ggplot(dataset, aes(x = diff + 1, y = subject, group = p)) +
geom_col(aes(fill = as.factor(exdose)), position = position_stack(reverse = TRUE))
I want the y axis order by group and I want a label on the side to label the groups if possible
you can see from the plot it is ordered by subject number but I want it ordered by group and some indicator of group.
I tried reorder but I was unsuccessful in getting the desired plot.
As Stefan points out, facets are probably the way to go here, but you can use them with subtle theme tweaks to make it look as though you have just added a grouping variable on the y axis:
library(tidyverse)
dataset %>%
mutate(group = factor(group),
subject = reorder(subject, as.numeric(group)),
exdose = factor(exdose)) %>%
ggplot(aes(x = diff + 1, y = subject, group = p)) +
geom_col(aes(fill = exdose), color = "gray50",
position = position_stack(reverse = TRUE)) +
scale_y_discrete(expand = c(0.1, 0.4)) +
scale_fill_brewer(palette = "Set2") +
facet_grid(group ~ ., scales = "free_y", switch = "y") +
theme_minimal(base_size = 16) +
theme(strip.background = element_rect(color = "gray"),
strip.text = element_text(face = 2),
panel.spacing.y = unit(0, "mm"),
panel.background = element_rect(fill = "#f9f8f6", color = NA))

Create a split violin plot with paired points and proper orientation

With ggplot2, I can create a violin plot with overlapping points, and paired points can be connected using geom_line().
library(datasets)
library(ggplot2)
library(dplyr)
iris_edit <- iris %>% group_by(Species) %>%
mutate(paired = seq(1:length(Species))) %>%
filter(Species %in% c("setosa","versicolor"))
ggplot(data = iris_edit,
mapping = aes(x = Species, y = Sepal.Length, fill = Species)) +
geom_violin() +
geom_line(mapping = aes(group = paired),
position = position_dodge(0.1),
alpha = 0.3) +
geom_point(mapping = aes(fill = Species, group = paired),
size = 1.5, shape = 21,
position = position_dodge(0.1)) +
theme_classic() +
theme(legend.position = "none",
axis.text.x = element_text(size = 15),
axis.title.y = element_text(size = 15),
axis.title.x = element_blank(),
axis.text.y = element_text(size = 10))
The see package includes the geom_violindot() function to plot a halved violin plot alongside its constituent points. I've found this function helpful when plotting a large number of points so that the violin is not obscured.
library(see)
ggplot(data = iris_edit,
mapping = aes(x = Species, y = Sepal.Length, fill = Species)) +
geom_violindot(dots_size = 0.8,
position_dots = position_dodge(0.1)) +
theme_classic() +
theme(legend.position = "none",
axis.text.x = element_text(size = 15),
axis.title.y = element_text(size = 15),
axis.title.x = element_blank(),
axis.text.y = element_text(size = 10))
Now, I would like to add geom_line() to geom_violindot() in order to connect paired points, as in the first image. Ideally, I would like the points to be inside and the violins to be outside so that the lines do not intersect the violins. geom_violindot() includes the flip argument, which takes a numeric vector specifying the geoms to be flipped.
ggplot(data = iris_edit,
mapping = aes(x = Species, y = Sepal.Length, fill = Species)) +
geom_violindot(dots_size = 0.8,
position_dots = position_dodge(0.1),
flip = c(1)) +
geom_line(mapping = aes(group = paired),
alpha = 0.3,
position = position_dodge(0.1)) +
theme_classic() +
theme(legend.position = "none",
axis.text.x = element_text(size = 15),
axis.title.y = element_text(size = 15),
axis.title.x = element_blank(),
axis.text.y = element_text(size = 10))
As you can see, invoking flip inverts the violin half, but not the corresponding points. The see documentation does not seem to address this.
Questions
How can you create a geom_violindot() plot with paired points, such that the points and the lines connecting them are "sandwiched" in between the violin halves? I suspect there is a solution that uses David Robinson's GeomFlatViolin function, though I haven't been able to figure it out.
In the last figure, note that the lines are askew relative to the points they connect. What position adjustment function should be supplied to the position_dots and position arguments so that the points and lines are properly aligned?
Not sure about using geom_violindot with see package. But you could use a combo of geom_half_violon and geom_half_dotplot with gghalves package and subsetting the data to specify the orientation:
library(gghalves)
ggplot(data = iris_edit[iris_edit$Species == "setosa",],
mapping = aes(x = Species, y = Sepal.Length, fill = Species)) +
geom_half_violin(side = "l") +
geom_half_dotplot(stackdir = "up") +
geom_half_violin(data = iris_edit[iris_edit$Species == "versicolor",],
aes(x = Species, y = Sepal.Length, fill = Species), side = "r")+
geom_half_dotplot(data = iris_edit[iris_edit$Species == "versicolor",],
aes(x = Species, y = Sepal.Length, fill = Species),stackdir = "down") +
geom_line(data = iris_edit, mapping = aes(group = paired),
alpha = 0.3)
As a note, the lines in the pairing won't properly align because the dotplot is binning each observation then lengthing out the dotline-- the paired lines only correspond to x-value as defined in aes, not where the dot is in the line.
As per comment - this is not a direct answer to your question, but I believe that you might not get the most convincing visualisation when using the "slope graph" optic. This becomes quickly convoluted (so many dots/ lines overlapping) and the message gets lost.
To show change between paired observations (treatment 1 versus treatment 2), you can also (and I think: better) use a scatter plot. You can show each observation and the change becomes immediately clear. To make it more intuitive, you can add a line of equality.
I don't think you need to show the estimated distribution (left plot), but if you want to show this, you could make use of a two-dimensional density estimation, with geom_density2d (right plot)
library(tidyverse)
## patchwork only for demo purpose
library(patchwork)
iris_edit <- iris %>% group_by(Species) %>%
## use seq_along instead
mutate(paired = seq_along(Species)) %>%
filter(Species %in% c("setosa","versicolor")) %>%
## some more modificiations
select(paired, Species, Sepal.Length) %>%
pivot_wider(names_from = Species, values_from = Sepal.Length)
lims <- c(0, 10)
p1 <-
ggplot(data = iris_edit, aes(setosa, versicolor)) +
geom_abline(intercept = 0, slope = 1, lty = 2) +
geom_point(alpha = .7, stroke = 0, size = 2) +
cowplot::theme_minimal_grid() +
coord_equal(xlim = lims, ylim = lims) +
labs(x = "Treatment 1", y = "Treatment 2")
p2 <-
ggplot(data = iris_edit, aes(setosa, versicolor)) +
geom_abline(intercept = 0, slope = 1, lty = 2) +
geom_density2d(color = "Grey") +
geom_point(alpha = .7, stroke = 0, size = 2) +
cowplot::theme_minimal_grid() +
coord_equal(xlim = lims, ylim = lims) +
labs(x = "Treatment 1", y = "Treatment 2")
p1+ p2
Created on 2021-12-18 by the reprex package (v2.0.1)

Raincloud plot - histogram?

I would like to create a raincloud plot. I have successfully done it. But I would like to know if instead of the density curve, I can put a histogram (it's better for my dataset).
This is my code if it can be usefull
ATSC <- ggplot(data = data, aes(y = atsc, x = numlecteur, fill = numlecteur)) +
geom_flat_violin(position = position_nudge(x = .2, y = 0), alpha = .5) +
geom_point(aes(y = atsc, color = numlecteur), position = position_jitter(width = .15), size = .5, alpha = 0.8) +
geom_point(data = sumld, aes(x = numlecteur, y = mean), position = position_nudge(x = 0.25), size = 2.5) +
geom_errorbar(data = sumld, aes(ymin = lower, ymax = upper, y = mean), position = position_nudge(x = 0.25), width = 0) +
guides(fill = FALSE) +
guides(color = FALSE) +
scale_color_brewer(palette = "Spectral") +
scale_y_continuous(breaks=c(0,2,4,6,8,10), labels=c("0","2","4","6","8","10"))+
scale_fill_brewer(palette = "Spectral") +
coord_flip() +
theme_bw() +
expand_limits(y=c(0, 10))+
xlab("Lecteur") + ylab("Age total sans check")+
raincloud_theme
I think we can maybe put the "geom_histogram()" but it doesn't work
Thank you in advance for your help !
(sources : https://peerj.com/preprints/27137v1.pdf
https://neuroconscience.wordpress.com/2018/03/15/introducing-raincloud-plots/)
This is actually not quite easy. There are a few challenges.
geom_histogram is "horizontal by nature", and the custom geom_flat_violin is vertical - as are boxplots. Therefore the final call to coord_flip in that tutorial. In order to combine both, I think best is switch x and y, forget about coord_flip, and use ggstance::geom_boxploth instead.
Creating separate histograms for each category is another challenge. My workaround to create facets and "merge them together".
The histograms are scaled way bigger than the width of the points/boxplots. My workaround scale via after_stat function.
How to nudge the histograms to the right position above Boxplot and points - I am converting the discrete scale to a continuous by mapping a constant numeric to the global y aesthetic, and then using the facet labels for discrete labels.
library(tidyverse)
my_data<-read.csv("https://data.bris.ac.uk/datasets/112g2vkxomjoo1l26vjmvnlexj/2016.08.14_AnxietyPaper_Data%20Sheet.csv")
my_datal <-
my_data %>%
pivot_longer(cols = c("AngerUH", "DisgustUH", "FearUH", "HappyUH"), names_to = "EmotionCondition", values_to = "Sensitivity")
# use y = -... to position boxplot and jitterplot below the histogram
ggplot(data = my_datal, aes(x = Sensitivity, y = -.5, fill = EmotionCondition)) +
# after_stat for scaling
geom_histogram(aes(y = after_stat(count/100)), binwidth = .05, alpha = .8) +
# from ggstance
ggstance::geom_boxploth( width = .1, outlier.shape = NA, alpha = 0.5) +
geom_point(aes(color = EmotionCondition), position = position_jitter(width = .15), size = .5, alpha = 0.8) +
# merged those calls to one
guides(fill = FALSE, color = FALSE) +
# scale_y_continuous(breaks = 1, labels = unique(my_datal$EmotionCondition))
scale_color_brewer(palette = "Spectral") +
scale_fill_brewer(palette = "Spectral") +
# facetting, because each histogram needs its own y
# strip position = left to fake discrete labels in continuous scale
facet_wrap(~EmotionCondition, nrow = 4, scales = "free_y" , strip.position = "left") +
# remove all continuous labels from the y axis
theme(axis.title.y = element_blank(), axis.text.y = element_blank(),
axis.ticks.y = element_blank())
Created on 2021-04-15 by the reprex package (v1.0.0)

geom_histogram with proportions and factor data

I'm trying to consistently plot histograms for zonal statistics from a thematic map. The data within a single zone often looks something like this:
dat <- data.frame("CLASS" = sample(LETTERS[1:6], 250, replace = TRUE,
prob = c(.15, .06, .35, .4, .02, 0)))
dat$CLASS <- factor(dat$CLASS, levels = LETTERS[1:6], ordered = T)
wherein not all possible classes may have been present in the zone.
I can pre-compute the data summary and use geom_bar and a manual colour scale to get consistent bar colours regardless of missing data:
library(dplyr)
library(ggplot2)
library(viridis)
dat_summ <- dat %>%
group_by(CLASS, .drop = FALSE) %>%
summarise(percentage = n() / nrow(.) * 100)
mancols <- viridis_pal()(6)
names(mancols) <- LETTERS[1:6]
ggplot(dat_summ) +
geom_bar(aes(x = CLASS, y = percentage, fill = CLASS),
stat = 'identity', show.legend = FALSE) +
scale_x_discrete(drop = FALSE) +
scale_fill_manual(values = mancols, drop = FALSE) +
labs(x = 'Class', y = 'Percent') +
theme_minimal() +
theme(panel.grid.minor = element_blank())
But I can't keep the colours consistent across plots when I try to use geom_histogram:
ggplot(dat) +
geom_histogram(aes(x = CLASS,
y = (..count../sum(..count..)) * 100,
fill = ..x..), stat = 'count', show.legend = FALSE) +
scale_x_discrete(drop = FALSE) +
scale_fill_viridis_c() +
labs(x = 'Class', y = 'Percent') +
theme_minimal() +
theme(panel.grid.minor = element_blank())
If any of the outside-edge columns (A, F) are count = 0, the colours rescale to where data is present. This doesn't happen if there's a gap in one of the middle classes. Using scale_fill_viridis_b() doesn't solve the problem - it always rescales the palette against the number of non-0 columns.
Is it possible to prevent this behaviour and output consistent colours no matter which columns are count = 0, or am I stuck with my geom_bar approach?
Maybe scale_fill_discrete/scale_fill_viridis_d(drop = F) is what you want (with fill = CLASS).
ggplot(dat) +
geom_histogram(aes(x = CLASS,
y = (..count../sum(..count..)) * 100,
fill = CLASS), stat = 'count', show.legend = FALSE) +
scale_x_discrete(drop = FALSE) +
scale_fill_viridis_d(drop = FALSE) +
labs(x = 'Class', y = 'Percent') +
theme_minimal() +
theme(panel.grid.minor = element_blank())
I think that the problem is that you pass the calculated variable ..x.. to fill in the aesthetics. It appears the length of this variable changes with your data set. You could replace it with scale_fill_manual and you will get the same plot colours regardless of how many levels there are in your CLASS variable:
ggplot(dat) +
geom_histogram(aes(x = CLASS, y = stat(count/sum(count) * 100), fill = CLASS), stat = 'count', show.legend = FALSE) +
scale_x_discrete(drop = FALSE) +
scale_fill_manual(values = c("#FF0000FF", "#CCFF00FF", "#00FF66FF", "#0066FFFF", "#CC00FFFF", "#FF99FFFF"))
labs(x = 'Class', y = 'Percent') +
theme_minimal() +
theme(panel.grid.minor = element_blank())

Removing axis labelling for one geom when multiple geoms are present

All I want is this R code to display the names of players inside the "topName" while hiding the names inside the "otherNames" by plotting both of them using two different geom_col().
epldata <- read.csv(file = 'epldata.csv')
epldata$srno <- c(1:461)
attach(epldata)
points <- epldata[order(-fpl_points),]
detach(epldata)
topNames[24:461]<-NA epldata$topNames <- topNames
topPoints[24:461]<-NA epldata$topPoints <- topPoints
epldata$otherNames <- NA epldata$otherNames[24:461] <-
as.character(points$name[c(24:461)]) epldata$otherPoints <- NA
epldata$otherPoints[24:461] <-
as.numeric(points$fpl_points[c(24:461)])
ggplot(data = epldata)+ geom_col(aes(x=epldata$topNames,
y=epldata$topPoints), fill = "red", alpha = 1) +
theme(axis.text.x = element_text(angle = 90, hjust = 1)) +
annotate("text", x=epldata$topNames, y=-50, #epldata$topPoints,
label = epldata$topNames, fontface = 1, size = 2, hjust = 0)+ geom_col(aes(x=epldata$otherNames, y=epldata$otherPoints), fill
= "gray", alpha = 0.3)+ theme(legend.position = "none")+ #theme(axis.text.x = element_text(angle = 90, hjust = 1))+ xlab("Player Names")+ ylab("FPL Points")+ guides(fill=FALSE,
color=FALSE, guide = FALSE) + coord_flip() + theme(axis.text.y =
element_blank(),
axis.ticks.y = element_blank())
This is the kind of output I am looking for but without using the Annotate Hack that I am currently using but directly plotting the names on the axis.
Update : have added the entire code and the link to the data set is below :
https://drive.google.com/open?id=1KTitWDcLIBmeBsz8mLcHXDIyhQLZnlhS
Once you've created a list of topNames, you can use scale_x_continuous to display only these axis labels:
scale_x_discrete(breaks = topNames)
Also, rather than using two separate geom_col() geometries, you can create a new "highlight" column in the dataframe and use that with the fill and alpha aesthetics:
library(dplyr)
library(ggplot2)
# read data from google drive
id <- "1KTitWDcLIBmeBsz8mLcHXDIyhQLZnlhS" #google file ID
epldata <- read.csv(sprintf("https://docs.google.com/uc?id=%s&export=download", id),
stringsAsFactors = FALSE)
N <- 24 #number of players to highlight
#get list of names of top N players
topNames <- epldata %>%
arrange(-fpl_points) %>%
head(N) %>%
pull(name)
#> Warning: package 'bindrcpp' was built under R version 3.5.1
# make variable for highlighting
epldata <- epldata %>%
mutate(highlight = ifelse(name %in% topNames, TRUE, FALSE))
ggplot(data = epldata,
aes(x = name, y = fpl_points, fill = highlight, alpha = highlight)) +
geom_col() +
scale_fill_manual(guide = FALSE,
values = c("gray", "red")) +
scale_alpha_manual(guide = FALSE,
values = c(0.4, 1)) +
scale_x_discrete(breaks = topNames) + #use breaks to determine axis labels
coord_flip() +
ylab("FPL Points") +
theme_classic() +
theme(axis.ticks.y = element_blank(),
axis.title.y = element_blank())
Created on 2018-09-19 by the reprex package (v0.2.1)

Resources