У меня есть некоторые данные, показывающие ответ на лечение (категориальная переменная). Каждой копии также присваивается известное значение, основанное на величине лечения по отношению к индивидууму (непрерывная переменная). То, что я хотел бы сделать, это показать реакцию как на эффект лечения (гистограмма), так и на непрерывную переменную (график рассеяния / регрессия) на одном графике, используя ggplot2, аналогично тому, как facet_wrap или facet_grid команды могут быть использованы. В основном, я хотел бы воссоздать график ниже, используя ggplot2.
Вот код, который я использовал для генерации данных примера и создать сюжет
## GENERATE CONTINUOUS VARIABLES FOR EACH TREATMENT (A - D)
A <- abs(norm(10, 1, 1))
B <- abs(rnorm(10, 3, 1))
C <- abs(rnorm(10, 5, 1))
D <- abs(rnorm(10, 7, 1))
## GENERATE RESPONSE TO TREATMENTS
res_A<-rnorm(10, 28, 3)
res_B<-rnorm(10, 22, 3)
res_C<-rnorm(10, 18, 3)
res_D<-rnorm(10, 12, 3)
## ESTABLISH DATA FRAMES FOR TREATMENTS AND RESPONSE
treatments<-data.frame(A, B, C, D)
response<-data.frame(res_A, res_B, res_C, res_D)
## CONVERT EACH DATA FRAME TO LONG FORM
library(reshape2)
treatments <-treatments %>% gather(Treatment, cont_x, A:D)
response <-response %>% gather(Treatment, Response, res_A:res_D)
## CREATE FINAL DATA FRAME WITH REQUIRED DATA
data<-data.frame(treatments$Treatment, treatments$cont_x, response$Response)
colnames(data) <- c("Treatment", "X", "Response")
## ESTABLISH MEANS AND STANDARD ERROR FOR TREATMENT EFFECTS
means<-tapply(data$Response,list(data$Treatment),mean,na.rm=T)
ER<-tapply(data$Response,list(data$Treatment),sd,na.rm=T)/sqrt(tapply(data$Response,list(data$Treatment),length))
## SET AESTHETICS AND LABEL VALUES
cols<-c("darkcyan","olivedrab3", "palevioletred3","brown3")
labs<-c("A", "B", "C", "D")
## GENERATE PLOT CANVASS
par(mfrow=c(1,2))
par(mar=c(3.5,3,2,1))
## GENEATE BAR PLOT
graph<-tapply(data$Response,data$Treatment,mean,na.rm=T)
plot<-barplot(graph,col=cols,las=1,xaxt='n',yaxt='n',
xlab=NA,ylab =NA,font.lab=2,
cex=0.6,cex.lab=0.6,font.lab=2,font.axis=2,
cex.axis=0.6,ylim=c(0,40), main="TREATMENT EFFECTS")
box()
arrows(x0=plot,y0=means-ER,x1=plot,
y1=means+ER,code=3,angle=90,length=0.02,lwd=1)
axis(side=1,line=0,at=plot,labels=labs,
cex.axis=0.8,mgp=c(0,0.5,0),tck=-0.02,font.axis=1)
axis(side=2,line=0,at=seq(0,40,10),las=1,cex.axis=0.8,
labels=seq(0,40,10),cex=0.6,mgp=c(0,0.6,0))
xlab<-c("Treatment")
ylab<-c("Response")
mtext(xlab, side=1, cex=1.2, line=2)
mtext(ylab, side=2, cex=1.2, line=1.75)
mark<-(means+ER)+2
text(0.7,mark[1],"a",font=1,cex=1.2)
text(1.9,mark[2],"b",font=1,cex=1.2)
text(3.1,mark[3],"c",font=1,cex=1.2)
text(4.3,mark[4],"d",font=1,cex=1.2)
## GENERATE SCATTERPLOT
par(mar=c(3.5, 2, 2, 2))
plot(data$X, data$Response,type='n',ylim = c(0, 40), xlim=c(0,9),pch=21, col='black', cex=1.5, xaxt='n',
yaxt='n', xlab=NA, ylab=NA, main = "CONTINUOUS RESPONSE")
axis(side=1,line=0,tck=NA,at=seq(0,9,3),labels=T,
cex.axis=0.8,mgp=c(0,0.5,0),tck=-0.02,font.axis=1)
axis(side=2,line=0,at=seq(0,40,10),labels=F, tck=0.01)
axis(side=2,line=0,at=seq(0,40,10),labels=F, tck=-0.01)
xlab<-c("Continuous variable")
mtext(xlab, side=1, cex=1.2, line=2)
## PERFORM REGRESSION AND ADD IN REGRESSION LINE
model<-lm (Response ~ X, data = data)
abline(model, lwd=2)
## ADD IN CONFIDENCE INTERVAL
newx <- seq(0,9,length.out=1000)
preds <- predict(model, newdata = data.frame(X=newx),
interval = 'confidence')
lines(newx, preds[ ,3], lty = 'dashed', col = "grey36",lwd=1)
lines(newx, preds[ ,2], lty = 'dashed', col = 'grey36',lwd=1)
polygon(c(rev(newx), newx), c(rev(preds[ ,3]), preds[ ,2]), col = 'grey80', border = NA)
## ADD IN POINTS ONTOP OF CI POLYGON
points(data$X, data$Response, bg= ifelse(data$Treatment == "A", "darkcyan",
ifelse(data$Treatment == "B","olivedrab3", ifelse(data$Treatment == "C", "palevioletred3", "brown3"))),pch=21, col='black', cex=1.5)
## ADD THE REGRESSION EQ
eq<-expression(italic("y = 28.54 - 2.16x"))
rsq<-expression(italic("R"^{2}~"= 0.76 ***"))
text(5 ,35, eq, cex=1.2)
text(4.5, 33, rsq, cex=1.2
Возможно ли это сделать, используя ggplot2?