for 循环并更有效地生成绘图

Question

我总是手动和单独地制作图。 我在想是否有更有效的方法来生成情节？

以下是我用来生成图的代码。 我先写了两个函数，然后分别生成图（我会把整个代码放在下面）。 我是否可以使用 for-loop 来制作这些图？

非常感谢您提前回答。

library(ggpubr)

# plot function
perplot <- function (df, x, y, k,o){
  ggplot (df, aes(x=x, y=y))+ 
    geom_point()+
    theme_classic()+
    labs(x='perception', y='response')+
    ggtitle((paste('subject',k,',','lambda = ',o))) 
}

geplot <- function (df, x, y, k, o){
  ggplot (df, aes(x=x, y=y))+ 
    geom_point()+
    geom_smooth(se=FALSE)+
    theme_classic()+
    labs(x='stimulus', y='response')+
    ggtitle((paste('subject',k,',','lambda = ',o))) 
}

# plots from dataplot
s1p1 <- perplot (dataplot,dataplot$per_dis,dataplot$response_0.2,1,0.2) 
s1p2 <- perplot (dataplot,dataplot$per_dis,dataplot$response_0.5,1,0.5)
s1p3 <- perplot (dataplot,dataplot$per_dis,dataplot$response_0.9,1,0.9) 
s1p4 <- perplot (dataplot,dataplot$per_dis,dataplot$response_1.5,1,1.5)
s1p5 <- perplot (dataplot,dataplot$per_dis,dataplot$response_2,1,2)

s1p11 <- geplot (dataplot,dataplot$phy_dis,dataplot$response_0.2,1,0.2)
s1p21 <- geplot (dataplot,dataplot$phy_dis,dataplot$response_0.5,1,0.5)
s1p31 <- geplot (dataplot,dataplot$phy_dis,dataplot$response_0.9,1,0.9)
s1p41 <- geplot (dataplot,dataplot$phy_dis,dataplot$response_1.5,1,1.5)
s1p51 <- geplot (dataplot,dataplot$phy_dis,dataplot$response_2,1,2)

subject1 <- ggarrange(s1p1,s1p2,s1p3,s1p4,s1p5,s1p11,s1p21,s1p31,s1p41,s1p51,ncol = 5,nrow = 2)
annotate_figure(subject1,
                top = text_grob("Perception sd = 0.8", color = "red", face = "bold", size = 14))

# plots from dataplot2
s2p1 <- perplot (dataplot2,dataplot2$per_dis,dataplot2$response_0.2,2,0.2) 
s2p2 <- perplot (dataplot2,dataplot2$per_dis,dataplot2$response_0.5,2,0.5) 
s2p3 <- perplot (dataplot2,dataplot2$per_dis,dataplot2$response_0.9,2,0.9)
s2p4 <- perplot (dataplot2,dataplot2$per_dis,dataplot2$response_1.5,2,1.5)
s2p5 <- perplot (dataplot2,dataplot2$per_dis,dataplot2$response_2,2,2)

s2p11 <- geplot (dataplot2,dataplot2$phy_dis,dataplot2$response_0.2,2,0.2)
s2p21 <- geplot (dataplot2,dataplot2$phy_dis,dataplot2$response_0.5,2,0.5)
s2p31 <- geplot (dataplot2,dataplot2$phy_dis,dataplot2$response_0.9,2,0.9)
s2p41 <- geplot (dataplot2,dataplot2$phy_dis,dataplot2$response_1.5,2,1.5)
s2p51 <- geplot (dataplot2,dataplot2$phy_dis,dataplot2$response_2,2,2)

subject2 <- ggarrange(s2p1,s2p2,s2p3,s2p4,s2p5,s2p11,s2p21,s2p31,s2p41,s2p51,ncol=5,nrow=2)
annotate_figure(subject2,
                top = text_grob("Perception sd = 2", color = "red", face = "bold", size = 14))

整个复制代码

N <- 1
CS <- 10.141 
S <- seq (7.72,12.56,0.807) 
t <- 15 
l <- length (S)
m0 <- 100 
exps <- c(-0.2, -0.5, -0.9, -1.5, - 2)


set.seed(207)
per <- matrix(nrow = length(S)*N, ncol = t+1)
for (i in 1:dim(per)[1]) {
  for (j in 1:t+1){
  per [,1] <- replicate (n = N, seq (7.72,12.56,0.807))
  per [i,j] <- round (abs (rnorm (1, mean = mean(per[i,1]), sd = 0.8)),digits=3)
  }}
colnames(per) <- c('physical','t1','t2','t3','t4','t5','t6','t7','t8','t9','t10','t11','t12','t13','t14','t15')
rownames(per) <- c('S1','S2','S3','CS+','S5','S6')
per <- per [,-1]


