Plotting multiple density distributions on one plot - r

For teaching purposes I'm looking to create and plot multiple distributions on to one graph. The code I've been using to do this is:
library(ggplot2)
library(ggfortify)
# Create an initial graph with 1 distribution
p3 <- ggdistribution(dnorm,
seq(-5, 10,length=1000),
colour='blue',
mean=0.15,
sd=0.24,
fill='blue')
# Update p3 with second distribution
p3 <- ggdistribution(dnorm, seq(-5, 10,length=1000),
mean = 1.11,
sd = 0.55,
colour='green',
fill='green',p=p3)
# View p3
p3
Initially, this seems great because it produces a graph with both distributions:
The problems start when I try to change the appearance of the graph.
(1) First when I attempt to change the y-axis scale so that it ranges from 0 to 1 instead of the percentages it shows by default, I am able to do so, but something happens to the distributions. Here is the code I am using:
p3 <- p3 + ylim(0,1) + xlim (-2, 6) + labs(title="Plotting Multiple Distributions", x="Mean difference", y="Density")
And this returns the following graph:
Any advice on how I can change the y-axis without ruining the distribution would be very appreciated!
(2) Second, when I try to add 2 lines along the axes using this code:
p3 <- p3 + geom_segment(aes(x=0, y=0, xend=0, yend=0.98),
size=1,
arrow = arrow(length = unit(0.4,"cm")))
p3 <- p3 + geom_segment(aes(x=-2, y=0, xend=6, yend=0),
size=1)
...R returns the following error message:
Error in eval(expr, envir, enclos) : object 'ymin' not found
Any advice as to how I might add these lines to improve the aesthetics of the graph would be very appreciated.
Thank you in advance for your time.

Sounds like you wish to change the y-axis labels to the range (0, 1), without actually changing the underlying distribution. Here's one approach:
# after obtaining p3 from the two ggdistribution() functions
# get the upper limit for p3's current y-axis range, rounded up
y.orig <- layer_scales(p3)$y$range$range[2] # = 1.662259 in my case, yours may
# differ based on the distribution
y.orig <- ceiling(y.orig * 10) / 10 # = 1.7
p3 +
xlim(-2, 6) +
scale_y_continuous(breaks = seq(0, y.orig, length.out = 5),
labels = scales::percent(seq(0, 1, length.out = 5))) +
annotate("segment", x = 0, y = 0, xend = 0, yend = y.orig,
size = 1, arrow = arrow(length = unit(0.4, "cm"))) +
annotate("segment", x = -2, y = 0, xend = 6, yend = 0,
size = 1)
Or if you prefer to keep labels close to the fake axis created from line segments, include expand = c(0, 0) for x / y:
p3 +
scale_x_continuous(limits = c(-2, 6), expand = c(0, 0)) +
scale_y_continuous(breaks = seq(0, y.orig, length.out = 5),
labels = scales::percent(seq(0, 1, length.out = 5)),
expand = c(0, 0)) +
annotate("segment", x = 0, y = 0, xend = 0, yend = y.orig,
size = 1, arrow = arrow(length = unit(0.4, "cm"))) +
annotate("segment", x = -2, y = 0, xend = 6, yend = 0,
size = 1)

Related

how to plot a bidirectional flip bargraph with count data?

