如何保存R的心理库中的pairs.panels生成的情节

时间:2017-06-29 15:39:15

标签: r plot psych reporters

我正在使用R的心理库,我在R中绘制相关对。

我想保存此函数生成的图并将其导出,例如使用ReporteRs在word文档中,但我不能这样做。这个问题已经讨论过here

当我深入研究为什么我没有导出它时,我意识到在R中写这个:

plot <- pairs.panel(...)
打印情节时,

正在给我:NULL

因此看来,无论pair.panels生成的对象是什么,它都可以存储在变量中,或者可以重新用于在报告中导出。

作为一个工作流程,我使用png()将图形存储在图像中,然后导入图像并将其插入报告中......效率低且速度慢,因此任何解决方法都会有所帮助 谢谢,

2 个答案:

答案 0 :(得分:2)

如果您查看psych的代码库,特别是pairs.panels,您会发现它正在使用基础图形来完成它的工作,并在那里绘制所有元素。不依赖ggplot2。基础文件成立于2007年。

如果您致力于使用此软件包,我认为您将不得不继续使用png()之类的方式保存图像。从理论上讲,人们可以分叉并尝试移植.....

不确定您要执行的操作,但如果您尝试执行成对比较,则另一个选项是利用其他libraries

例如:

2011年,Dalhousie大学的Mike Lawrence(但比 pairs.panels.R 新4年)使用ggplot2

library(ggplot2)

#define a helper function (borrowed from the "ez" package)
ezLev=function(x,new_order){
    for(i in rev(new_order)){
        x=relevel(x,ref=i)
    }
    return(x)
}

ggcorplot = function(data,var_text_size,cor_text_limits){
    # normalize data
    for(i in 1:length(data)){
        data[,i]=(data[,i]-mean(data[,i]))/sd(data[,i])
    }
    # obtain new data frame
    z=data.frame()
    i = 1
    j = i
    while(i<=length(data)){
        if(j>length(data)){
            i=i+1
            j=i
        }else{
            x = data[,i]
            y = data[,j]
            temp=as.data.frame(cbind(x,y))
            temp=cbind(temp,names(data)[i],names(data)[j])
            z=rbind(z,temp)
            j=j+1
        }
    }
    names(z)=c('x','y','x_lab','y_lab')
    z$x_lab = ezLev(factor(z$x_lab),names(data))
    z$y_lab = ezLev(factor(z$y_lab),names(data))
    z=z[z$x_lab!=z$y_lab,]
    #obtain correlation values
    z_cor = data.frame()
    i = 1
    j = i
    while(i<=length(data)){
        if(j>length(data)){
            i=i+1
            j=i
        }else{
            x = data[,i]
            y = data[,j]
            x_mid = min(x)+diff(range(x))/2
            y_mid = min(y)+diff(range(y))/2
            this_cor = cor(x,y)
            this_cor.test = cor.test(x,y)
            this_col = ifelse(this_cor.test$p.value<.05,'<.05','>.05')
            this_size = (this_cor)^2
            cor_text = ifelse(
                this_cor>0
                ,substr(format(c(this_cor,.123456789),digits=2)[1],2,4)
                ,paste('-',substr(format(c(this_cor,.123456789),digits=2)[1],3,5),sep='')
            )
            b=as.data.frame(cor_text)
            b=cbind(b,x_mid,y_mid,this_col,this_size,names(data)[j],names(data)[i])
            z_cor=rbind(z_cor,b)
            j=j+1
        }
    }
    names(z_cor)=c('cor','x_mid','y_mid','p','rsq','x_lab','y_lab')
    z_cor$x_lab = ezLev(factor(z_cor$x_lab),names(data))
    z_cor$y_lab = ezLev(factor(z_cor$y_lab),names(data))
    diag = z_cor[z_cor$x_lab==z_cor$y_lab,]
    z_cor=z_cor[z_cor$x_lab!=z_cor$y_lab,]
    #start creating layers
    points_layer = layer(
        geom = 'point'
        , data = z
        , mapping = aes(
            x = x
            , y = y
        )
    )
    lm_line_layer = layer(
        geom = 'line'
        , geom_params = list(colour = 'red')
        , stat = 'smooth'
        , stat_params = list(method = 'lm')
        , data = z
        , mapping = aes(
            x = x
            , y = y
        )
    )
    lm_ribbon_layer = layer(
        geom = 'ribbon'
        , geom_params = list(fill = 'green', alpha = .5)
        , stat = 'smooth'
        , stat_params = list(method = 'lm')
        , data = z
        , mapping = aes(
            x = x
            , y = y
        )
    )
    cor_text = layer(
        geom = 'text'
        , data = z_cor
        , mapping = aes(
            x=y_mid
            , y=x_mid
            , label=cor
            , size = rsq
            , colour = p
        )
    )
    var_text = layer(
        geom = 'text'
        , geom_params = list(size=var_text_size)
        , data = diag
        , mapping = aes(
            x=y_mid
            , y=x_mid
            , label=x_lab
        )
    )
    f = facet_grid(y_lab~x_lab,scales='free')
    o = opts(
        panel.grid.minor = theme_blank()
        ,panel.grid.major = theme_blank()
        ,axis.ticks = theme_blank()
        ,axis.text.y = theme_blank()
        ,axis.text.x = theme_blank()
        ,axis.title.y = theme_blank()
        ,axis.title.x = theme_blank()
        ,legend.position='none'
    )
    size_scale = scale_size(limits = c(0,1),to=cor_text_limits)
    return(
        ggplot()+
        points_layer+
        lm_ribbon_layer+
        lm_line_layer+
        var_text+
        cor_text+
        f+
        o+
        size_scale
    )
}