per_d = matrix(nrow = length(S)*N, ncol = t)
for (i in 1:dim(per)[1]){
  for (j in 1:t){
    per_d [i,j] <- abs (per [i,j] - 10.141) 
  }
}
colnames(per_d) <- c('t1','t2','t3','t4','t5','t6','t7','t8','t9','t10','t11','t12','t13','t14','t15')



names(exps) <- paste("g1", seq_along(exps), sep = "")
res <- lapply(exps, function(x){
  g <- round (m0 * exp (x * per_d),digits = 3)
  colnames(g) <- paste('t', 1:ncol(g), sep = "")
  g <- as.data.frame(g)
  g
}
)  


set.seed(308)
per2 <- matrix(nrow = length(S)*N, ncol = t+1)
for (i in 1:dim(per)[1]) {
  for (j in 1:t+1){
    per2 [,1] <- replicate (n = N, seq (7.72,12.56,0.807))
    per2 [i,j] <- round (abs (rnorm (1, mean = mean(per2[i,1]), sd = 2)),digits=3)
  }}
colnames(per2) <- c('physical','t1','t2','t3','t4','t5','t6','t7','t8','t9','t10','t11','t12','t13','t14','t15')
rownames(per2) <- c('S1','S2','S3','CS+','S5','S6')
per2 <- per2 [,-1]

# calculate perceptual distance: perceptual value - CS+
per2_d = matrix(nrow = length(S)*N, ncol = t)
for (i in 1:dim(per2)[1]){
  for (j in 1:t){
    per2_d [i,j] <- abs (per2 [i,j] - 10.141) 
  }
}
colnames(per2_d) <- c('t1','t2','t3','t4','t5','t6','t7','t8','t9','t10','t11','t12','t13','t14','t15')


names(exps) <- paste("g2", seq_along(exps), sep = "")
res2 <- lapply(exps, function(x){
  g <- round (m0 * exp (x * per2_d),digits = 3)
  colnames(g) <- paste('t', 1:ncol(g), sep = "")
  g <- as.data.frame(g)
}
)  

sub1pd<-as.data.frame (per_d)
sub1p<-as.data.frame(per)
sub2pd<-as.data.frame (per2_d)
sub2p<-as.data.frame(per2)

dfmak <- function(df1,df2,df3,df4,df5,df6){
  data.frame(stimulus =  c (paste0('S',1:3),'CS+',paste0('S',5:6)),
             phy_dis = S,
             per_dis = c(df1$t1,df1$t2,df1$t3,df1$t4,df1$t5,df1$t6,df1$t7,df1$t8,df1$t9,df1$t10,df1$t11,df1$t12,df1$t13,df1$t14,df1$t15),
             trials = rep(1:15, each = 6),
             response_0.2 = c (df2$t1,df2$t2,df2$t3,df2$t4,df2$t5,df2$t6,df2$t7,df2$t8,df2$t9,df2$t10,df2$t11,df2$t12,df2$t13,df2$t14,df2$t15),
             response_0.5 = c (df3$t1,df3$t2,df3$t3,df3$t4,df3$t5,df3$t6,df3$t7,df3$t8,df3$t9,df3$t10,df3$t11,df3$t12,df3$t13,df3$t14,df3$t15),
             response_0.9 = c (df4$t1,df4$t2,df4$t3,df4$t4,df4$t5,df4$t6,df4$t7,df4$t8,df4$t9,df4$t10,df4$t11,df4$t12,df4$t13,df4$t14,df4$t15),
             response_1.5 = c (df5$t1,df5$t2,df5$t3,df5$t4,df5$t5,df5$t6,df5$t7,df5$t8,df5$t9,df5$t10,df5$t11,df5$t12,df5$t13,df5$t14,df5$t15),
             response_2 = c (df6$t1,df6$t2,df6$t3,df6$t4,df6$t5,df6$t6,df6$t7,df6$t8,df6$t9,df6$t10,df6$t11,df6$t12,df6$t13,df6$t14,df6$t15)
  )
}

dataplot <- dfmak (sub1pd,res$g11,res$g12,res$g13,res$g14,res$g15)
dataplot2 <- dfmak (sub2pd,res2$g21,res2$g22,res2$g23,res2$g24,res2$g25)

Answer 1

只是最后一个绘图位，效率略高。 使用拼凑而成的 package，因为我更喜欢它，而且它非常适用于绘图列表。

查看拼凑插图如何添加标题

library(patchwork)

response <- c(0.2, 0.5, 0.9, 1.5, 2)
per_dis <- lapply(response, function(i) perplot (dataplot2, dataplot2$per_dis, dataplot2[[paste("response", i, sep = "_")]], 2, i))
phy_dis <- lapply(response, function(i) perplot (dataplot2, dataplot2$phy_dis, dataplot2[[paste("response", i, sep = "_")]], 2, i))

library(patchwork)
wrap_plots(c(per_dis, phy_dis), nrow = 2)