I am analysing some data with a binomial distribution.
We have 2 possible choices for a stimulus, and patients (female and male) have to decide whether they feel pain (1) or not (0).
I would like to plot a bargraph showing the number of patients who choose 0 or 1, in a rotated way.
An idea of the graph I am looking for is the following, from Sevarika et al, 2022.
#my data
id<-c(1,1,2,2,3,3,4,4,5,5,6,6,7,7,8,8,9,9,10,10)
trt<-c("C","E","C","E","C","E","C","E","C","E","C","E","C","E","C","E","C","E","E","C")
response<-c(0,1,0,1,0,1,1,1,0,1,0,1,0,1,1,1,0,1,0,1)
sex<-c(rep("male",5),rep("female",5))
data<-data.frame(id,trt,response,sex)
So my objective is a flipped boxplot where females and males are separated, and the number of 1 or 0 is shown on each side of the axis. I mean, where it says control, let it say 0, where it says treatment let it say 1, and the top bar should be males and the bottom bar should be females.
Thank you very much, best regards
Base R way:
# compute percentages
tab <- t(table(data$response, data$sex) * c(-1, 1))
tab <- tab / rowSums(abs(tab)) * 100
# positions of x axis labels
lab.x <- seq(-100, 100, 25)
# initiate new plot
frame()
par(mar=c(2.5, 1, 2, 1))
plot.window(range(lab.x), c(0, 1))
# draw x axis
axis(1, at=lab.x, labels=abs(lab.x))
# draw vertical lines
abline(v=0)
abline(v=c(-1, 1)*50, lty=2)
# bar middle y coordinates
bar.mid <- c(.3, .7)
# bar height
bar.ht <- .25
# draw bars
rect(c(tab), bar.mid - bar.ht/2, 0, bar.mid + bar.ht/2,
col=rep(gray(c(.8, .2)), each=2))
mtext(c('No pain', 'Pain'), 3, at=c(-1, 1)*40, cex=1.3, line=.5)
# print bar labels (male, female)
text(min(lab.x), bar.mid, rownames(tab), adj=0)
You probably need to wrangle your data into a more appropriate format for plotting. Here's one method of doing it:
library(tidyverse)
data %>%
count(response, sex) %>%
mutate(n = ifelse(response == 0, -n, n)) %>%
ggplot(aes(sex, n, fill = factor(response))) +
geom_hline(yintercept = 0) +
geom_hline(yintercept = c(-3, 3), linetype = 2, size = 0.2) +
geom_col(position = 'identity', color = 'black', width = 0.5) +
coord_flip() +
scale_y_continuous(breaks = seq(-7, 7), name = 'count', limits = c(-7, 7)) +
scale_fill_manual(values = c("#bebebe", "#2a2a2a"), guide = 'none') +
annotate('text', y = c(-4, 4), x = c(2.8, 2.8), vjust = 1, size = 6,
label = c('RESPONSE = 0', 'RESPONSE = 1'), fontface = 2) +
scale_x_discrete(expand = c(0, 1), name = NULL) +
theme_minimal(base_size = 16) +
theme(axis.line.x = element_line(),
axis.ticks.x = element_line(),
panel.grid = element_blank())

Plotting angular data in ggplot

