Estimated averages of a glmm by the emmeans package - r

I am trying to plot the estimated means using a negative binomial random effects model with their respective confidence intervals, in which the data and the fit were defined as follows:
d.AD <- data.frame(treatment = gl(12,12),
treatment2 = gl(4,1,36),
counts = rpois(144, 4.03),
treatment3 = gl(3,4,36),
ID = gl(12,12))
d.AD$treatment2 = as.integer(d.AD$treatment2)
d.AD$treatment3 = as.factor(d.AD$treatment3)
d.AD$ID = as.factor(d.AD$ID)
library(ggplot2)
library(lme4)
library(emmeans)
mode1A <- glmer.nb(counts~treatment3+poly(treatment2, 2) + (1|ID),
data=d.AD, verbose=F)
The function to make the averages with the confidence intervals used was the emmeans of the emmeans package. However, see that the shape of the graph is inverted, that is, I would like the x axis to be my y axis and vice versa.
emm1 = emmeans(mode1A,~"treatment3", type="response")
emm1df = as.data.frame(emm1)
plot(emm1) +
geom_point(size=2.2)+
labs(x = 'Response', y = 'Treatment') +
scale_shape_manual(NULL, values = 18) +
theme(legend.title = element_text(size = 25,color = "black"),
legend.text = element_text(size = 25,color = "black"),
axis.title = element_text(size = 25,color = "black"),
axis.text.x = element_text(color = "black", hjust=1),
axis.text.y = element_text(color = "black", hjust=1),
axis.text = element_text(size = 25,color = "black"),
plot.title = element_blank(),
strip.text.x = element_text(size = 15,color = "black"))
I would like something close to this example.

You could do something like:
emm1df |>
ggplot(aes(x = treatment3,
y = response,
label = round(response,2)
)
) +
geom_point(size = 2) +
geom_errorbar(aes(ymin = asymp.LCL,
ymax = asymp.UCL),
width = 0
) +
geom_label(nudge_y = (emm1df$asymp.UCL-emm1df$response)*1.2) +
ylim(c(3,5)) +
labs(x = "Treatment",
y = "Response")

