如何从函数内部生成条件图

Question

我的数据结构如下：

set.seed(123)
dat1 <- data.frame(State = rep(c("NY","MA","FL","GA"), each = 10),
                   Loc = rep(c("a","b","c","d","e","f","g","h"),each = 5),
                   ID = rep(c(1:10), each = 2),
                   var1 = rnorm(200),
                   var2 = rnorm(200),
                   var3 = rnorm(200),
                   var4 = rnorm(200),
                   var5 = rnorm(200))

我正在为PCA使用FactoMineR和factoextra软件包。我正在编写以下函数来生成PCA的摘要输出和图：

pfun <- function(dat, cols, ncp){
  res <- PCA(dat[,cols], scale.unit = T, ncp = ncp, graph = F)
  eigs<-round(res$eig, 2)
  scree <- fviz_eig(res, addlabels = T)
  contribplot<-corrplot(get_pca_var(res)$contrib, is.corr = F)#variable contributions to each pc
  cos2plot<-corrplot(pca.vars$cos2, is.corr=F)#quality of var representation in each pc
  output<- list(eigs, scree, contribplot, cos2plot)
  return(output)
}
pfun(dat = cdatsq, cols = 7:13, ncp = 7)

该函数到目前为止运行良好，但是我也希望它为每个数字/主成分组合生成双线图和变量贡献图，该函数确定特征值小于或等于1。例如，我尝试了在函数中使用num <- sum(eigs[,1]>=1, na.rm = TRUE)#for the number of pcs to keep and plot和for循环：

for(i in 1:sum(eigs[,1]>=1, na.rm = TRUE)){
  fviz_contrib(res, choice = "var", axes = i, top = 10)
}

这不起作用，如何在其余输出中进行打印？另外，我想使用fviz_pca_biplot()为sum(eigs[,1]>=1, na.rm = TRUE)范围内的每个主成分组合生成双线图。在函数之外，一个绘图调用将如下所示：

#example shown for PC2:PC3 with points labeled by `Loc` 
fviz_pca_biplot(res, axes = c(2,3), geom.ind = "point", pointsize=0, repel = T)+ 
  ggtitle("plot for PC2:PC3")+
  geom_text(aes(label = paste0(dat1$Loc)), alpha = 0.5, size = 3, nudge_y = 0.1, show.legend = FALSE)

但是在函数中，如何在sum(eigs[,1]>=1, na.rm = TRUE)的边界内指定主成分的“所有组合”（即，将有PC1，PC2，PC2，PC3等的图）？理想情况下，我想针对每个分组变量将biplot分为单独的网格（例如，双图点用State着色的页面和用Loc着色的biplot点的页面）。

Answer 1

您需要print循环中的输出才能将其导出。要获得所选PC的所有组合，可以使用for：

编辑：

要获取网格，可以使用combn中的plot_grid：

cowplot

<< [ “ https://image.soinside.com/eyJ1cmwiOiAiaHR0cHM6Ly9pLmltZ3VyLmNvbS9SUkVPMGpCLnBuZyJ9” alt =“”> T

library(factoextra)
library(FactoMineR)
library(corrplot)
library(cowplot)

set.seed(123)
dat1 <- data.frame(State = rep(c("NY","MA","FL","GA"), each = 10),
                   Loc = rep(c("a","b","c","d","e","f","g","h"),each = 5),
                   ID = rep(c(1:10), each = 2),
                   var1 = rnorm(200),
                   var2 = rnorm(200),
                   var3 = rnorm(200),
                   var4 = rnorm(200),
                   var5 = rnorm(200))



pfun <- function(dat, cols, ncp){
    res <- PCA(dat[,cols], scale.unit = T, ncp = ncp, graph = F)
    eigs <- round(res$eig, 2)
    scree <- fviz_eig(res, addlabels = T)
    pca.vars <- get_pca_var(res)
    contribplot <- corrplot(pca.vars$contrib, is.corr = F)#variable contributions to each pc
    cos2plot <- corrplot(pca.vars$cos2, is.corr=F)#quality of var representation in each pc
    keep.eigs <- sum(eigs[,1]>=1, na.rm = TRUE)
    contribs <- lapply(seq_len(keep.eigs), function(i) fviz_contrib(res, choice = "var", axes = i, top = 10))
    cowplot::plot_grid(plotlist=contribs, ncol=3)
    eig.comb <- combn(keep.eigs, 2, simplify = FALSE)
    biplots <- lapply(eig.comb, function(x){
        fviz_pca_biplot(res, axes = x, geom.ind = "point", pointsize=0, repel = T)+ 
            ggtitle(paste0("plot for PC", x[1], ":PC", x[2]))+
            geom_text(aes(label = paste0(dat$Loc), colour=dat$Loc), 
                      alpha = 0.5, size = 3, 
                      nudge_y = 0.1, show.legend = FALSE)
    })
    print(cowplot::plot_grid(plotlist=biplots, ncol=3))
    biplots2 <- lapply(eig.comb, function(x){
        fviz_pca_biplot(res, axes = x, geom.ind = "point", pointsize=0, repel = T)+ 
            ggtitle(paste0("plot for PC", x[1], ":PC", x[2]))+
            geom_text(aes(label = paste0(dat$State), colour=dat$State), 
                      alpha = 0.5, size = 3, 
                      nudge_y = 0.1, show.legend = FALSE)
    })
    print(cowplot::plot_grid(plotlist=biplots2, ncol=3))
    output <- list(eigs, scree, contribplot, cos2plot)
    return(output)
}

pfun(dat = dat1, cols = 4:8, ncp = 7)

#> [[1]]
#>        eigenvalue percentage of variance cumulative percentage of variance
#> comp 1       1.14                  22.88                             22.88
#> comp 2       1.08                  21.68                             44.57
#> comp 3       1.02                  20.30                             64.87
#> comp 4       0.93                  18.66                             83.53
#> comp 5       0.82                  16.47                            100.00
#> 
#> [[2]]

由#> 
#> [[3]]
#>           Dim.1       Dim.2     Dim.3       Dim.4      Dim.5
#> var1 0.20414881  0.24443766 0.5704115  0.80144254 0.02769182
#> var2 0.89612168 -0.03274609 0.1541064  0.16242237 0.66822795
#> var3 0.07326261  0.42569819 0.5364510  0.81272052 0.00000000
#> var4 0.03185269  1.00000000 0.3135185 -0.04406605 0.54682715
#> var5 0.64274654  0.21074258 0.2736449  0.11561294 0.60538540
#> 
#> [[4]]
#>           Dim.1       Dim.2     Dim.3       Dim.4      Dim.5
#> var1 0.22611471  0.25238130 0.5362197  0.68682597 0.02081676
#> var2 0.94869940 -0.02188827 0.1505096  0.14271101 0.50232677
#> var3 0.08943830  0.43173613 0.5047551  0.69642899 0.00000000
#> var4 0.04619648  1.00000000 0.2982062 -0.03311043 0.41106619
#> var5 0.68411533  0.21904048 0.2612629  0.10285356 0.45508617
（v0.3.0）在2020-06-13创建