如何在R中創建如下所示的圖形？

Question

假設我有這樣的數據。

set.seed(23) 
n <- 5 
data <- data.frame(group1=rnorm(n, 100, 5), group2=rnorm(n, 100, 5),  
     group1.se=runif(n, 0.5, 3), group2.se=runif(n, 0.5, 3)) 
data 
##  group1 group2 group1.se group2.se 
## 1 100.96606 105.53745 1.9659945 2.5511267 
## 2 97.82659 98.60957 1.1868524 2.2123432 
## 3 104.56634 105.09603 0.8691424 2.7084732 
## 4 108.96694 100.22719 2.5035258 0.7798019 
## 5 104.98303 107.87890 1.4660246 2.4470850 

我想創建一個顯示每個時間跨越不同點兩個實驗組的平均體重的圖表，爲每個平均重量標準誤差酒吧。我想要顯示每個組的方法爲點連線的點，x軸的「天數」和y軸的「權重」。最終產品應該看起來像這樣。

Answer 1

你可以做這樣的事情。

# Simulate data 
set.seed(23) 
n <- 5 
group1 <- rnorm(n, 100, 5) 
group2 <- rnorm(n, 100, 5) 
group1.se <- runif(n, 0.5, 3) 
group2.se <- runif(n, 0.5, 3) 

# Make line plots 
x <- c(1:n) 
plot(group1 ~ x, ylim=c(90, 115), type="b", lwd=2, col="red", ylab="weights", xlab="days") 
lines(group2 ~ x, type="b", lwd=2, pch=2, col="blue") 

# Add standard error bars 
arrows(x0=x, y0=group1+0.5, y1=group1+group1.se, length=0.05, angle=90, col="lightpink") 
arrows(x0=x, y0=group1-0.5, y1=group1-group1.se, length=0.05, angle=90, col="lightpink") 
arrows(x0=x, y0=group2+0.5, y1=group2+group2.se, length=0.05, angle=90, col="lightblue") 
arrows(x0=x, y0=group2-0.5, y1=group2-group2.se, length=0.05, angle=90, col="lightblue") 

# Add legend 
legend("bottomright", legend=c("group1", "group2"), col=c("red", "blue"), lty=1) 

Answer 2

你可以做基礎R圖形任何東西，如果你知道這種API。

## define data 
x <- 0:14; 
dat <- list(
    Sentinel=list(
     mean=c(-0.95,-0.15,-0.40,-0.10,-1.30,-0.95,-1.10,-0.60,-1.10,-1.20, 0.30,-0.50,-2.60, 0.10,-0.95), 
     sd =c(0.55, 0.55, 1.40, 0.25, 0.60, 1.20, 0.40, 1.00, 0.80, 0.15, 0.25, 0.22, 0.52, 0.30, 1.50), 
     pch=22L, pt.cex=1.7, pt.lwd=2.5, pt.bg='white' 
    ), 
    Infected=list(
     mean=c(-1.35, 0.50,-0.26,-0.05,-0.40,-0.94, 0.55, 0.55,-0.48, 0.23,-1.30,-0.23,-1.05, 0.40, 0.20), 
     sd =c(0.70, 0.15, 0.70, 0.27, 0.87, 0.50, 0.80, 0.70, 0.50, 0.28, 0.40, 0.45, 1.02, 0.45, 0.35), 
     pch=21L, pt.cex=1.4, pt.lwd=2.5, pt.bg='#5555BB' 
    ) 
); 

## plot parameters 
xoff <- 1; 
xlim <- c(0-xoff,14+xoff); 
ylim <- c(-4,2); 
xticks <- seq(x[1L],x[length(x)],2); 
yticks <- -4:2; 
datline.lwd <- 2; 
err.spread <- 0.12; 
err.lwd <- 2.2; 
err.col <- '#777777'; 

## helper function 
errorbar <- function(x,mean,sd) { 
    segments(x,mean-sd,y1=mean+sd,lwd=err.lwd,col=err.col); 
    segments(x-err.spread,mean-sd,x1=x+err.spread,lwd=err.lwd,col=err.col); 
    segments(x-err.spread,mean+sd,x1=x+err.spread,lwd=err.lwd,col=err.col); 
}; ## end errorbar() 

