Plotting dr4pl dose response curves, and how to integrate them with ggplot2? - r

I am trying to set up a high-throughput way of plotting out dose response curves from a large screening experiment. Prism obviously has the easiest way of doing dose-response curves well, but I can't copy and paste this much data.
Since CRAN removed drc, the package dr4pl seems the way to go, but there is very little instruction available yet.
#make data frame
dose <- c("0.078125","0.156250","0.312500","0.625000","1.250000","2.500000","5.000000","10.000000","20.000000")
POC<-c("1.05637425", "0.87380081", "0.79171200", "0.83166848", "0.77361290", "0.35199288", "0.19404609", "0.09079221", "0.09850658")
data<-data.frame(dose, POC)
#use the dr4pl pakcage to calculate curve and IC50 etc
model<-dr4pl(POC~dose, data)
summary.model <- summary(model)
summary.model$coefficients
#plot this
plot(dr4pl(POC~dose, data=data))
The above will generate the type of curve I need using dr4pl, and get me the IC50. but how would I plot several datasets/curves on one plot?
Ideally I'd rather plot the data using ggplot2: plot+geom_point() and add in the dose response line by using the dr4pl summary as a +stat_smooth() model, if that makes sense? But I don't know how to do this.
Any help would be appreciated

I can get most of the way but not all the way. The main step is to write a predict() method for dr4pl objects:
predict.dr4pl <- function (object, newdata=NULL, se.fit=FALSE, level, interval) {
xseq <- if (is.null(newdata)) object$data$Dose else newdata$x
pred <- MeanResponse(xseq, object$parameters)
if (!se.fit) {
return(pred)
}
qq <- qnorm((1+level)/2)
se <- sapply(xseq,
function(x) car::deltaMethod(object,
"UpperLimit + (LowerLimit - UpperLimit)/(1 + (x/IC50)^Slope)")[["Estimate"]])
return(list(fit=data.frame(fit=pred,lwr=pred-qq*se,
upr=pred+qq*se), se.fit=se))
}
I included a slightly hacky way to compute the confidence intervals via the delta method - this might not be too reliable (bootstrapping would be better ...)
It works OK (sort of) for your data (changed the name to dd because it's sometimes dicey to name the data data (fortunes::fortune("dog"))).
dd <- data.frame(dose = c(0.078125,0.156250,0.312500,0.625000,1.25,
2.50,5.0,10.0,20.0),
POC = c(1.05637425, 0.87380081, 0.79171200,
0.83166848, 0.77361290, 0.35199288,
0.19404609, 0.09079221, 0.09850658))
library(dr4pl)
ggplot(dd, aes(dose,POC)) + geom_point() +
geom_smooth(method="dr4pl",se=TRUE) + coord_trans(x="log10")
the confidence intervals are terrible, turn them off with se=FALSE
dr4pl puts the x-axis on a log10-scale by default, but the standard scale_x_log10() screws this up because it is applied before the fitting and prediction, so I use coord_trans(x="log10") instead.
However, coord_trans() doesn't play so nicely if the axes are on a very broad logarithmic scale - I tried the example above with the sample_data_1 data from the package and it didn't work.
But I'm afraid I've spent enough time on this for now.
It would more robust to use the predict method above to generate the values you want, over the range you want, separately, and then use geom_line() + geom_ribbon() to add the information to the plot ....
If you're willing to fit the model first (outside geom_smooth) you can do this (this is using sample_data_1 from dr4pl package - it's from the first example in ?dr4pl)
model2 <- dr4pl(dose = sample_data_1$Dose,
response = sample_data_1$Response)
ggplot(sample_data_1, aes(Dose,Response)) + geom_point() +
stat_function(fun=function(x) predict(model2,newdata=data.frame(x=x))) +
scale_x_log10()
which is less sensitive to the order of scaling/unscaling the x axis.
Improved but slow bootstrap CIs:
predictdf.dr4pl <- function (model, xseq, se, level, nboot=200) {
pred <- MeanResponse(xseq, model$parameters)
if (!se) {
return(base::data.frame(x=xseq, y=pred))
}
## bootstrap residuals
pred0 <- MeanResponse(model$data$Dose, model$parameters)
res <- pred0-model$data$Response
bootres <- matrix(nrow=length(xseq), ncol=nboot)
pb <- txtProgressBar(max=nboot,style=3)
for (i in seq(nboot)) {
setTxtProgressBar(pb,i)
mboot <- dr4pl(model$data$Dose,
pred0 + sample(res, size=length(pred0),
replace=TRUE))
bootres[,i] <- MeanResponse(xseq, mboot$parameters)
}
fit <- data.frame(x = xseq,
y=pred,
ymin=apply(bootres,1,quantile,(1-level)/2),
ymax=apply(bootres,1,quantile,(1+level)/2))
return(fit)
}
print(ggplot(dd, aes(dose,POC))
+ geom_point()
+ geom_smooth(method="dr4pl",se=TRUE) + coord_trans(x="log10")
)

