Reputation: 55
I am trying to reproduce the image above. I am close but I cannot get the control values to have both a unique shape and color while staying with the case values. I assume that this was done with a clever use of a factor variable but I have no idea how they did it.
library(ggplot2)
box.print <- function(C1M,C1, D2, QCDC2, QCSDT4, num){
NAME <- names(D2[num])
adjsdt4 <- C1M[,num]
sdt4 <- C1[,num]
disco2 <- D2[,num]
qcdc <- QCDC2[,num]
qcsdt4 <- QCSDT4[,num]
adj <- data.frame(Intensity=c(adjsdt4,qcsdt4),
Study= rep("adjSDT4",length(adjsdt4)+length(qcsdt4)),
QC= c(rep("cases",length(adjsdt4)),rep("QC",length(qcsdt4)))
)
nadj <- data.frame(Intensity=c(sdt4,qcsdt4),
Study= rep("SDT4",length(sdt4)+length(qcsdt4)),
QC= c(rep("cases",length(sdt4)),rep("QC",length(qcsdt4)))
)
disco <- data.frame(Intensity=c(disco2,qcdc),
Study= rep("DISCO2",length(disco2)+length(qcdc)),
QC= c(rep("cases",length(disco2)),rep("QC",length(qcdc)))
)
full <- rbind(adj,nadj,disco)
g1 <- ggplot(full, aes(x=Study, y=Intensity))+geom_boxplot(outlier.shape = NA)+ggtitle(NAME)+
geom_jitter(alpha=0.5, aes(color=Study,label=Study,shape=QC),position = position_jitter(width = .8),size=2)
g1 = g1+theme(panel.grid.major= element_blank(),
panel.grid.minor= element_blank(),
panel.background= element_blank(),
panel.border= element_rect(colour="black",fill=NA),
legend.position="none")
g1= g1+scale_shape_manual(values=c(19,1))+scale_fill_discrete(guide=FALSE)
print(g1)
}
A <- data.frame(rnorm(100))
B <- data.frame(rnorm(100))
C <- A*2
QA <- data.frame(1.951, 1.734, 1.519, 1.397, 1.391, 1.825)
QA <- t(QA)
QC <- QA*1.5
box.print(A,B,C,QA,QC,1)
Upvotes: 1
Views: 750
Reputation: 550
I would add another variable for color in the dataframe. You have a two value variable for the shape aesthetic, and you need a four value variable for the color aesthetic. Taking your sample function, create a variable for color:
box.print <- function(C1M,C1, D2, QCDC2, QCSDT4, num){
NAME <- names(D2[num])
adjsdt4 <- C1M[,num]
sdt4 <- C1[,num]
disco2 <- D2[,num]
qcdc <- QCDC2[,num]
qcsdt4 <- QCSDT4[,num]
adj <- data.frame(Intensity=c(adjsdt4,qcsdt4),
Study= rep("adjSDT4",length(adjsdt4)+length(qcsdt4)),
QC= c(rep("cases",length(adjsdt4)),rep("QC",length(qcsdt4))))
nadj <- data.frame(Intensity=c(sdt4,qcsdt4),
Study= rep("SDT4",length(sdt4)+length(qcsdt4)),
QC= c(rep("cases",length(sdt4)),rep("QC",length(qcsdt4))))
disco <- data.frame(Intensity=c(disco2,qcdc),
Study= rep("DISCO2",length(disco2)+length(qcdc)),
QC= c(rep("cases",length(disco2)),rep("QC",length(qcdc))))
full <- rbind(adj,nadj,disco)
full$color <- NA
full$color[full$QC == "QC"] <- "QC"
full$color[full$QC == "cases"] <- full$Study[full$QC == "cases"]
g1 <- ggplot(full, aes(x=Study, y=Intensity))+
geom_boxplot(outlier.shape = NA)+
ggtitle(NAME)+
geom_jitter(alpha=0.5, aes(color=color,label=Study, shape=QC),position = position_jitter(width = .8),size=2)
g1 = g1+theme(panel.grid.major= element_blank(),
panel.grid.minor= element_blank(),
panel.background= element_blank(),
panel.border= element_rect(colour="black",fill=NA),
legend.position="none")
g1= g1+
scale_shape_manual(values=c(19,1))+
scale_fill_discrete(guide=FALSE) +
scale_color_manual(values = c("dodgerblue", "red", "darkgreen", "black"))
print(g1)
}
It should produce something like this: Link to img since I can't embed yet
Upvotes: 2