我试图在 R 中绘制 Dewey 和 Lu(1959)建议的路径分析的输出。

require(agricolae)
require(Hmisc)

data(wilt)
data(soil)
x<-soil[,c(3,12,14,20)]
y<-wilt[,14]
data <- cbind(y,x)
#Correlation of independant variables
cor.x <- rcorr(as.matrix(x))$r
#Correlation of dependant variable with all the independant variables
cor.y <- as.data.frame(t(subset(rcorr(as.matrix(cbind(y,x)))$r, select = c(y))))[,-1]
#Path Analysis
Path <- path.analysis(cor.x,cor.y)
#Direct Effects
diag(Path$Coeff)
#Residual Effects
Path$Residual

我想绘制自变量对因变量 y 的直接影响以及因变量之间的相关性以及残差效应如下。

我试过 semPlotpath.diagram {sem}qgraph.lavaan ,但它们只绘制模型。 pathdiagram 不绘制边缘标签(路径系数和相关性)。如何在 R 中做到这一点?

这是我使用 `diagram 包所得到的。
par(mar = c(1, 1, 1, 1))
openplotmat()
# Get plot coordinates
elpos <- coordinates (c(2, length(cor.y)))
# adjust coordinates for Residual
elpos[2,1] <- abs((elpos[1,1]+elpos[1,2])/2)


#Specify Arrow positions
#1 Residual to Dependent
ft1 <- matrix(ncol = 2, byrow = TRUE, data = c(1, 2))
#2 Independent to dependent
ft2 <- matrix(ncol=2, byrow = FALSE,
              data= c(seq((2+length(cor.y)))[3:(length(cor.y)+2)], rep(2, length(cor.y))))
#3 For cor.x
fromto_CU <- t(combn(seq((2+length(cor.y)))[3:(length(cor.y)+2)],2))
#4 For path distances
fromto_ST <- rbind(ft1,ft2)

# Plot Path distance arrows
nr <- nrow(fromto_ST)
arrpos <- matrix(ncol = 2, nrow = nr)
for (i in 1:nr)
  arrpos[i, ] <- straightarrow (to = elpos[fromto_ST[i, 2], ],
                                from = elpos[fromto_ST[i, 1], ],
                                lwd = 2, arr.pos = 0.6, arr.length = 0.5)

#Label residual path distance arrow
text(arrpos[1, 1], arrpos[1, 2] + 0.05,
     paste("P", "X", nrow(cor.x)+1," = ", round(Path$Residual, 2), sep=""), cex=0.6)

#Label path distance arrows
nr <- nrow(arrpos)
for(i in 2:nr){
  text(arrpos[i, 1], arrpos[i, 2] + 0.05,
       paste("P", "X", i-1," = ", round(diag(Path$Coeff)[i-1], 2), sep=""), cex=0.6)
}

# Plot correlation arrows direction 1
nr <- nrow(fromto_CU)
arrpos <- matrix(ncol = 2, nrow = nr)
for (i in 1:nr)
  arrpos[i, ] <- curvedarrow (to = elpos[fromto_CU[i, 2], ],
                                from = elpos[fromto_CU[i, 1], ],
                                lwd = 2, arr.pos = 0.8, arr.length = 0.5, curve = 0.35)

# Plot correlation arrows - direction 2
nr <- nrow(fromto_CU)
arrpos <- matrix(ncol = 2, nrow = nr)
for (i in 1:nr)
  arrpos[i, ] <- curvedarrow (to = elpos[fromto_CU[i, 1], ],
                              from = elpos[fromto_CU[i, 2], ],
                              lwd = 2, arr.pos = 0.8, arr.length = 0.5, curve = -0.35)

# Create combinations of cor.x for labelling rxy in correlation arrows
rcomb <- as.data.frame(t(combn(seq(nrow(cor.x)),2)))
rcomb <- paste(rcomb$V1,rcomb$V2, sep="")

# Label correlation arrows
nr <- nrow(fromto_CU)
arrpos <- matrix(ncol = 2, nrow = nr)
for (i in 1:nr)
  arrpos[i, ] <- curvedarrow (to = elpos[fromto_CU[i, 1], ],
                              from = elpos[fromto_CU[i, 2], ],
                              lwd = 2, arr.pos = 0.5, lcol = "transparent", arr.length = 0.5, curve = -0.35)

nr <- nrow(arrpos)
for(i in 1:nr){
  text(arrpos[i, 1], arrpos[i, 2] + 0.05,
       paste("r", "X", rcomb[i]," = ", round(as.dist(cor.x)[i], 2), sep=""), cex=0.6)
}

# Label Residual
textrect (elpos[1,], 0.09, 0.03,lab = "Residual", box.col = "white",
          shadow.col = "grey", shadow.size = 0.005, cex = 1)
# Label Dependent
textrect (elpos[2,], 0.09, 0.03,lab = attributes(y)$class, box.col = "white",
          shadow.col = "grey", shadow.size = 0.005, cex = 1)
# Label independents
nr <- nrow(elpos)
for (i in 3:nr){
  textrect (elpos[i,], 0.09, 0.03,lab = colnames(x)[i-2], box.col = "white",
            shadow.col = "grey", shadow.size = 0.005, cex = 1)
}

我需要一些帮助

1) 在 diagram 中的水平布局上绘图,使绘图看起来像第一个

2) 在箭头标签中绘制下标,例如 PX5、r12、r34 等。 expressionpaste 在使用的​​循环中的组合返回索引符号本身而不是索引元素。

最佳答案

从长远来看,您可能会发现只需使用 text 之类的工具将文本放置在绘图中所需的位置即可。我不知道用什么参数来定义带有“P25 = -0.37”和类似标签的对角线,但假设您知道每条线的坐标(例如端点),您可以使用 plotrix:radialtext

关于r - 将 Dewey 和 Lu 路径分析结果绘制为 R 中的路径图,我们在Stack Overflow上找到一个类似的问题:https://stackoverflow.com/questions/24364665/

10-16 22:21