Related

Export results from LOESS plot

I am trying to export the underlying data from a LOESS plot (blue line)
I found this post on the subject and was able to get it to export like the post says:
Can I export the result from a loess regression out of R?
However, as the last comment from the poster in that post says, I am not getting the results for my LOESS line. Does anyone have any insights on how to get it to export properly?
Thanks!
Code for my export is here:
#loess object
CL111_loess <- loess(dur_cleaned~TS_LightOn, data = CL111)
#get SE
CL111_predict <- predict(CL111_loess, se=T)
CL111_ouput <- data.frame("fitted" = CL111_predict$fit, "SE"=CL111_predict$se.fit)
write.csv(CL111_ouput, "CL111_output.csv")
Data for the original plot is here:
Code for my original plot is here:
{r}
#individual plot
ggplot(data = CL111) + geom_smooth(mapping = aes(x = TS_LightOn, y = dur_cleaned), method = "lm", se = FALSE, colour = "Green") +
labs(x = "TS Light On (Seconsd)", y = "TS Response Time (Seconds)", title = "Layout 1, Condition AO, INS High") +
theme(plot.title = element_text(hjust = 0.5)) +
stat_smooth(mapping = aes(x = TS_LightOn, y = dur_cleaned), method = "loess", se = TRUE) + xlim(0, 400) + ylim (0, 1.0)
#find coefficients for best fit line
lm(CL111_LM$dur_cleaned ~ CL111_LM$TS_LightOn)
You can get this information via ggplot_build().
If your plot is saved as gg1, run ggplot_build(gg1); then you have to examine the data object (which is a list of data for different layers) and try to figure out which layer you need (in this case, I looked for which data layer included a colour column that matched the smooth line ...
bb <- ggplot_build(gg1)
## extract the right component, just the x/y coordinates
out <- bb$data[[2]][,c("x","y")]
## check
plot(y~x, data = out)
You can do whatever you want with this output now (write.csv(), save(), saveRDS() ...)
I agree that there is something weird/that I don't understand about the way that ggplot2 is setting up the loess fit. You do have to do predict() with the right newdata (e.g. a data frame with a single column TS_LightOn that ranges from 0 to 400) - otherwise you get predictions of the points in your data set, which may not be properly spaced/in the right order - but that doesn't resolve the difference for me.
To complement #ben-bolker, I have just written a small function that may be useful for retrieving the internal dataset created by ggplot for a geom_smooth call. It takes the resultant ggplot as input and returns the smoothed data. The problem it solves is that, as Ben observed, internally ggplot creates a smoothed fit with predicted data on random intervals, different from the interval used for the input data. This function will get you back the ggplot fit data with an interval based on integer and equally spaced values. That function uses a loess fit on the already smoothed data, using a small value of span (0.1), that is adjusted upward on-the-fly to cope with small numbers of values.
This is useful if you used geom_smooth with a method that is not 'loess' or using 'NULL' and you cannot easily build a model that replicates what geom_smooth is doing internally.
The function separates different series on the same plot as well as series located on different facets. It also returns the 'ymin' and 'ymax' values.
Note that this function uses an interval based on integer values of x. You can modify this if you need an interval based on equally-spaced values of x, but not integral. In that case, pass your x interval of choice in the xInterval parameter, or tweak the line:
outOne <- data.frame(x=c(min(trunc(sub$x)):max(trunc(sub$x)))).
get_geom_smooth_dataFromPlot <- function (a_ggplot, xInterval=NULL) {
#internal ggplot values read in ggTable
ggTable <- ggplot_build(a_ggplot)$data[[1]]
#facet panels
panels <- as.numeric(names(table(ggTable$PANEL)))
nPanel <- length(panels)
onePanel <- (nPanel==1)
#number of series in each plot
groups <- as.numeric(names(table(ggTable$group)))
nGroup <- length(groups)
oneGroup <- (nGroup==1)
out <- data.frame()
#are there 'ymin' and 'ymax' values?
SE_data <- "ymin" %in% colnames(ggTable)
for (pan in (1:nPanel)) {
for (grp in (1:nGroup)) {
sub <- subset(ggTable, (PANEL==panels[pan])&(group==groups[grp]))
#no group series for this facet panel?
if (dim(sub)[1] == 0) next
if (is.null(xInterval)) {
outOne <- data.frame(x=c(min(trunc(sub$x)):max(trunc(sub$x))))
} else {
outOne <- data.frame(x=xInterval)
}
nObs <- dim(outOne)[1]
#hack to avoid problems with a small range for the x interval
# when there are more than 90 x values
# we use a span of 0.1, but
# we adjust on-the-fly up to a span of 0.5
# for 10 values of the x interval
cSpan <- max (0.1, 0.5 * 10 / (nObs-(nObs-10)/2))
if (!onePanel) outOne$panel <- pan
if (!oneGroup) outOne$group <- grp
mod <- loess(y~x, data=sub, span=cSpan)
outOne$y <- predict(mod, outOne$x, se=FALSE)
if (SE_data) {
mod <- loess(ymin~x, data=sub, span=cSpan)
outOne$ymin <- predict(mod, outOne$x, se=FALSE)
mod <- loess(ymax~x, data=sub, span=cSpan)
outOne$ymax <- predict(mod, outOne$x, se=FALSE)
}
out <- rbind(out, outOne)
}
}
return (out)
}

How to customize title, axis labels, etc. in a plot of a decomposed time series

I'm reasonably familiar with the usual ways of modifying a plot by writing your own x axis labels or a main title, but I've been unable to customize the output when plotting the results of a time series decomposition.
For example,
library(TTR)
t <- ts(co2, frequency=12, start=1, deltat=1/12)
td <- decompose(t)
plot(td)
plot(td, main="Title Doesn't Work") # gets you an error message
gives you a nice, basic plot of the observed time series, trend, etc. With my own data (changes in depth below the water surface), however, I'd like to be able to switch the orientation of the y axes (eg ylim=c(40,0) for 'observed', or ylim=c(18,12) for 'trend'), change 'seasonal' to 'tidal', include the units for the x axis ('Time (days)'), and provide a more descriptive title for the figure.
My impression is that the kind of time series analyses I'm doing is pretty basic and, eventually, I may be better off using another package, perhaps with better graphical control, but I'd like to use ts() and decompose() if I can for now (yeah, cake and consumption). Assuming this doesn't get too horrendous.
Is there a way to do this?
Thanks! Pete
You can modify the plot.decomposed.ts function (that's the plot "method" that gets dispatched when you run plot on an object of class decomposed.ts (which is the class of td).
getAnywhere(plot.decomposed.ts)
function (x, ...)
{
xx <- x$x
if (is.null(xx))
xx <- with(x, if (type == "additive")
random + trend + seasonal
else random * trend * seasonal)
plot(cbind(observed = xx, trend = x$trend, seasonal = x$seasonal, random = x$random),
main = paste("Decomposition of", x$type, "time series"), ...)
}
Notice in the code above that the function hard-codes the title. So let's modify it so that we can choose our own title:
my_plot.decomposed.ts = function(x, title="", ...) {
xx <- x$x
if (is.null(xx))
xx <- with(x, if (type == "additive")
random + trend + seasonal
else random * trend * seasonal)
plot(cbind(observed = xx, trend = x$trend, seasonal = x$seasonal, random = x$random),
main=title, ...)
}
my_plot.decomposed.ts(td, "My Title")
Here's a ggplot version of the plot. ggplot requires a data frame, so the first step is to get the decomposed time series into data frame form and then plot it.
library(tidyverse) # Includes the packages ggplot2 and tidyr, which we use below
# Get the time values for the time series
Time = attributes(co2)[[1]]
Time = seq(Time[1],Time[2], length.out=(Time[2]-Time[1])*Time[3])
# Convert td to data frame
dat = cbind(Time, with(td, data.frame(Observed=x, Trend=trend, Seasonal=seasonal, Random=random)))
ggplot(gather(dat, component, value, -Time), aes(Time, value)) +
facet_grid(component ~ ., scales="free_y") +
geom_line() +
theme_bw() +
labs(y=expression(CO[2]~(ppm)), x="Year") +
ggtitle(expression(Decomposed~CO[2]~Time~Series)) +
theme(plot.title=element_text(hjust=0.5))

add exponential function given mean and intercept to cdf plot

Considering the following random data:
set.seed(123456)
# generate random normal data
x <- rnorm(100, mean = 20, sd = 5)
weights <- 1:100
df1 <- data.frame(x, weights)
#
library(ggplot2)
ggplot(df1, aes(x)) + stat_ecdf()
We can create a general cumulative distribution plot.
But, I want to compare my curve to that from data used 20 years ago. From the paper, I only know that the data is "best modeled by a shifted exponential distribution with an x intercept of 1.1 and a mean of 18"
How can I add such a function to my plot?
+ stat_function(fun=dexp, geom = "line", size=2, col="red", args = (mean=18.1))
but I am not sure how to deal with the shift (x intercept)
I think scenarios like this are best handled by making your function first outside of the ggplot call.
dexp doesn't take a parameter mean but uses rate instead which is the same as lambda. That means you want rate = 1/18.1 based on properties of exponential distributions. Also, I don't think dexp makes much sense here since it shows the density and I think you really want the probability with is pexp.
your code could look something like this:
library(ggplot2)
test <- function(x) {pexp(x, rate = 1/18.1)}
ggplot(df1, aes(x)) + stat_ecdf() +
stat_function(fun=test, size=2, col="red")
you could shift your pexp distributions doing this:
test <- function(x) {pexp(x-10, rate = 1/18.1)}
ggplot(df1, aes(x)) + stat_ecdf() +
stat_function(fun=test, size=2, col="red") +
xlim(10,45)
just for fun this is what using dexp produces:
I am not entirely sure if I understand concept of mean for exponential function. However, generally, when you pass function as an argument, which is fun=dexp in your case, you can pass your own, modified functions in form of: fun = function(x) dexp(x)+1.1, for example.
Maybe experimenting with this feature will get you to the solution.

Plot a polynomial function like on the wolframalpha-website so that it is easy to understand

Plotting a function in the wolfram-alpha-website looks like this:
http://www.wolframalpha.com/link
Plotting the same function in R looks like this:
plot( function(x) x^2 - 3*x - 10 )
The default plot from Wolfram is much easier to understand. I think this is because it shows the x-axis (at y=0), and centers the parabola.
I am not good enough at math to just look at the formula of a function and see where I should center the plot, and I am plotting the functions to learn about how different functions create different lines, so I need this centering to be done automatically, because otherwise I might misunderstand a plot.
Is it possible to create the Wolfram-plot automatically i.e. without me telling R where it would be sensible to center the plot?
The polynom package will create some sensible defaults.
eg.
library(polynom)
# your polynomial (coefficients in ascending powers of x order)
p <- polynomial(c(-10,-3,1))
plot(p)
# a more complicated example, a polynomial crossing the x axis at -1,0,1,2,3,4,5
p2 <- poly.calc(-1:5)
p2
# -120*x + 154*x^2 + 49*x^3 - 140*x^4 + 70*x^5 - 14*x^6 + x^7
plot(p2)
You can set the desired interval to plot over, as described in ?plot.function. Also see curve and abline.
plot( function(x) x^2 - 3*x - 10 , -15, 15) ; abline(h=0,v=0,lty=3)
or
curve(x^2 - 3*x - 10 , -15, 15) ; abline(h=0,v=0,lty=3)
This is quite an old post post but I was trying to fit a polynomial curve based on the coefficients of my model.
The original in base R :
plot( y ~ x)
curve(3*x - 2*x^2 + 2*x^3) ## random coefficients for easy example
I use ggplot2 - so I wanted to use the curve generated from the coefficients rather than a + geom_smooth (This also works but I prefer the curve below)
bestfit <- geom_smooth(method = "loess", se = T, size = 1)
ggplot2
+ bestfit
Instead I created a function with the coefficients above
test
test <- function(x) {3*x - 2*x^2 + 2*x^3}
I have then added it as a layer in the ggplot
ggplot2
+ stat_function(fun = test)
It gives me the same curve as the base plot function but I can add all the additional layers in ggplot

Plot random effects from lmer (lme4 package) using qqmath or dotplot: How to make it look fancy?

The qqmath function makes great caterpillar plots of random effects using the output from the lmer package. That is, qqmath is great at plotting the intercepts from a hierarchical model with their errors around the point estimate. An example of the lmer and qqmath functions are below using the built-in data in the lme4 package called Dyestuff. The code will produce the hierarchical model and a nice plot using the ggmath function.
library("lme4")
data(package = "lme4")
# Dyestuff
# a balanced one-way classiï¬cation of Yield
# from samples produced from six Batches
summary(Dyestuff)
# Batch is an example of a random effect
# Fit 1-way random effects linear model
fit1 <- lmer(Yield ~ 1 + (1|Batch), Dyestuff)
summary(fit1)
coef(fit1) #intercept for each level in Batch
# qqplot of the random effects with their variances
qqmath(ranef(fit1, postVar = TRUE), strip = FALSE)$Batch
The last line of code produces a really nice plot of each intercept with the error around each estimate. But formatting the qqmath function seems to be very difficult, and I've been struggling to format the plot. I've come up with a few questions that I cannot answer, and that I think others could also benefit from if they are using the lmer/qqmath combination:
Is there a way to take the qqmath function above and add a few
options, such as, making certain points empty vs. filled-in, or
different colors for different points? For example, can you make the points for A,B, and C of the Batch variable filled, but then the rest of the points empty?
Is it possible to add axis labels for each point (maybe along the
top or right y axis, for example)?
My data has closer to 45 intercepts, so it is possible to add
spacing between the labels so they do not run into each other?
MAINLY, I am interested in distinguishing/labeling between points on the
graph, which seems to be cumbersome/impossible in the ggmath function.
So far, adding any additional option in the qqmath function produce errors where I would not get errors if it was a standard plot, so I'm at a loss.
Also, if you feel there is a better package/function for plotting intercepts from lmer output, I'd love to hear it! (for example, can you do points 1-3 using dotplot?)
EDIT: I'm also open to an alternative dotplot if it can be reasonably formatted. I just like the look of a ggmath plot, so I'm starting with a question about that.
One possibility is to use library ggplot2 to draw similar graph and then you can adjust appearance of your plot.
First, ranef object is saved as randoms. Then variances of intercepts are saved in object qq.
randoms<-ranef(fit1, postVar = TRUE)
qq <- attr(ranef(fit1, postVar = TRUE)[[1]], "postVar")
Object rand.interc contains just random intercepts with level names.
rand.interc<-randoms$Batch
All objects put in one data frame. For error intervals sd.interc is calculated as 2 times square root of variance.
df<-data.frame(Intercepts=randoms$Batch[,1],
sd.interc=2*sqrt(qq[,,1:length(qq)]),
lev.names=rownames(rand.interc))
If you need that intercepts are ordered in plot according to value then lev.names should be reordered. This line can be skipped if intercepts should be ordered by level names.
df$lev.names<-factor(df$lev.names,levels=df$lev.names[order(df$Intercepts)])
This code produces plot. Now points will differ by shape according to factor levels.
library(ggplot2)
p <- ggplot(df,aes(lev.names,Intercepts,shape=lev.names))
#Added horizontal line at y=0, error bars to points and points with size two
p <- p + geom_hline(yintercept=0) +geom_errorbar(aes(ymin=Intercepts-sd.interc, ymax=Intercepts+sd.interc), width=0,color="black") + geom_point(aes(size=2))
#Removed legends and with scale_shape_manual point shapes set to 1 and 16
p <- p + guides(size=FALSE,shape=FALSE) + scale_shape_manual(values=c(1,1,1,16,16,16))
#Changed appearance of plot (black and white theme) and x and y axis labels
p <- p + theme_bw() + xlab("Levels") + ylab("")
#Final adjustments of plot
p <- p + theme(axis.text.x=element_text(size=rel(1.2)),
axis.title.x=element_text(size=rel(1.3)),
axis.text.y=element_text(size=rel(1.2)),
panel.grid.minor=element_blank(),
panel.grid.major.x=element_blank())
#To put levels on y axis you just need to use coord_flip()
p <- p+ coord_flip()
print(p)
Didzis' answer is great! Just to wrap it up a little bit, I put it into its own function that behaves a lot like qqmath.ranef.mer() and dotplot.ranef.mer(). In addition to Didzis' answer, it also handles models with multiple correlated random effects (like qqmath() and dotplot() do). Comparison to qqmath():
require(lme4) ## for lmer(), sleepstudy
require(lattice) ## for dotplot()
fit <- lmer(Reaction ~ Days + (Days|Subject), sleepstudy)
ggCaterpillar(ranef(fit, condVar=TRUE)) ## using ggplot2
qqmath(ranef(fit, condVar=TRUE)) ## for comparison
Comparison to dotplot():
ggCaterpillar(ranef(fit, condVar=TRUE), QQ=FALSE)
dotplot(ranef(fit, condVar=TRUE))
Sometimes, it might be useful to have different scales for the random effects - something which dotplot() enforces. When I tried to relax this, I had to change the facetting (see this answer).
ggCaterpillar(ranef(fit, condVar=TRUE), QQ=FALSE, likeDotplot=FALSE)
## re = object of class ranef.mer
ggCaterpillar <- function(re, QQ=TRUE, likeDotplot=TRUE) {
require(ggplot2)
f <- function(x) {
pv <- attr(x, "postVar")
cols <- 1:(dim(pv)[1])
se <- unlist(lapply(cols, function(i) sqrt(pv[i, i, ])))
ord <- unlist(lapply(x, order)) + rep((0:(ncol(x) - 1)) * nrow(x), each=nrow(x))
pDf <- data.frame(y=unlist(x)[ord],
ci=1.96*se[ord],
nQQ=rep(qnorm(ppoints(nrow(x))), ncol(x)),
ID=factor(rep(rownames(x), ncol(x))[ord], levels=rownames(x)[ord]),
ind=gl(ncol(x), nrow(x), labels=names(x)))
if(QQ) { ## normal QQ-plot
p <- ggplot(pDf, aes(nQQ, y))
p <- p + facet_wrap(~ ind, scales="free")
p <- p + xlab("Standard normal quantiles") + ylab("Random effect quantiles")
} else { ## caterpillar dotplot
p <- ggplot(pDf, aes(ID, y)) + coord_flip()
if(likeDotplot) { ## imitate dotplot() -> same scales for random effects
p <- p + facet_wrap(~ ind)
} else { ## different scales for random effects
p <- p + facet_grid(ind ~ ., scales="free_y")
}
p <- p + xlab("Levels") + ylab("Random effects")
}
p <- p + theme(legend.position="none")
p <- p + geom_hline(yintercept=0)
p <- p + geom_errorbar(aes(ymin=y-ci, ymax=y+ci), width=0, colour="black")
p <- p + geom_point(aes(size=1.2), colour="blue")
return(p)
}
lapply(re, f)
}
Another way to do this is to extract simulated values from the distribution of each of the random effects and plot those. Using the merTools package, it is possible to easily get the simulations from a lmer or glmer object, and to plot them.
library(lme4); library(merTools) ## for lmer(), sleepstudy
fit <- lmer(Reaction ~ Days + (Days|Subject), sleepstudy)
randoms <- REsim(fit, n.sims = 500)
randoms is now an object with that looks like:
head(randoms)
groupFctr groupID term mean median sd
1 Subject 308 (Intercept) 3.083375 2.214805 14.79050
2 Subject 309 (Intercept) -39.382557 -38.607697 12.68987
3 Subject 310 (Intercept) -37.314979 -38.107747 12.53729
4 Subject 330 (Intercept) 22.234687 21.048882 11.51082
5 Subject 331 (Intercept) 21.418040 21.122913 13.17926
6 Subject 332 (Intercept) 11.371621 12.238580 12.65172
It provides the name of the grouping factor, the level of the factor we are obtaining an estimate for, the term in the model, and the mean, median, and standard deviation of the simulated values. We can use this to generate a caterpillar plot similar to those above:
plotREsim(randoms)
Which produces:
One nice feature is that the values that have a confidence interval that does not overlap zero are highlighted in black. You can modify the width of the interval by using the level parameter to plotREsim making wider or narrower confidence intervals based on your needs.
Yet another way to obtain the desired plot is through the plot_model()command integraded in the sjPlotpackage. The advantage is that the command returns a ggplot-object and hence there are many options to adjust the figure as wished. I kept the example simple because there are many options to individualize the visualisation - just check ?plot_modelfor all options.
library(lme4)
library(sjPlot)
#?plot_model
data(Dyestuff, package = "lme4")
summary(Dyestuff)
fit1 <- lmer(Yield ~ 1 + (1|Batch), Dyestuff)
summary(fit1)
plot_model(fit1, type="re",
vline.color="#A9A9A9", dot.size=1.5,
show.values=T, value.offset=.2)

Resources