Related
I am attempting to make a ggplot2 scatter plot that is grouped by bins in R. I successfully made the first model, which I did not try to alter the fill for. But when I tried to have the fill of the scatter plot be based upon my variable (Miss.) ,which is a numeric value ranging from 0.00 to 0.46, it essentially ignores the heat map scale and turns everything gray.
ggplot(data = RightFB, mapping = aes(x = TMHrzBrk, y = TMIndVertBrk))+
geom_bin_2d(bins = 15)+
scale_fill_continuous(type = "viridis")+
ylim(5, 20)+
xlim(0,15)+
coord_fixed(1.3)
ggplot(data = RightFB, mapping = aes(x = TMHrzBrk, y = TMIndVertBrk, fill
=Miss.))+
geom_bin_2d(bins = 15)+
scale_fill_continuous(type = "viridis")+
ylim(5, 20)+
xlim(0,15)+
coord_fixed(1.3)
I appreciate any help! Thanks!
I think I understand your problem, so let's replicate it with a reproducible example. Obviously we don't have your data, but the following data frame has the same names, types and ranges as your own data, so this walk-through should work for you.
set.seed(1)
RightFB <- data.frame(TMHrzBrk = runif(1000, 0, 15),
TMIndVertBrk = runif(1000, 5, 20),
Miss. = runif(1000, 0, 0.46))
Your first plot will look something like this:
library(tidyverse)
ggplot(data = RightFB, mapping = aes(x = TMHrzBrk, y = TMIndVertBrk)) +
geom_bin_2d(bins = 15) +
scale_fill_continuous(type = "viridis") +
ylim(5, 20) +
xlim(0, 15) +
coord_fixed(1.3)
#> Warning: Removed 56 rows containing missing values (`geom_tile()`).
Here, the fill colors represent the counts of observations within each bin. But if you try to map the fill to Miss., you get all gray squares:
ggplot(data = RightFB, mapping = aes(x = TMHrzBrk, y = TMIndVertBrk,
fill = Miss.)) +
geom_bin_2d(bins = 15) +
scale_fill_continuous(type = "viridis") +
ylim(5, 20) +
xlim(0, 15) +
coord_fixed(1.3)
#> Warning: The following aesthetics were dropped during statistical transformation: fill
#> i This can happen when ggplot fails to infer the correct grouping structure in
#> the data.
#> i Did you forget to specify a `group` aesthetic or to convert a numerical
#> variable into a factor?
#> Removed 56 rows containing missing values (`geom_tile()`).
The reason this happens is that by default geom_bin_2d calculates the bins and the counts within each bin to get the fill variable. There are multiple observations within each bin, and they all have a different value of Miss. . Furthermore, geom_bin_2d doesn't know what you want to do with this variable. My guess is that you are looking for the average of Miss. within each bin, but this is difficult to achieve within the framework of geom_bin_2d.
The alternative is to calculate the bins yourself, get the average of Miss. in each bin, and plot as a geom_tile
RightFB %>%
mutate(TMHrzBrk = cut(TMHrzBrk, breaks = seq(0, 15, 1), seq(0.5, 14.5, 1)),
TMIndVertBrk = cut(TMIndVertBrk, seq(5, 20, 1), seq(5.5, 19.5, 1))) %>%
group_by(TMHrzBrk, TMIndVertBrk) %>%
summarize(Miss. = mean(Miss., na.rm = TRUE), .groups = "drop") %>%
mutate(across(TMHrzBrk:TMIndVertBrk, ~as.numeric(as.character(.x)))) %>%
ggplot(aes(x = TMHrzBrk, y = TMIndVertBrk, fill = Miss.)) +
geom_tile() +
scale_fill_continuous(type = "viridis") +
ylim(5, 20) +
xlim(0, 15) +
coord_fixed(1.3)
EDIT
With the link to the data in the comments, here is a full reprex:
library(tidyverse)
RightFB <- read.csv(paste0("https://raw.githubusercontent.com/rileyfeltner/",
"FB-Analysis/main/Right%20FB.csv"))
RightFB <- RightFB[c(2:6, 9, 11, 13, 18, 19)]
RightFB$Miss. <- as.numeric(as.character(RightFB$Miss.))
#> Warning: NAs introduced by coercion
RightFB$TMIndVertBrk <- as.numeric(as.character(RightFB$TMIndVertBrk))
#> Warning: NAs introduced by coercion
RightFB <- na.omit(RightFB)
RightFB1 <- filter(RightFB, P > 24)
RightFB %>%
mutate(TMHrzBrk = cut(TMHrzBrk, breaks = seq(0, 15, 1), seq(0.5, 14.5, 1)),
TMIndVertBrk = cut(TMIndVertBrk, seq(5, 20, 1), seq(5.5, 19.5, 1))) %>%
group_by(TMHrzBrk, TMIndVertBrk) %>%
summarize(Miss. = mean(Miss., na.rm = TRUE), .groups = "drop") %>%
mutate(across(TMHrzBrk:TMIndVertBrk, ~as.numeric(as.character(.x)))) %>%
ggplot(aes(x = TMHrzBrk, y = TMIndVertBrk, fill = Miss.)) +
geom_tile() +
scale_fill_continuous(type = "viridis") +
ylim(5, 20) +
xlim(0, 15) +
coord_fixed(1.3)
#> Warning: Removed 18 rows containing missing values (`geom_tile()`).
Created on 2022-11-23 with reprex v2.0.2
I would like to group a series of lines by 2 factors using group = interaction in ggplot. Here is some sample code:
set.seed(123)
N <- 18
means <- rnorm(N,0,1)
ses <- rexp(N,2)
upper<- means+qnorm(0.975)*ses
lower<- means+qnorm(0.025)*ses
fruit <- rep(c("Apples","Bananas","Pears"), each=6)
size <- rep(rep(c("Small","Medium","Big"), each=2),3)
GMO <- rep(c("Yes","No"), 9)
d<- data.frame(means,upper,lower,fruit,size,GMO)
ggplot(data=d,
aes(x = fruit,y = means, ymin = lower, ymax = upper, col=size,linetype=GMO,group=interaction(GMO, size)))+
geom_hline(aes(fill=size),yintercept =1, linetype=2)+
xlab('labels')+ ylab("Parameter estimates (95% Confidence Interval)")+
geom_pointrange(position=position_dodge(width = 0.6)) +
scale_x_discrete(name="Fruits")+
coord_flip()-> fplot
dev.new()
fplot
Here's a link to the resulting graph: https://i.stack.imgur.com/5YF4F.png
I would like to bring the same coloured lines for each of the three groups closer together. In other words I would like the lines to cluster not only by the 'Fruit' variable but also the 'Size' variable for each of the fruits. poisition_dodge seems to only work for one of the interacting groups.
Thanks for your advice.
As far as I know that is not possible with position_dodge, i.e. it dodges according to the categories of the group aes. And it does not matter whether you map one variable on the group aes or an interaction of two or more. The groups are simply placed equidistant from one another.
One option to achieve your desired result would be to use the "facets that don't look like facets" trick which means faceting by fruit, mapping size on x and afterwards using theme options to get rid of the facet look plus some tweaking of the x scale:
set.seed(123)
N <- 18
means <- rnorm(N, 0, 1)
ses <- rexp(N, 2)
upper <- means + qnorm(0.975) * ses
lower <- means + qnorm(0.025) * ses
fruit <- rep(c("Apples", "Bananas", "Pears"), each = 6)
size <- rep(rep(c("Small", "Medium", "Big"), each = 2), 3)
GMO <- rep(c("Yes", "No"), 9)
d <- data.frame(means, upper, lower, fruit, size, GMO)
library(ggplot2)
ggplot(data = d, aes(x = size, y = means, ymin = lower, ymax = upper, col = size, linetype = GMO, group = GMO)) +
geom_hline(yintercept = 1, linetype = 2) +
xlab("labels") +
ylab("Parameter estimates (95% Confidence Interval)") +
geom_pointrange(position = position_dodge(width = 0.6)) +
scale_x_discrete(name = "Fruits", breaks = "Medium", labels = NULL, expand = c(0, 1)) +
coord_flip() +
facet_grid(fruit ~ ., switch = "y") +
theme(strip.placement = "outside",
strip.background.y = element_blank(),
strip.text.y.left = element_text(angle = 0),
panel.spacing.y = unit(0, "pt"))
Maybe you want to facet_wrap your size variable:
set.seed(123)
N <- 18
means <- rnorm(N,0,1)
ses <- rexp(N,2)
upper<- means+qnorm(0.975)*ses
lower<- means+qnorm(0.025)*ses
fruit <- rep(c("Apples","Bananas","Pears"), each=6)
size <- rep(rep(c("Small","Medium","Big"), each=2),3)
GMO <- rep(c("Yes","No"), 9)
d<- data.frame(means,upper,lower,fruit,size,GMO)
library(ggplot2)
#> Warning: package 'ggplot2' was built under R version 4.1.2
ggplot(data=d,
aes(x = fruit,y = means, ymin = lower, ymax = upper, col=size,linetype=GMO,group=interaction(GMO, size)))+
geom_hline(aes(fill=size),yintercept =1, linetype=2)+
xlab('labels')+ ylab("Parameter estimates (95% Confidence Interval)")+
geom_pointrange(position=position_dodge(width = 0.6)) +
scale_x_discrete(name="Fruits")+
coord_flip() +
facet_wrap(~size)-> fplot
#> Warning: geom_hline(): Ignoring `mapping` because `yintercept` was provided.
fplot
Created on 2022-07-13 by the reprex package (v2.0.1)
I’m visualizing some distributions with the ggdist package and would like to modify the width of the interval lines. For example, a basic plot created with stat_histinterval() creates a histogram with an interval at the bottom.
library(tidyverse)
library(ggdist)
set.seed(123)
dist <-
tibble(p_grid = seq(from = 0, to = 1, length.out = 1000),
prior = rep(1, times = 1000)) %>%
mutate(likelihood = dbinom(4, size = 15, prob = p_grid),
posterior = likelihood * prior,
posterior = posterior / sum(posterior)) %>%
slice_sample(n = 10000, weight_by = posterior, replace = TRUE)
ggplot(dist, aes(x = p_grid)) +
stat_histinterval(.width = c(0.67, 0.89))
What I would like to do is make the black interval lines thicker. From the documentation, it seems like the interval_size argument is what I need. However, specifying an interval size overwrites the entire interval (i.e., it looks like one interval instead of a 67% and 89% interval).
ggplot(dist, aes(x = p_grid)) +
stat_histinterval(interval_size = 5)
And specifying multiple sizes to the interval_size argument errors out.
ggplot(dist, aes(x = p_grid)) +
stat_histinterval(interval_size = c(5, 10))
#> Error: Aesthetics must be either length 1 or the same as the data (34): interval_size
Is there a way to modify the interval's thickness while preserving the presence of multiple intervals?
Created on 2022-01-14 by the reprex package (v2.0.1)
The argument for this is interval_size_range which for some reason is only documented on geom_slabinterval despite working in other functions:
ggplot(dist, aes(x = p_grid)) +
stat_histinterval(.width = c(0.67, 0.89),
interval_size_range = c(1, 3))
To eliminate the giant point, you want to change the default value of fatten_point which expands that point. For some reason, fatten_point also affects the size of the interval, so you'll need to increase the interval_size_range to compensate with a matching line size:
ggplot(dist, aes(x = p_grid)) +
stat_histinterval(.width = c(0.67, 0.89),
interval_size_range = c(2, 5),
fatten_point = 1)
Could you just use two interval statements?
ggplot(dist, aes(x = p_grid)) +
stat_histinterval(.width = .89, interval_size=10) +
stat_interval(.width = .67, interval_size=10, col="black", show.legend=FALSE)
The problem is that there is a bit of overplotting. You could just add all of the individual elements:
ggplot(dist, aes(x = p_grid)) +
geom_histogram(fill="gray55") +
stat_interval(.width = .67, interval_size=10, col="black", show.legend = FALSE) +
stat_interval(.width = .89, interval_size=5,col="black", show.legend = FALSE) +
geom_point(data=dist, aes(x=mean(p_grid), y=0), col="white", inherit.aes = FALSE, size=5)
Suppose a dataset containing count data per multiple time periods and per multiple groups in the following format:
set.seed(123)
df <- data.frame(group = as.factor(rep(1:3, each = 50)),
week = rep(1:50, 3),
rate = c(round(700 - rnorm(50, 100, 10) - 1:50 * 2, 0),
round(1000 - rnorm(50, 200, 10) - 1:50 * 2, 0),
round(1000 - rnorm(50, 200, 10) - 1:50 * 2, 0)))
group week rate
1 1 1 604
2 1 2 598
3 1 3 578
4 1 4 591
5 1 5 589
6 1 6 571
7 1 7 581
8 1 8 597
9 1 9 589
10 1 10 584
I'm interested in fitting a model-based trend line per groups, however, I want this trend line to be displayed only from a certain x value. To visualize the trend line using all data points (requires ggplot2):
df %>%
ggplot(aes(x = week,
y = rate,
group = group,
lty = group)) +
geom_line() +
geom_point() +
geom_smooth(method = "glm",
method.args = list(family = "quasipoisson"),
se = FALSE)
Or to fit a model based on a specific range of values (requires ggplot2 and dplyr):
df %>%
group_by(group) %>%
mutate(rate2 = ifelse(week < 35, NA, rate)) %>%
ggplot(aes(x = week,
y = rate,
group = group,
lty = group)) +
geom_line() +
geom_point() +
geom_smooth(aes(y = rate2),
method = "glm",
method.args = list(family = "quasipoisson"),
se = FALSE)
However, I cannot find a way to fit the models using all data, but display the trend line only from a specific x value (let's say 35+). Thus, I essentially want the trend line as computed for plot one, but displaying it according the second plot, using ggplot2 and ideally only one pipeline.
I went to look at the after_stat function mentioned by #tjebo. See if the following works for you?
df %>%
ggplot(aes(x = week,
y = rate,
lty = group)) +
geom_line() +
geom_point() +
geom_smooth(method = "glm",
aes(group = after_stat(interaction(group, x > 35)),
colour = after_scale(alpha(colour, as.numeric(x > 35)))),
method.args = list(family = "quasipoisson"),
se = F)
This works by splitting the points associated with each line into two groups, those in the x <=35 region and those in the x >35 region, since a line's colour shouldn't vary, and defining a separate colour transparency for each new group. As a result, only the lines in the x > 35 region are visible.
When used, the code triggers a warning that the after_scale modification isn't applied to the legend. I don't think that's a problem though, since we don't need it to appear in the legend anyway.
If you can tolerate a warning, you can solve this with 1 line difference from the example code using stage().
library(tidyverse)
set.seed(123)
df <- data.frame(group = as.factor(rep(1:3, each = 50)),
week = rep(1:50, 3),
rate = c(round(700 - rnorm(50, 100, 10) - 1:50 * 2, 0),
round(1000 - rnorm(50, 200, 10) - 1:50 * 2, 0),
round(1000 - rnorm(50, 200, 10) - 1:50 * 2, 0)))
df %>%
ggplot(aes(x = week,
y = rate,
group = group,
lty = group)) +
geom_line() +
geom_point() +
geom_smooth(method = "glm",
method.args = list(family = "quasipoisson"),
aes(x = stage(week, after_stat = ifelse(x > 35, x, NA))),
se = FALSE)
#> `geom_smooth()` using formula 'y ~ x'
#> Warning: Removed 165 rows containing missing values (geom_smooth).
One way to do this is to construct the fitted values outside of ggplot so you have control over them:
df$fit <- glm(rate ~ week + group, data = df, family = "quasipoisson")$fitted.values
library(dplyr)
library(ggplot2)
ggplot(df, aes(x = week, group = group, lty = group)) +
geom_line(aes(y = rate)) +
geom_point(aes(y = rate)) +
geom_line(data = df %>% filter(week >= 35), aes(y = fit), color = "blue", size = 1.25)
I am not sure if it is generally correct to use a linear model in time series. The whole point about time series is that they require specific statistics because of their expected autocorrelation. You might want something like average rolling models instead.
I am not sure if your visualisation might not be quite confusing and, more dangerously, misleading.
Besides, an interesting problem. I thought the new after_stat might somehow help, but I couldn't get it working.
So, here a quick hack. Change the order of your geom-s and draw a rectangle in-between. I am cheekily using a different theme, but if you really want to use theme_grey(), you can fake the axis lines as well.
library(tidyverse)
set.seed(123)
df <- data.frame(group = as.factor(rep(1:3, each = 50)),
week = rep(1:50, 3),
rate = c(round(700 - rnorm(50, 100, 10) - 1:50 * 2, 0),
round(1000 - rnorm(50, 200, 10) - 1:50 * 2, 0),
round(1000 - rnorm(50, 200, 10) - 1:50 * 2, 0)))
df %>%
ggplot(aes(x = week, y = rate, group = group, lty = group)) +
stat_smooth(se = FALSE) +
geom_rect(xmin = -Inf, xmax = 35, ymin = -Inf, ymax = Inf,
fill = "white") +
geom_line() +
geom_point() +
theme_classic()
#> `geom_smooth()` using method = 'loess' and formula 'y ~ x'
Created on 2021-02-09 by the reprex package (v1.0.0)
P.S. I've removed a few of the unnecessary bits in the code to reproduce this, like the model specs.
You could use ggplot_build to get the structure of the plot :
p <- ggplot(df, aes(x = week,
y = rate,
group = group,
lty = group)) +
geom_line() +
geom_point() +
geom_smooth(method = "glm",
method.args = list(family = "quasipoisson"),
se = FALSE)
p_build <- ggplot_build(p)
You could then modify the internal data, here the third element of the data list (geom_smooth):
p_build$data[[3]]$x <- sapply(p_build$data[[3]]$x,function(x) {ifelse(x<35,NA,x)})
and use ggplot_gtable to regenerate the plot (the lm calculations still apply to the whole dataset):
plot(ggplot_gtable(p_build))
I am creating animated plotly graph for my assignment in r, where I am comparing several models with various number of observations. I would like to add annotation showing what is the RMSE of the current model - this means I would like to have text that changes together with slider. Is there any easy way how to do that?
Here is my dataset stored on GitHub. There already is created variable with RMSE: data
The base ggplot graphic is as follows:
library(tidyverse)
library(plotly)
p <- ggplot(values_predictions, aes(x = x)) +
geom_line(aes(y = preds_BLR, frame = n, colour = "BLR")) +
geom_line(aes(y = preds_RLS, frame = n, colour = "RLS")) +
geom_point(aes(x = x, y = target, frame = n, colour = "target"), alpha = 0.3) +
geom_line(aes(x = x, y = sin(2 * pi * x), colour = "sin(2*pi*x)"), alpha = 0.3) +
ggtitle("Comparison of performance) +
labs(y = "predictions and targets", colour = "colours")
This is converted to plotly, and I have added an animation to the Plotly graph:
plot <- ggplotly(p) %>%
animation_opts(easing = "linear",redraw = FALSE)
plot
Thanks!
You can add annotations to a ggplot graph using the annotate function: http://ggplot2.tidyverse.org/reference/annotate.html
df <- data.frame(x = rnorm(100, mean = 10), y = rnorm(100, mean = 10))
# Build model
fit <- lm(x ~ y, data = df)
# function finds RMSE
RMSE <- function(error) { sqrt(mean(error^2)) }
library(ggplot2)
ggplot(df, aes(x, y)) +
geom_point() +
annotate("text", x = Inf, y = Inf, hjust = 1.1, vjust = 2,
label = paste("RMSE", RMSE(fit$residuals)) )
There seems to be a bit of a problem converting between ggplot and plotly. However this workaround here shows a workaround which can be used:
ggplotly(plot) %>%
layout(annotations = list(x = 12, y = 13, text = paste("RMSE",
RMSE(fit$residuals)), showarrow = F))
Here's an example of adding data dependent text using the built in iris dataset with correlation as text to ggplotly.
library(plotly)
library(ggplot2)
library(dplyr)
mydata = iris %>% rename(variable1=Sepal.Length, variable2= Sepal.Width)
shift_right = 0.1 # number from 0-1 where higher = more right
shift_down = 0.02 # number from 0-1 where higher = more down
p = ggplot(mydata, aes(variable1,variable2))+
annotate(geom = "text",
label = paste0("Cor = ",as.character(round(cor.test(mydata$variable1,mydata$variable2)$estimate,2))),
x = min(mydata$variable1)+abs(shift_right*(min(mydata$variable1)-max(mydata$variable1))),
y = max(mydata$variable2)-abs(shift_down*(min(mydata$variable2)-max(mydata$variable2))), size=4)+
geom_point()
ggplotly(p) %>% style(hoverinfo = "none", traces = 1) # remove hover on text