Try
plot(emm1, horizontal = FALSE)
See `? plot.emmGrid

Related

histogram with densities estimated by a model in ggplot2

I'm trying to make a plot in ggplot2 of the densities estimated by a model fitted in gamlss.
I performed this using R base, as shown below:
library(gamlss)
library(ggplot2)
data(Orange)
mod.g = gamlss(circumference ~ age,
family=GA, data = Orange)
pred.g <- predict(mod.g, type = "r")
shapex = (mean(pred.g)/sd(pred.g))^2
ratex = mean(pred.g)/sd(pred.g)^2
hist(Orange$circumference, freq = FALSE, breaks = seq(0, 240, 20))
curve(dgamma(x,
shapex,
ratex), add = T,col = "blue",lwd=2)
legend("topright", legend = c("Gamma"), lty = 1, col = "blue")
Result:
However, when I tried to perform this in ggplot2 the lines are not being plotted, see:
ggplot(Orange, aes(x = circumference)) +
geom_histogram(color = "black", fill = "#225EA8", binwidth=30) +
geom_line(aes(shapex, ratex)) +
theme(legend.title = element_text(size = 15),
legend.text = element_text(size = 17),
axis.title = element_text(size = 22),
axis.text.x = element_text(color = "black", hjust=1),
axis.text.y = element_text(color = "black", hjust=1),
axis.text = element_text(size = 15),
strip.text.x = element_text(size = 18))
After_stat is necessary, but doesn't do the entire trick. With curve you are actually plotting a function. You are passing two constants to your geom_line - how are you expecting ggplot2 to know that you want to plot a gamma distribution with those two constants as parameter?
For this, you could use stat_function
ggplot(Orange, aes(x = circumference)) +
geom_histogram(aes(y = after_stat(density)), color = "black", fill = "#225EA8", binwidth=30) +
stat_function(fun = function(x) dgamma(x, shapex, ratex))
Created on 2023-02-15 with reprex v2.0.2

Plot linear mixed-effects model using function ggemmeans

Say, I have a linear mixed-effects model:
## create data
iris$group = c(rep('A', each = 75),
rep('B', each = 75))
iris$id = rep(c(1:10), each = 15)
## assign contrasts
iris$group <- factor(iris$group, levels=c('A', 'B'))
(contrasts(iris$group) <- matrix(dimnames=list(levels(iris$group), c('.sum.group')), c(-0.5, 0.5), nrow=2))
## build the model
LMM = lmer(Sepal.Length ~ 1 +
Sepal.Width +
Petal.Length +
Petal.Width +
group*Petal.Width +
(1|id),
data = iris,
control=lmerControl(optimizer="bobyqa",
optCtrl=list(maxfun=2e5)),
REML = FALSE)
Now, I need to plot the interaction group*Petal.Width from the model using the function ggemmeans. Exactly this function must be used in my case.
The documentation for the function says, it gives a standard ggplot-object as an output. However, I couldn't figure out how to adjust its aesthetics, and it seems that it's not exactly how ggplot would behave. Here is the best that I could achieve:
ggemmeans(LMM, terms = c("Petal.Width", "group")) %>% plot()+
geom_line(aes(linetype=group))+
aes(linetype = group)+
theme(legend.title = element_text(size=30),
legend.position = 'top',
legend.key.size = unit('1.5', 'cm'),
axis.title.y = element_text(size = rel(2), angle = 90),
axis.title.x = element_text(size = rel(2)),
axis.text.x = element_text(size=20),
axis.text.y = element_text(size=20))+
scale_colour_manual(values = c("orangered", "purple"))
Now, how could I at least
Remove the thin dashed line behind the thick dashed one?
Change the color of the confidence intervals to the color of the lines? (now the plot is using standard colors for CIs, whatever color I assign to the lines)
Make sure these CIs reflect 95% CIs and not something else? (e.g., in a similar function plot_model, there's an argument for controlling this)
The fill and color are mapped to a variable called group_col created by ggemmeans, so you can do:
ggemmeans(LMM, terms = c("Petal.Width", "group")) %>%
plot() +
aes(linetype = group_col) +
theme(legend.title = element_text(size=30),
legend.position = 'top',
legend.key.size = unit('1.5', 'cm'),
axis.title.y = element_text(size = rel(2), angle = 90),
axis.title.x = element_text(size = rel(2)),
axis.text.x = element_text(size=20),
axis.text.y = element_text(size=20))+
scale_colour_manual("group", values = c("orangered", "purple")) +
scale_fill_manual("group", values = c("orangered", "purple"),
guide = "legend") +
scale_linetype_manual("group", values = 1:2) +
guides(fill = guide_legend(override.aes =
list(fill = c("orangered", "purple"))))

plotting p-values using ggplot stat_summary

I want to plot a dataframe (stats) with the coefficient and error bars, and automatically write the p-values above each point.
stats <- data.frame(Coefficient = c(-0.07,-0.04,-0.15173266),
p_value = c(.0765210755,0.5176050652,0.0001309025),
conf_low = c(-.1544418,-0.1686583,-0.2294873),
conf_high = c(0.007812205,0.084939487,-0.073978033),
Test = c("TestA","TestB","TestC"))
I am trying to make a function to plot the p-values above each Coefficient point. (The coord_flip in the plot below may also be throwing me off.
give.pval <- function(y){
return(c(x = Coefficient, label = stats$p_value))
}
The following ggplot is exactly what I need, except for the stat_summary line which I am doing incorrectly
ggplot(stats, aes(x = Test, y = Coefficient)) +
geom_point(aes(size = 6)) +
geom_errorbar(aes(ymax = conf_high, ymin = conf_low)) +
geom_hline(yintercept=0, linetype="dashed") +
#stat_summary(fun.data = give.pval, geom = "text") +
theme_calc() +
theme(panel.grid.major = element_blank(), panel.grid.minor = element_blank(),
axis.text.x = element_text(size = 12, vjust = 0.5), axis.title.x = element_text(size = 16),
axis.text.y = element_text(size = 12), axis.title.y = element_blank(),
legend.position = "none",
plot.title = element_text(hjust = 0.5, size = 24)) +
coord_flip() +
ylab("Coefficient")
I would like the have this plot but with the appropriate p-value above each of the three Coefficient points.
Thanks for any advice.
This could be achieved with a geom_text layer where you map p_value on the label aes and some additional nudging
library(ggplot2)
stats <- data.frame(Coefficient = c(-0.07,-0.04,-0.15173266),
p_value = c(.0765210755,0.5176050652,0.0001309025),
conf_low = c(-.1544418,-0.1686583,-0.2294873),
conf_high = c(0.007812205,0.084939487,-0.073978033),
Test = c("TestA","TestB","TestC"))
ggplot(stats, aes(x = Test, y = Coefficient)) +
geom_point(aes(size = 6)) +
geom_errorbar(aes(ymax = conf_high, ymin = conf_low)) +
geom_hline(yintercept=0, linetype="dashed") +
geom_text(aes(label = p_value), nudge_x = .2) +
theme(panel.grid.major = element_blank(), panel.grid.minor = element_blank(),
axis.text.x = element_text(size = 12, vjust = 0.5), axis.title.x = element_text(size = 16),
axis.text.y = element_text(size = 12), axis.title.y = element_blank(),
legend.position = "none",
plot.title = element_text(hjust = 0.5, size = 24)) +
coord_flip() +
ylab("Coefficient")

Partial italics in facet headings of ggplot

I am wondering if there is any way to rename facet titles so that they contain partial italics and partial non-italics.
Here is some toy data
library(Hmisc)
library(dplyr)
# Plot power vs. n for various odds ratios
n <- seq(10, 1000, by=10) # candidate sample sizes
OR <- as.numeric(sort(c(seq(1/0.90,1/0.13,length.out = 9),2.9))) # candidate ORs
alpha <- c(.001, .01, .05) # alpha significance levels
# put all of these into a dataset and calculate power
powerDF <- data.frame(expand.grid(OR, n, alpha)) %>%
rename(OR = Var1, num = Var2, alph = Var3) %>%
arrange(OR) %>%
mutate(power = as.numeric(bpower(p1=.29, odds.ratio=OR, n=num, alpha = alph))) %>%
transform(OR = factor(format(round(OR,2),nsmall=2)),
alph = factor(ifelse(alph == 0.001, "p=0.001",
ifelse(alph == 0.01, "p=0.01", "p=0.05"))))
pPower <- ggplot(powerDF, aes(x = num, y = power, colour = factor(OR))) +
geom_line() +
facet_grid(factor(alph)~.) +
labs(x = "sample size") +
scale_colour_discrete(name = "Odds Ratio") +
scale_x_continuous(breaks = seq(0,1000,100)) +
scale_y_continuous(breaks = seq(0,1,.1), sec.axis = sec_axis(trans=I, breaks=NULL, name="Significance Level")) + # this is the second axis label
theme_light() +
theme(axis.title.x = element_text(size = 12, face = "bold"),
axis.title.y = element_text(size = 12, face = "bold"),
axis.text = element_text(size = 11),
panel.grid.minor = element_blank(),
panel.grid.major.y = element_line(colour = "gray95"),
panel.grid.major.x = element_line(colour = "gray95"),
strip.text = element_text(colour = 'black', face = 'bold', size = 12),
legend.text = element_text(size = 12),
legend.title = element_text(size = 12, face = "bold"))
pPower
Is there any way to get the facet headings to read "p=0.001", "p=0.01" etc, instead of "p=0.001", i.e. to get partial italics and partial non-italics?

change color data points plotLearnerPrediction (MLR package)

I have produced some nice plots with the plotLearnerPrediction function of the MLR package. I was able to make some adjustments to the returned ggplot (see my code below). But I am not sure how to make the last adjustment. Namely, I want to change the coloring of the data points based on labels (groups in example plot).
My last plot (with black data points)
Another produced plot (overlapping data points)
This is the last version of my code (normally part of a for loop):
plot <- plotLearnerPrediction(learner = learner_name, task = tasks[[i]], cv = 0,
pointsize = 1.5, gridsize = 500) +
ggtitle(trimws(sprintf("Predictions %s %s", meta$name[i], meta$nr[i])),
subtitle = sprintf("DR = %s, ML = %s, CV = LOO, ACC = %.2f", meta$type[i],
toupper(strsplit(learner_name, "classif.")[[1]][2]), acc[[i]])) +
xlab(sprintf("%s 1", lab)) +
ylab(sprintf("%s 2", lab)) +
scale_fill_manual(values = colors) +
theme(plot.title = element_text(size = 18, face = "bold"),
plot.subtitle = element_text(size = 12, face = "bold", colour = "grey40"),
axis.text.x = element_text(vjust = 0.5, hjust = 1),
axis.text = element_text(size = 14, face = "bold"),
axis.title.x = element_text(vjust = 0.5),
axis.title = element_text(size = 16, face = "bold"),
#panel.grid.minor = element_line(colour = "grey80"),
axis.line.x = element_line(color = "black", size = 1),
axis.line.y = element_line(color = "black", size = 1),
panel.grid.major = element_line(colour = "grey80"),
panel.background = element_rect(fill = "white"),
legend.justification = "top",
legend.margin = margin(l = 0),
legend.title = element_blank(),
legend.text = element_text(size = 14))
Below is a part of the source code of the plotLearnerPrediction function. I want to overrule geom_point(colour = "black"). Adding simply geom_point(colour = "pink") to my code will not color data points, but the whole plot. Is there a solution to overrule that code with a vector of colors? Possibly a change in the aes() is also needed to change colors based on groups.
else if (taskdim == 2L) {
p = ggplot(mapping = aes_string(x = x1n, y = x2n))
p = p + geom_tile(data = grid, mapping = aes_string(fill = target))
p = p + scale_fill_gradient2(low = bg.cols[1L], mid = bg.cols[2L],
high = bg.cols[3L], space = "Lab")
p = p + geom_point(data = data, mapping = aes_string(x = x1n,
y = x2n, colour = target), size = pointsize)
p = p + geom_point(data = data, mapping = aes_string(x = x1n,
y = x2n), size = pointsize, colour = "black",
shape = 1)
p = p + scale_colour_gradient2(low = bg.cols[1L],
mid = bg.cols[2L], high = bg.cols[3L], space = "Lab")
p = p + guides(colour = FALSE)
}
You can always hack into gg objects. The following works for ggplot2 2.2.1 and adds a manual alpha value to all geom_point layers.
library(mlr)
library(ggplot2)
g = plotLearnerPrediction(makeLearner("classif.qda"), iris.task)
ids.geom.point = which(sapply(g$layers, function(z) class(z$geom)[[1]]) == "GeomPoint")
for(i in ids.geom.point) {
g$layers[[i]]$aes_params$alpha = 0.1
}
g
The plotLearnerPrediction() function returns the ggplot plot object, which allows for some level of customization without having to modify the source code. In your particular case, you can use scale_fill_manual() to set custom fill colors:
library(mlr)
g = plotLearnerPrediction(makeLearner("classif.randomForest"), iris.task)
g + scale_fill_manual(values = c("yellow", "orange", "red"))

Resources