使用 lapply 或其他技术合并重复的 r 代码

Question

使用这些数据...

> dput(wi.fvs.hog.matrix)
structure(list(Year = c("2008", "2009", "2010", "2011", "2012", 
"2013", "2014", "2015", "2016", "2017", "2018"), Age0 = c(1.85714285714286, 
0.4, 0.485714285714286, 1.1, 2.42857142857143, 0.257142857142857, 
0.0428571428571429, 0.314285714285714, 0.716666666666667, 0.833333333333333, 
2.51666666666667), Age1 = c(1.41463963164237, 1.02555123757, 
0.848368924551809, 1.0129081429117, 1.34174221299874, 1.73844699293102, 
1.13150227778049, 1.04021644273328, 1.58517508190915, 0.816172211616916, 
NA), Age2 = c(0.697482814458681, 0.884021354731086, 0.572217414946522, 
0.747321961250137, 0.414954234638407, 1.15324140821528, 0.795970290332159, 
0.937855311313068, 0.964409048099429, NA, NA), Age3 = c(0.387697040724315, 
0.469038457221031, 0.361764248224063, 1.04480498090706, 0.488540659420917, 
0.352297506342294, 0.870303410790715, 0.375040960193853, NA, 
NA, NA), Age4 = c(0.615800626709934, 0.483981693363844, 0.421893433414089, 
1.09969988854403, 0.589655172413793, 0.548020964506191, 0.346473672965025, 
NA, NA, NA, NA), Age5 = c(0.453089244851259, 0.56020477727594, 
2.04363876414779, 1.63160785116988, 0.378917378917379, 0.698236836482513, 
NA, NA, NA, NA, NA), Age6 = c(0.238805970149254, 0.537267080745342, 
0.920689655172414, 0.369420702754036, 0.382474226804124, NA, 
NA, NA, NA, NA, NA), Age7 = c(0.779503105590062, 0.303448275862069, 
0.369420702754036, 0.230927835051546, NA, NA, NA, NA, NA, NA, 
NA), Age8 = c(0.43448275862069, 0.138651471984805, 0.0309278350515464, 
NA, NA, NA, NA, NA, NA, NA, NA), Age9 = c(0.0123456790123457, 
0.0412371134020619, NA, NA, NA, NA, NA, NA, NA, NA, NA)), row.names = c(NA, 
-11L), class = c("tbl_df", "tbl", "data.frame"))

我创建了这段代码来制作相关图...

fvs.prop.curve1 <- ggplot(wi.fvs.hog.matrix, aes(x = Age0, y = Age1)) + 
  geom_point(aes()) +
  ylim(0,2.2) +
  stat_smooth(method = "lm", se = FALSE, color="red") +
  labs(y = "Age 1", x = "YOY") +
  theme_bw() + theme(panel.border = element_blank(), panel.grid.major = element_blank(),
                     panel.grid.minor = element_blank(), axis.line = element_line(colour = "black"))

fvs.prop.curve2 <- ggplot(wi.fvs.hog.matrix, aes(x = Age0, y = Age2)) + 
  geom_point(aes()) +
  ylim(0,2.2) +
  stat_smooth(method = "lm", se = FALSE, color="red") +
  labs(y = "Age 2", x = "YOY") +
  theme_bw() + theme(panel.border = element_blank(), panel.grid.major = element_blank(),
                     panel.grid.minor = element_blank(), axis.line = element_line(colour = "black"))

fvs.prop.curve3 <- ggplot(wi.fvs.hog.matrix, aes(x = Age0, y = Age3)) + 
  geom_point(aes()) +
  ylim(0,2.2) +
  stat_smooth(method = "lm", se = FALSE, color="red") +
  labs(y = "Age 3", x = "YOY") +
  theme_bw() + theme(panel.border = element_blank(), panel.grid.major = element_blank(),
                     panel.grid.minor = element_blank(), axis.line = element_line(colour = "black"))