#set up some fake data
library(MASS)
N=100

#first pair of variables
variance1=1
variance2=2
mean1=10
mean2=20
rho = .8
Sigma=matrix(c(variance1,sqrt(variance1*variance2)*rho,sqrt(variance1*variance2)*rho,variance2),2,2)
pair1=mvrnorm(N,c(mean1,mean2),Sigma,empirical=T)

#second pair of variables
variance1=10
variance2=20
mean1=100
mean2=200
rho = -.4
Sigma=matrix(c(variance1,sqrt(variance1*variance2)*rho,sqrt(variance1*variance2)*rho,variance2),2,2)
pair2=mvrnorm(N,c(mean1,mean2),Sigma,empirical=T)

my_data=data.frame(cbind(pair1,pair2))

ggcorplot(
    data = my_data
    , var_text_size = 30
    , cor_text_limits = c(2,30)
)

示例用法和输出:

ggcorplot(
  data = iris[1:4],
  var_text_size = 5,
  cor_text_limits = c(5,10))

产量

Pairwise Comparisons of Iris Data

答案 1 :(得分:0)

从 2021 年开始,pairs.panels 可以处理 png。请参阅 http://personality-project.org/r/psych/HowTo/factor.pdf 的第 11 页。语法是

  png(filename = <panels_fn.png>, width = 480, height = 480, units = "px", pointsize = 12,
      bg = "white", res = NA, family = "", restoreConsole = TRUE,
      type = c("windows", "cairo", "cairo-png"), antialias = "d")
  
    pairs.panels(df[, relevant_cols], lm = FALSE, main = my_plot_title )
  dev.off()

您可以更改 png 参数以适应。有趣的是,如果我写

,它不起作用
p <- pairs.panels(df[, relevant_cols], lm = FALSE, main = my_plot_title )
png(filename = <panels_fn.png>, width = 480, height = 480, units = "px", pointsize = 12,
          bg = "white", res = NA, family = "", restoreConsole = TRUE,
          type = c("windows", "cairo", "cairo-png"), antialias = "d")
        print(p)
dev.off()