I have a set of angles that I want to plot, compare and visualise in a circular scale and then patch them into a comparative figure panel. I understand the plot function does what I want for an individual dataset. However, I have multiple of them and want to compare and visualise them with better aesthetics (like in ggplots). Primarily I want to overlay 2 circles on each other and compare them. Here is a sample of my data
a<-c(289.25, 279.61, 288.09, 208.22, 295.74, 214.48, 192.51, 269.93, 225.89, 215.65)
a
ap<-circular(a, template = "geographics", modulo = "2pi")
plot(ap)
arrows.circular(ap, col = "blue", length = 0.25, angle = 30)
enter image description here
I tried the as.ggplot function from the ggplotify package as suggested here. However, I cannot add arrows or layers to my base plot by using as.ggplot (i.e) It converts the plot(ap)part in my example into a ggplot object but the next part (arrows.circular(ap, col = "blue", length = 0.25, angle = 30) is not working.
Is there a way I can draw these plots in ggplot or is there a way to convert the layers of base plots into ggplots using as.ggplot??
Any suggestions would be helpful. Thanks in advance!
You can recreate the plot using ggplot like this:
library(ggplot2)
ggplot(data.frame(a = a %% (2 * pi))) +
geom_segment(aes(x = a, xend = a, y = 0, yend = 1), color = 'blue',
arrow = arrow()) +
geom_hline(yintercept = 1) +
annotate('text', x = 0:3 * pi/2, y = 0.9, label = c('N', 'E', 'S', 'W'),
size = 5) +
geom_point(aes(x = a, y = 1)) +
scale_x_continuous(limits = c(0, 2 * pi)) +
coord_polar() +
theme_void()
And it's certainly possible to alter its appearance to make it look a bit 'softer' and more professional, though this is of course a matter of taste:
library(ggplot2)
ggplot(data.frame(a = a %% (2 * pi))) +
annotate('rect', xmin = -Inf, xmax = Inf, ymin = 0, ymax = 1,
fill = 'gray97') +
geom_hline(yintercept = 1, color = 'gray60') +
geom_segment(aes(x = a, xend = a, y = 0, yend = 1),
color = 'deepskyblue4', size = 1, alpha = 0.5,
arrow = arrow(angle = 25, length = unit(4, 'mm'))) +
annotate('text', x = 0:3 * pi/2, y = 0.9, label = c('N', 'E', 'S', 'W'),
size = 7, fontface = 2, color = 'gray30') +
geom_point(aes(x = a, y = 1)) +
scale_x_continuous(limits = c(0, 2 * pi)) +
coord_polar() +
theme_void() +
theme(plot.background = element_rect(color = NA, fill = '#ecf1f4'))

How can arrows be added to faceted plots at different positions on each plot but at a constant angle?

This is a tricky one, and I'm making it trickier by basically asking two questions concurrently. But they're related (in practice, if not in theory).
The issue
Basically I want to use one script and one data frame to create a faceted plot with arrows:
at unique locations on each plot and
at consistent angles regardless of the scale.
The goal is to use the arrows to indicate dosing of a therapeutic, which might change for individuals or treatment cohorts.
Example dataset
Here's an example of the sort of data which I might need to plot with arrows:
df_3 <- tibble(
ID = rep(1:2, each = 10),
TIME = rep(1:10, times = 2),
DV = c(runif(10), runif(10) * 5)
)
An example plot of what I DON'T want
The follow code generates an example of where I am, but not where I want to be:
ggplot(data = df_3, aes(x = TIME, y = DV)) +
geom_line() +
facet_wrap(~ID, scales = "free_y") +
annotate("segment",
x = c(0.5, 1.5, 2.5), xend = c(0, 1, 2), y = 0.05, yend = 0,
arrow = arrow(length = unit(0.20, "cm"), type = "closed"))
Note that the arrows can only be set to a single series of locations (which are tedious to add, since I need to finagle the x and xend variables to get the angle I want) and, because the y-axes are different, the angles of each set of angles is different.
For example, let's say I want arrows at times 0, 1, and 2 for Individual 1, but at times 2, 4, and 6 for Individual 2.
I'm thinking I need to add the location for the arrows into the dataset, but I'm worried that will force ggplot to plot the arrows for every individual plot, creating fuzzy/dark arrows.
I'm open to any and all suggestions or thoughts. I appreciate your time.
The problem you're running into is that the arrows are totally defined in dataspace, which can skew the angle in visual space. One way to tackle it is to write your own geom that draws it exactly as you like, but that feels like overkill for a task that seems so simple.
This seems like a nice use case for Paul Murrell's gggrid package. One of the possibilities is to create a function that takes the raw data and transformed data (called coords), and outputs the desired graphical object.
# devtools::install_github("pmur002/gggrid")
library(ggplot2)
library(gggrid)
#> Loading required package: grid
df_3 <- data.frame(
ID = rep(1:2, each = 10),
TIME = rep(1:10, times = 2),
DV = c(runif(10), runif(10) * 5)
)
arrows <- function(data, coords) {
offset <- unit(4, "mm")
segmentsGrob(
x0 = unit(coords$x, "npc") + offset,
x1 = unit(coords$x, "npc"),
y0 = unit(coords$y, "npc") + offset,
y1 = unit(coords$y, "npc"),
arrow = arrow(length = unit(0.2, "cm"), type = "closed"),
gp = gpar(fill = "black")
)
}
ggplot(data = df_3, aes(x = TIME, y = DV)) +
geom_line() +
facet_wrap(~ID, scales = "free_y") +
grid_panel(data = data.frame(TIME = c(0.5, 1.5, 2.5), DV = 0),
grob = arrows)
The nice thing is that this is not a static annotation such as annotation_custom() which is simply repeated along facets. In the example below we can see that the second arrow gets send to the second panel.
ggplot(data = df_3, aes(x = TIME, y = DV)) +
geom_line() +
facet_wrap(~ID, scales = "free_y") +
grid_panel(data = data.frame(TIME = c(0.5, 1.5, 2.5),
DV = 0, ID = c(1, 2, 1)), # <- facet var
grob = arrows)
Created on 2021-09-21 by the reprex package (v2.0.1)
Not sure whether I fully understand what you are trying to achieve but one option to add your arrows would be to make use of annotation_custom instead of annotate.
set.seed(123)
library(tibble)
df_3 <- tibble(
ID = rep(1:2, each = 10),
TIME = rep(1:10, times = 2),
DV = c(runif(10), runif(10) * 5)
)
library(grid)
library(ggplot2)
segment <- segmentsGrob(x0 = unit(.05, "npc"), y0 = unit(.05, "npc"),
x1 = unit(0, "npc"), y1 = unit(0, "npc"),
arrow = arrow(angle = 45, length = unit(0.2, "cm"), type = "closed"), gp = gpar(fill = "black"))
ggplot(data = df_3, aes(x = TIME, y = DV)) +
geom_line() +
scale_x_continuous(limits = c(0, NA)) +
scale_y_continuous(limits = c(0, NA)) +
facet_wrap(~ID, scales = "free_y") +
lapply(0:2, function(xmin) {
annotation_custom(grob = segment, xmin = xmin, ymin = 0, xmax = max(df_3$TIME) + xmin)
})

Convert plot to ggplot and add horizontal lines until specific points

I have creted the plot below using the base R plot() function but I would like to convert it to ggplot() and also add horizontal lines like in the example picture but until the crossing with the graphs and not a full continuing horizontal line until the end.
# Figure 3.1 & 3.2
# curve(logistic(pnorm(x), a=1, d=0),-3,3,ylab="Probability of x",
# main="Logistic transform of x",xlab="z score units")
# #logistic with a=1.702 is almost the same as pnorm
# curve(logistic(pnorm(x), d=1),add=TRUE)
# Set x-axis values
theta <- seq(from = -10, to = 10, by = 0.001)
# Code for plot1
B_i <- 1
B_j <- -1
P_item1_rasch <- NULL
P_item2_rasch <- NULL
for (i in 1:length(theta)){
P_item1_rasch[i] <- (exp((theta[i]-B_i)))/(1+(exp((theta[i]-B_i))))
P_item2_rasch[i] <- (exp((theta[i]-B_j)))/(1+(exp((theta[i]-B_j))))
}
#select the colors that will be used
library(RColorBrewer)
#all palette available from RColorBrewer
display.brewer.all()
#we will select the first 4 colors in the Set1 palette
cols<-brewer.pal(n=4,name="Set1")
#cols contain the names of four different colors
plot(theta, P_item1_rasch, xlim=c(-4,4), ylim=c(0,1))
lines(theta, P_item2_rasch,col=cols[2])
# Add lines at the values below, but only half as in the example Figures
# abline(h=0.5)
# abline(v=-1)
# abline(v=1)
Perhaps something like this?
theta <- seq(from = -10, to = 10, by = 0.001)
# Code for plot1
B_i <- 1
B_j <- -1
P_item0_rasch <- NULL
P_item1_rasch <- NULL
P_item2_rasch <- NULL
for (i in 1:length(theta)){
P_item0_rasch[i] <- (exp((theta[i])))/(1+(exp((theta[i]))))
P_item1_rasch[i] <- (exp((theta[i]-B_i)))/(1+(exp((theta[i]-B_i))))
P_item2_rasch[i] <- (exp((theta[i]-B_j)))/(1+(exp((theta[i]-B_j))))
}
df <- data.frame(theta = rep(theta, 3),
P_item_rasch = c(P_item0_rasch, P_item1_rasch, P_item2_rasch),
number = factor(rep(1:3, each = length(theta))))
library(ggplot2)
ggplot(df, aes(theta, P_item_rasch, color = number)) +
geom_line() +
lims(x = c(-6, 6)) +
geom_segment(x = -1, xend = 1, y = 0.5, yend = 0.5, lty = 2) +
geom_vline(xintercept = c(-1, 0, 1), lty = 2) +
scale_color_manual(values = RColorBrewer::brewer.pal(4, "Set1")[-1]) +
theme_classic() +
theme(legend.position = "none")
#> Warning: Removed 24000 row(s) containing missing values (geom_path).
Edit
The OP changed the question to alter the requirements. Here is a way to achieve them:
ggplot(df, aes(theta, P_item_rasch)) +
geom_line(aes(color = number)) +
lims(x = c(-6, 6)) +
# Line between curves
geom_segment(x = -1, xend = 1, y = 0.5, yend = 0.5, lty = 2) +
# Optional line on left
geom_segment(x = -Inf, xend = -1, y = 0.5, yend = 0.5, lty = 2) +
# Lower lines
geom_segment(data = data.frame(theta = c(-1, 0, 1), P_item_rasch = rep(-Inf, 3)),
aes(xend = theta, yend = 0.5), lty = 2) +
# Upper lines
#geom_segment(data = data.frame(theta = c(-1, 0, 1), P_item_rasch = rep(Inf, 3)),
# aes(xend = theta, yend = 0.5), lty = 2) +
scale_color_manual(values = RColorBrewer::brewer.pal(4, "Set1")[-1]) +
theme_classic() +
theme(legend.position = "none")
Created on 2020-12-06 by the reprex package (v0.3.0)

How to prevent xlim from changing the height using geom_curve?

I have the following code:
library(tidyverse)
data_frame(x = 1:5, x1=x+1, c = c('a','a','a','b','b')) %>%
ggplot() +
geom_curve(aes(x = x, xend= x1, y = 0, yend = 0), curvature = -1.3, alpha=.2) +
facet_wrap(~ c, ncol=1)
but I would like to tweak the limits of the y axis to cut the background area above ~ .1.
I tried to do this:
data_frame(x = 1:5, x1=x+1, c = c('a','a','a','b','b')) %>%
ggplot() +
geom_curve(aes(x = x, xend= x1, y = 0, yend = 0), curvature = -1.3, alpha=.2) +
facet_grid(c ~ .) +
ylim(0,.35) +
facet_wrap(~ c, ncol=1)
but it simply rescales the archs based on the values in ylim. How can I prevent this behavior?
coord_fixed() has arguments that allow you to control precisely what you would like to have here.
See also http://ggplot2.tidyverse.org/reference/coord_fixed.html for reference.
Unfortunately, it is however not possible to use your x and x1 in a dynamic way inside coord_fixed().
As long as you are fine putting absolute values (0.6 and 6.4 below), you can however do something like this:
data_frame(x = 1:5, x1 = x+1, c = c('a','a','a','b','b')) %>%
ggplot(.) +
geom_curve(aes(x = x, xend = x1, y = 0, yend = 0), curvature = -1.3, alpha = .2) +
facet_grid(c ~ .) +
coord_fixed(ratio = 7, xlim = c(0.6, 6.4), ylim = c(0, 0.12), expand = FALSE) +
scale_y_continuous(breaks = c(0, 0.1))
Assuming this looks like what you would want it to look like, note that I set expand = FALSE to start ylim at zero, and added buffers to xlim (0.4) and the upper bound of ylim.
I have modified the default ratio value from 1 to 7, to scale you back down from the 0.7 to 0.1, which is what I understand you would like to have in the end. ratio = 1 would imply that you have the same scale (same distances) on the y-axis as on the x-axis (which is what you refer to as re-scaling I believe).
Finally I had to add the manual breaks for the y-axis (to have fewer ones), such that the grid boxes would be a bit larger, which again is just what I infer as your possible wish.
Does replacing ylim(0,.35) with coord_fixed(ylim=c(0, 0.35)) do what you want?

Resources