使用ggord绘制多变量LDA图遇向量重叠，求分组连线实现方案

现状说明 #

使用ggord工具时发现，变量较少时能生成清晰的变量向量，但处理约50个基因表达的多变量LDA分析（共3组，分类变量为grup_int）时，向量重叠成网状无法辨识，当前使用的代码如下：

# simple syntax
ggord::ggord(model1, ldat2$grup_int, size = 1, ylim = c(-4,4))

当前效果：

期望效果 #

希望实现类似iris数据集示例中的分组连线效果（样本点到各组中心的虚线连接），示例代码及效果如下：

示例代码 #

library(MASS)
res <- lda(Species ~ . , iris)
res

fd <- predict(res, iris)$x  # 判别函数得分
coef(lm(fd ~ .-Species,iris))


iris2 <- iris
iris2[,1:4] <- scale(iris2[,1:4])
lda(Species ~ . , iris2)$scaling


plot(res, pch=19, col=as.integer(iris[,5]))


predicho <- predict(res, iris)
str(predicho)
predicho$class


table(iris[,5], predicho$class)


res.cv <- lda(Species ~ . , iris, CV=TRUE)


tc <- table(iris[,5], res.cv$class)
tc


prednew <- predict(res, newdata=data.frame(Sepal.Length=5, Sepal.Width=3, Petal.Length=2.5, Petal.Width=0.3))
prednew


fd <- predict(res,iris)$x
medias <- sapply(1:3, function(grupo) colMeans(fd[iris[,5]==levels(iris[,5])[grupo],]))
plot(fd, pch=19, col=as.integer(iris[,5]), asp=1)
points(medias[1,],medias[2,],pch="+",cex=2, col=1:3)
points(prednew$x,col="blue",pch=19)

# 添加样本到各组中心的连线
lines(c(prednew$x[1],medias[1,1]),c(prednew$x[2],medias[2,1]),lty=2,col=1)
lines(c(prednew$x[1],medias[1,2]),c(prednew$x[2],medias[2,2]),lty=2,col=2)
lines(c(prednew$x[1],medias[1,3]),c(prednew$x[2],medias[2,3]),lty=2,col=3)

library(cluster)
D<-daisy(rbind(prednew$x,t(medias)),"euclidean")
mtext(paste("距离:",round(D[1],3)),col=1,line=2)
mtext(paste("距离:",round(D[2],3)),col=2,line=1)
mtext(paste("距离:",round(D[3],3)),col=3,line=0)

参考效果 #

解决方案 #

方案1：关闭变量向量，手动添加分组连线 #

ggord默认绘制所有变量的载荷向量，变量过多时必然重叠。先关闭向量显示，再用ggplot2语法添加样本到各组中心的连线：

library(ggord)
library(ggplot2)

# 绘制基础LDA图，关闭变量向量（设置veclen=0）
p <- ggord(model1, ldat2$grup_int, size = 1, ylim = c(-4,4), veclen = 0)

# 获取LDA得分和各组中心坐标
lda_scores <- predict(model1, ldat2)$x
group_centers <- aggregate(lda_scores, by = list(grup_int = ldat2$grup_int), FUN = colMeans)

# 构造连线数据：每个样本点对应到所有组中心的连线信息
line_data <- do.call(rbind, lapply(1:nrow(lda_scores), function(i) {
  sample_coord <- lda_scores[i, ]
  data.frame(
    x = rep(sample_coord[1], nrow(group_centers)),
    xend = group_centers$LD1,
    y = rep(sample_coord[2], nrow(group_centers)),
    yend = group_centers$LD2,
    group = group_centers$grup_int
  )
}))

# 添加连线和组中心标记到图中
p + geom_segment(data = line_data, aes(x = x, y = y, xend = xend, yend = yend, color = group), 
                 linetype = "dashed", alpha = 0.5) +
  geom_point(data = group_centers, aes(x = LD1, y = LD2, color = grup_int), 
             shape = "+", size = 5)

方案2：保留关键变量向量（可选） #

如果需要保留部分变量的向量信息，可以筛选载荷绝对值较大的变量，仅绘制这些变量的向量：

# 获取LDA模型的变量载荷
loadings <- model1$scaling
# 筛选LD1和LD2载荷绝对值排名前10的变量
top_vars <- rownames(loadings)[order(-abs(loadings[,1]), -abs(loadings[,2]))][1:10]

# 绘制仅包含关键变量的LDA图
ggord(model1, ldat2$grup_int, size = 1, ylim = c(-4,4), var.sub = top_vars)

内容的提问来源于stack exchange，提问作者Javier Hernando