I would like to combine continuous and quantile models in the same plot to compare and contrast the two approaches (xtile is a function that returns the quantile as factor):
q.s <- cph(inc ~ rcs(exposure,3), data=data)
q.q <- cph(inc ~ xtile(exposure,3), data=data)
p.s <- Predict(q.s, exposure, fun=exp)
p.q <- Predict(q.q, exposure, fun=exp)
ggplot.Predict gives a nice plot of either model - but I would like to combine both. Is this possible?
I have added an example - which I hope might illustrate what I would like to generate.
enter image description here
Try this where plot1/2 are your quantile and continuous plots (can change heights, widths, number of columns, number of rows):
p1 <- ggplot.Predict(..plot1 options here...)
p2 <- ggplot.Predict(..plot2 options here...)
library(gridExtra)
grid.arrange(p1, p2,
ncol=2, nrow=1, widths=c(2,2), heights=c(2))
For more information, check out the gridExtra package.
Related
I build a model with the lmer-fuction (m1). Now I want to plot the predicting values. I used this code:
p1 <- ggpredict(m1, "variable1")
p2 <- ggpredict(m1, "variable2")
p3 <- ggpredict(m1, "variable3")
With plot(p1) I would get the single plot as output. But I want that all three plots are visualized in one. Is there a way to overlay/combine them?
We can use patchwork to arrange multiple plots
library(patchwork)
p1|p2|p3
I'm fitting a dose-response curve to many data sets that I want to plot to a single file.
Here's how one data set looks like:
df <- data.frame(dose=c(10,0.625,2.5,0.156,0.0391,0.00244,0.00977,0.00061,10,0.625,2.5,0.156,0.0391,0.00244,0.00977,0.00061,10,0.625,2.5,0.156,0.0391,0.00244,0.00977,0.00061),viability=c(6.12,105,57.9,81.9,86.5,98.3,96.4,81.8,27.3,85.2,80.8,92,82.5,110,90.2,76.6,11.9,89,35.4,79,95.8,117,82.1,95.1),stringsAsFactors=F)
Here's the dose-response fit:
library(drc)
fit <- drm(viability~dose,data=df,fct=LL.4(names=c("Slope","Lower Limit","Upper Limit","ED50")))
Now I'm predicting values in order to plot the curve:
pred.df <- expand.grid(dose=exp(seq(log(max(df$dose)),log(min(df$dose)),length=100)))
pred <- predict(fit,newdata=pred.df,interval="confidence")
pred.df$viability <- pred[,1]
pred.df$viability.low <- pred[,2]
pred.df$viability.high <- pred[,3]
And this is how a single plot looks like:
library(ggplot2)
p <- ggplot(df,aes(x=dose,y=viability))+geom_point()+geom_ribbon(data=pred.df,aes(x=dose,y=viability,ymin=viability.low,ymax=viability.high),alpha=0.2)+labs(y="viability")+
geom_line(data=pred.df,aes(x=dose,y=viability))+coord_trans(x="log")+theme_bw()+scale_x_continuous(name="dose",breaks=sort(unique(df$dose)),labels=format(signif(sort(unique(df$dose)),3),scientific=T))+ggtitle(label="all doses")
adding a few parameter estimates to the plot:
params <- signif(summary(fit)$coefficient[-1,1],3)
names(params) <- c("lower","upper","ed50")
p <- p + annotate("text",size=3,hjust=0,x=2.4e-3,y=5,label=paste(sapply(1:length(params),function(p) paste0(names(params)[p],"=",params[p])),collapse="\n"),colour="black")
Which gives:
Now suppose I have 20 of these that I want to cram in a single figure file.
I thought that a reasonable solution would be to use grid.arrange:
As an example I'll loop 20 times on this example data set:
plot.list <- vector(mode="list",20)
for(i in 1:20){
plot.list[[i]] <- ggplot(df,aes(x=dose,y=viability))+geom_point()+geom_ribbon(data=pred.df,aes(x=dose,y=viability,ymin=viability.low,ymax=viability.high),alpha=0.2)+labs(y="viability")+
geom_line(data=pred.df,aes(x=dose,y=viability))+coord_trans(x="log")+theme_bw()+scale_x_continuous(name="dose",breaks=sort(unique(df$dose)),labels=format(signif(sort(unique(df$dose)),3),scientific=T))+ggtitle(label="all doses")+
annotate("text",size=3,hjust=0,x=2.4e-3,y=5,label=paste(sapply(1:length(params),function(p) paste0(names(params)[p],"=",params[p])),collapse="\n"),colour="black")
}
And then plot using:
library(grid)
library(gridExtra)
grid.arrange(grobs=plot.list,ncol=3,nrow=ceiling(length(plot.list)/3))
Which is obviously poorly scaled. So my question is how to create this figure with better scaling - meaning that all objects are compressed proportionally in way that produces a figure that is still visually interperable.
You should set the device size so that the plots remain readable, e.g.
pl = replicate(11, qplot(1,1), simplify = FALSE)
g = arrangeGrob(grobs = pl, ncol=3)
ggsave("plots.pdf", g, width=15, height=20)
I have a dataset of leaf trait measurements made at multiple sites at two contrasting seasons. I am interested to explore the association/line fit between a pair of traits and to differentiate the seasons at each site.
Rather than a linear regression, I would prefer to use the Standardised Major Axis approach within the smatr package:
e.g. sma.site1 <- sma(TraitA ~ TraitB * Visit, data=subset(myfile, Site=="Site1")) # testing the null hypothesis of common slopes for the two Visits (Seasons) at a given Site.
I can produce a handy lattice plot in ggplot2 with a separate panel for each Site and the points differentiated by Visit:
e.g. qplot(TraitB, TraitA, data=myfile, colour=Visit) + facet_wrap(~Site, ncol=2)
However, if I add trend lines fitted with the additional argument in ggplot2:
+ geom_smooth(aes(group=Visit), method="lm", se=F)
……, those lines are not a good match for the sma coefficients.
What I would like to do is fit the lines suggested by the sma test onto the ggplot lattice. Is there an easy, or efficient, way to do that?
I know that I can subset the data, produce a plot for each site, add the relevant lines with + geom_abline() and then stitch the separate plots up together with grid.arrange(). But that feels very long-winded.
I would be grateful for any pointers.
I don't know anything about the smatr package but you should be able to tweak this to get the right values. Since you provided no data I used the leaf data from the example in the pkg. The basic idea is to pull out the slope & intercept from the returned sma object and then facet the geom_abline. I may be misinterpreting the object, though.
library(smatr)
library(ggplot2)
data(leaflife)
do.call(rbind, lapply(unique(leaflife$site), function(x) {
obj <- sma(longev~lma*rain, data=subset(leaflife, site=x))
data.frame(site=x,
intercept=obj$coef[[1]][1, 1],
slope=obj$coef[[1]][2, 1])
})) -> fits
gg <- ggplot(leaflife)
gg <- gg + geom_point(aes(x=lma, y=longev, color=soilp))
gg <- gg + geom_abline(data=fits, aes(slope=slope, intercept=intercept))
gg <- gg + facet_wrap(~site, ncol=2)
gg
I just saw this question and am not sure if you are still interested in this. I run the code by hrbrmstr, and found actually the only thing you need to change is:
obj <- sma(longev~lma*rain, data=subset(leaflife, site == x))
then you can get the plot with four lines for each group.
and also
Apologies for that. Here's my question with a reproducible data set:
library(effects)
data(Arrests)
Arrests$year <- as.factor(Arrests$year)
arrests.mod <- glm(released ~ employed + citizen + checks + colour*year +
colour*age, family=binomial, data=Arrests)
t.effects <- allEffects(arrests.mod)
plot(t.effects, "colour:year")
plot(t.effects, "colour:age")
Is it possible to combine the two plots into a single figure?
par(mfrow=c(2,1))
This doesn't work. I.e. the figures are reproduced separately in two graphs, but not in the same figure.
par(mfrow=c(2,1)) don't work for grid plots. It is only for base graphics. You can use gridExtra to arrange lattice plots.
library(gridExtra)
p1 <- plot(t.effects, "colour:year")
p2 <- plot(t.effects, "colour:age")
grid.arrange(latticeGrob(p1),
latticeGrob(p2))
You can reference specific effects from your alleffects object with vector indices. In your case I believe t.effects[4:5] or, equivalently, t.effects[c("colour:year", "colour:age")]
library(effects)
data(Arrests)
Arrests$year <- as.factor(Arrests$year)
arrests.mod <- glm(released ~ employed + citizen + checks + colour*year + colour*age, family=binomial, data=Arrests)
t.effects <- allEffects(arrests.mod)
plot(t.effects[4:5])
I have a list of linear and non-linear models derived from different data sets measuring the same two variables x and y that I would like to plot on the same plot using stat_smooth. This is to be able to easily compare the shape of the relationship between x and y across datasets.
I'm trying to figure out the most effective way to do this. Right now I am considering creating an empty ggplot object and then using some kind of loop or lapply to add sequentially to that object, but this is proving more difficult than I thought. Of course it would be easiest to simply supply the models to ggplot but as far as I know, this is not possible. Any thoughts?
Here is a simple example data set to play with using just two models, one linear and one exponential:
df1=data.frame(x=rnorm(10),y=rnorm(10))
df2=data.frame(x=rnorm(15),y=rnorm(15))
df.list=list(lm(y~x,df1),nls(y~exp(a+b*x),start=list(a=1,b=1),df2))
And two separate example plots:
ggplot(df1,aes(x,y))+stat_smooth(method=lm,se=F)
ggplot(df2,aes(x,y))+stat_smooth(method=nls,formula=y~exp(a+b*x),start=list(a=1,b=1),se=F)
EDIT: Note that the OP changed the question after this answer was posted
Combine the data into a single data frame, with a new column indicating the model, then use ggplot to distinguish between the models:
df1=data.frame(x=rnorm(10),y=rnorm(10))
df2=data.frame(x=rnorm(10),y=rnorm(10))
df1$model <- "A"
df2$model <- "B"
dfc <- rbind(df1, df2)
library(ggplot2)
ggplot(dfc, aes(x, y, group=model)) + geom_point() + stat_smooth(aes(col=model))
This produces:
I think the answer here is to get a common range of X and Y you want to run this over, and go from there. You can pull out a curve from each model using predict, and add on layers to a ggplot using l_ply.
d
f1=data.frame(x=rnorm(10),y=rnorm(10))
df2=data.frame(x=rnorm(15),y=rnorm(15))
df.list=list(lm(y~x,df1),nls(y~exp(a+b*x),start=list(a=1,b=1),df2))
a<-ggplot()
#get the range of x you want to look at
x<-seq(min(c(df1$x, df2$x)), max(c(df1$x, df2$x)), .01)
#use l_ply to keep adding layers
l_ply(df.list, function(amod){
#a data frame for predictors and response
ndf <- data.frame(x=x)
#get the response using predict - you can even get a CI here
ndf$y <- predict(amod, ndf)
#now add this new layer to the plot
a<<- a+geom_line(ndf, mapping=(aes(x=x, y=y)))
} )
a
OR, if you want to have a nice color key with model number or something:
names(df.list) <- 1:length(df.list)
modFits <- ldply(df.list, function(amod){
ndf <- data.frame(x=x)
#get the response using predict - you can even get a CI here
ndf$y <- predict(amod, ndf)
ndf
})
qplot(x, y, geom="line", colour=.id, data=modFits)