fvs.prop.curve4 <- ggplot(wi.fvs.hog.matrix, aes(x = Age0, y = Age4)) + 
  geom_point(aes()) +
  ylim(0,2.2) +
  stat_smooth(method = "lm", se = FALSE, color="red") +
  labs(y = "Age 4", x = "YOY") +
  theme_bw() + theme(panel.border = element_blank(), panel.grid.major = element_blank(),
                     panel.grid.minor = element_blank(), axis.line = element_line(colour = "black"))

fvs.prop.curve5 <- ggplot(wi.fvs.hog.matrix, aes(x = Age0, y = Age5)) + 
  geom_point(aes()) +
  ylim(0,2.2) +
  stat_smooth(method = "lm", se = FALSE, color="red") +
  labs(y = "Age 5", x = "YOY") +
  theme_bw() + theme(panel.border = element_blank(), panel.grid.major = element_blank(),
                     panel.grid.minor = element_blank(), axis.line = element_line(colour = "black"))

fvs.prop.curve6 <- ggplot(wi.fvs.hog.matrix, aes(x = Age0, y = Age6)) + 
  geom_point(aes()) +
  ylim(0,2.2) +
  stat_smooth(method = "lm", se = FALSE, color="red") +
  labs(y = "Age 6", x = "YOY") +
  theme_bw() + theme(panel.border = element_blank(), panel.grid.major = element_blank(),
                     panel.grid.minor = element_blank(), axis.line = element_line(colour = "black"))

fvs.prop.curve7 <- ggplot(wi.fvs.hog.matrix, aes(x = Age0, y = Age7)) + 
  geom_point(aes()) +
  ylim(0,2.2) +
  stat_smooth(method = "lm", se = FALSE, color="red") +
  labs(y = "Age 6", x = "YOY") +
  theme_bw() + theme(panel.border = element_blank(), panel.grid.major = element_blank(),
                     panel.grid.minor = element_blank(), axis.line = element_line(colour = "black"))


#create multiple panel plot
fvs.prop.gg <- ggarrange(fvs.prop.curve1, fvs.prop.curve2, fvs.prop.curve3, 
                       fvs.prop.curve4, fvs.prop.curve5, fvs.prop.curve6,  ncol = 3, nrow = 2)

#annotate multiple panel plot
annotate_figure(fvs.prop.gg,
                top = text_grob("Correlation plots \n FDM Proportional \n", color = "Black", face = "bold", size = 14),
                bottom = text_grob("Data source: \n FDM", color = "blue",
                                   hjust = 1, x = 1, face = "italic", size = 10),
                left = text_grob("", color = "green", rot = 90),
                right = "",
                fig.lab = "Figure 1", fig.lab.face = "bold")

哪些输出：

现在必须有一种更简单、更简洁的方法来使用其中一个应用函数来做到这一点

我试图修改代码，我曾经用交叉相关图 ccf() 做类似的事情，但不知道如何设置它。问题之一是下面代码的数据是长格式的，然后使用split() 进行拆分。也许有人知道更简单的方法？

lapply(seq_along(wi.fvs.hog.matrix), function(x) ccf(wi.fvs.hog.matrix[[x]]$Year,wi.fvs.hog.matrix[[x]]$Age, lag.max = 5,
                                            ylab = "", main= names(wi.fvs.hog.matrix)[x]))

Answer 1

您是否考虑过使用构面？分面将避免重复代码以及避免lapply。

它需要数据是长格式的。

library(tidyverse)

wi.fvs.hog.matrix %>%
  pivot_longer(cols = Age1:Age9) %>%
  ggplot(aes(x = Age0, y = value)) + 
  geom_point() +
  ylim(0,2.2) +
  stat_smooth(method = "lm", se = FALSE, color="red") +
  facet_wrap(~name) + 
  labs(y = "Age 1", x = "YOY") +
  theme_bw() + 
  theme(panel.border = element_blank(), 
        panel.grid.major = element_blank(),
        panel.grid.minor = element_blank(), 
        axis.line = element_line(colour = "black"))

从 OP 运行代码我得到 fvs.prop.gg 为：

`