r - LDA 贡献双标图

Question

我正在尝试为线性判别分析 (LDA) 创建双标图。我正在使用从这里获得的代码的修改版本 https://stats.stackexchange.com/questions/82497/can-the-scaling-values-in-a-linear-discriminant-analysis-lda-be-used-to-plot-e

但是，我有 80 个变量，使双标图极难阅读。高度贡献的变量使情况变得更糟，因为它们的箭头长度很长，其余标签在中间被揉成一团。 所以我想要实现的是一个双标图，其中所有可变箭头的长度都相等，并且它们的相对贡献(比例)通过渐变颜色区分。 到目前为止，我已经设法获得了分级颜色，但我找不到使箭头长度相同的方法。据我了解，geom_text 和 geom_segment 使用 LD1 和 LD2 值来确定 length 和 direction箭头。如何覆盖长度？

代码:

library(ggplot2)
library(grid)
library(MASS)
data(iris)


iris.lda <- lda(as.factor(Species)~.,
                data=iris)

#Project data on linear discriminants
iris.lda.values <- predict(iris.lda, iris[,-5])

#Extract scaling for each predictor and
data.lda <- data.frame(varnames=rownames(coef(iris.lda)), coef(iris.lda))

#coef(iris.lda) is equivalent to iris.lda$scaling

data.lda$length <- with(data.lda, sqrt(LD1^2+LD2^2))

#Plot the results
p <- qplot(data=data.frame(iris.lda.values$x),
           main="LDA",
           x=LD1,
           y=LD2,
           colour=iris$Species)+stat_ellipse(geom="polygon", alpha=.3, aes(fill=iris$Species))
p <- p + geom_hline(aes(yintercept=0), size=.2) + geom_vline(aes(xintercept=0), size=.2)
p <- p + theme(legend.position="right")
p <- p + geom_text(data=data.lda,
                   aes(x=LD1, y=LD2,
                       label=varnames, 
                       shape=NULL, linetype=NULL,
                       alpha=length, position="identity"),
                   size = 4, vjust=.5,
                   hjust=0, color="red")
p <- p + geom_segment(data=data.lda,
                      aes(x=0, y=0,
                          xend=LD1, yend=LD2,
                          shape=NULL, linetype=NULL,
                          alpha=length),
                      arrow=arrow(length=unit(0.1,"mm")),
                      color="red")
p <- p + coord_flip()

print(p)

Answer 1

这样的事情怎么样？我们必须做一些三角函数来使长度相等。请注意，相等是在绘图坐标中，因此如果您想要实际显示为相等大小，则需要添加 coord_equal。

(我清理了你的绘图代码，因为其中很多都是一团糟。)

rad <- 3 # This sets the length of your lines.
data.lda$length <- with(data.lda, sqrt(LD1^2+LD2^2))
data.lda$angle <- atan2(data.lda$LD1, data.lda$LD2)
data.lda$x_start <- data.lda$y_start <- 0
data.lda$x_end <- cos(data.lda$angle) * rad
data.lda$y_end <- sin(data.lda$angle) * rad

#Plot the results
ggplot(cbind(iris, iris.lda.values$x),
       aes(y = LD1, x = LD2, colour = Species)) + 
  stat_ellipse(aes(fill = Species), geom = "polygon", alpha = .3) +
  geom_point() +
  geom_hline(yintercept = 0, size = .2) + 
  geom_vline(xintercept = 0, size = .2) +
  geom_text(aes(y = y_end, x = x_end, label = varnames, alpha = length),
            data.lda, size = 4, vjust = .5, hjust = 0, colour = "red") +
  geom_spoke(aes(x_start, y_start, angle = angle, alpha = length), data.lda, 
             color = "red", radius = rad, size = 1) +
  ggtitle("LDA") +
  theme(legend.position = "right")