## plot 
plot(NA,xlim=xlim,ylim=ylim,xaxs='i',yaxs='i',axes=F,ann=F); 
for (prop in names(dat)) { 
    d <- dat[[prop]]; 
    lines(x,d$mean,lwd=datline.lwd); 
    errorbar(x,d$mean,d$sd); 
    points(x,d$mean,pch=d$pch,cex=d$pt.cex,lwd=d$pt.lwd,bg=d$pt.bg); 
}; ## end for 
axis(1L,xticks,cex.axis=1.3,lwd=3,col='#777777'); 
mtext('Days post Infection-Aerosol Group',1L,2.3,cex=1.47); 
axis(2L,yticks,cex.axis=1.3,lwd=3,col='#777777',las=1L); 
mtext('Change in Temperature (Fahrenheit)',2L,2.3,cex=1.47); 
rect(xlim[1L],ylim[1L],xlim[2L],ylim[2L],lwd=4,border='#777777',xpd=NA); 
lp <- c('pch','pt.cex','pt.lwd','pt.bg'); 
do.call(legend,c(list(11.7,1.7,names(dat),bty='n',adj=0.1,lwd=datline.lwd),setNames(nm=lp,lapply(lp,function(p) sapply(dat,`[[`,p))))); 

---

你的新的隨機測試數據涵蓋範圍不同，所以我們要調整一些東西，使繪圖代碼工作。

## OP's new randomized input 
set.seed(23L); 
N <- 5L; 
data <- data.frame(group1=rnorm(N,100,5),group2=rnorm(N,100,5),group1.se=runif(N,0.5,3),group2.se=runif(N,0.5,3)); 

## transfer to dat 
x <- seq_len(nrow(data))-1L; 
dat <- list(
    group1=list(
     mean=data$group1, 
     sd =data$group1.se, 
     pch=22L, pt.cex=1.7, pt.lwd=2.5, pt.bg='white' 
    ), 
    group2=list(
     mean=data$group2, 
     sd =data$group2.se, 
     pch=21L, pt.cex=1.4, pt.lwd=2.5, pt.bg='#5555BB' 
    ) 
); 

## plot parameters 
xoff <- 1; 
xlim <- c(x[1L]-xoff,x[length(x)]+xoff); 
ylim <- c(95,113); 
xticks <- seq(x[1L],x[length(x)]); 
yticks <- seq(ylim[1L],ylim[2L]); 
datline.lwd <- 2; 
err.spread <- 0.12; 
err.lwd <- 2.2; 
err.col <- '#777777'; 

## helper function 
errorbar <- function(x,mean,sd) { 
    segments(x,mean-sd,y1=mean+sd,lwd=err.lwd,col=err.col); 
    segments(x-err.spread,mean-sd,x1=x+err.spread,lwd=err.lwd,col=err.col); 
    segments(x-err.spread,mean+sd,x1=x+err.spread,lwd=err.lwd,col=err.col); 
}; ## end errorbar() 

## plot 
plot(NA,xlim=xlim,ylim=ylim,xaxs='i',yaxs='i',axes=F,ann=F); 
for (prop in names(dat)) { 
    d <- dat[[prop]]; 
    lines(x,d$mean,lwd=datline.lwd); 
    errorbar(x,d$mean,d$sd); 
    points(x,d$mean,pch=d$pch,cex=d$pt.cex,lwd=d$pt.lwd,bg=d$pt.bg); 
}; ## end for 
axis(1L,xticks,cex.axis=1.3,lwd=3,col='#777777'); 
mtext('Days',1L,2.3,cex=1.47); 
axis(2L,yticks,cex.axis=1.3,lwd=3,col='#777777',las=1L); 
mtext('Weight',2L,2.7,cex=1.47); 
rect(xlim[1L],ylim[1L],xlim[2L],ylim[2L],lwd=4,border='#777777',xpd=NA); 
lp <- c('pch','pt.cex','pt.lwd','pt.bg'); 
do.call(legend,c(list(3.7,99,names(dat),bty='n',adj=0.1,lwd=datline.lwd),setNames(nm=lp,lapply(lp,function(p) sapply(dat,`[[`,p))))); 

Answer 3

這裏是一個ggplot2溶液。爲了提供一個可重複的例子，我使用數據集BodyWeight{nlme}，以及不同飲食的大鼠體重隨時間變化的數據。

library(data.table) 
library(ggplot2) 
library(ggthemes) 
library(nlme) 


data(BodyWeight) # get the data 
setDT(BodyWeight) # convert into data.table 


# summarize your data into the information you want, getting stats by each time and Diet group 
    df <- BodyWeight[, .(mean= mean(weight), 
         SE_upper = mean(weight) + sd(weight)/sqrt(length(weight)), 
         SE_lower = mean(weight) - sd(weight)/sqrt(length(weight))), 
        by=.(Time,Diet)] 


# Plot 
    ggplot(data=df, aes(x=Time, y=mean, group= Diet)) + 
    geom_errorbar(aes(ymin=SE_lower, ymax=SE_upper), color="gray40") + 
    geom_line(color="gray10") + 
    geom_point(aes(shape=Diet, color=Diet), size=3) + 
    theme_bw() + 
    theme(panel.grid = element_blank()) + 
    labs(x = "Days of Diet", y = "Weight") 

如果你想調整的情節，ggplot2是用大量的例子在那裏非常靈活，well documented。