ggplot2：调整 R 中 PCA 双图中 PCA 载荷的标签位置

Issue:

我制作了一个PCA biplot使用包ggbiplot/ggplot2。我使用该函数延长了载荷（箭头）geom_segment()我想删除原始加载（短箭头），保留较长加载（新箭头），保留带有灰色背景的标签，但重新定位它们，使它们不重叠并很好地位于较长加载的末尾箭头。在下面的 PCA 双图中，有 10 个载荷，但只有 8 个参数。有什么不对劲。

我通过 StackOverflow 在网络上进行了广泛的研究，并且我已要求 R Studio 社区解决我的问题，尽管如此，我能找到的唯一信息是通过不同的双标图函数或对其他完全不同的 PCA 包的引用（MASS、factoextra、FactoMineR、PCAtools 等），这些都没有解决我想回答的问题。

我真的很想继续使用ggbiplot/ggplot2为了更好地理解这两个包，我更喜欢视觉表示PCA biplot (see below)我创造了。我理想地希望双标图看起来像desired output (see below)。请参阅下面所附的数据。

如果有人可以提供帮助，我将不胜感激。

提前谢谢了

R-code:

install.packages("remotes")
remotes::install_github("vqv/ggbiplot")
install_github("vqv/ggbiplot")

#install.packages("devtools")
library(devtools)
library(ggbiplot)
library(ggplot2)
library(remotes)

#You can do a PCA to visualize the difference between the groups using the standardised box cox data
PCA=prcomp(Whistle_Parameters[2:18], center = TRUE, scale=TRUE, retx = T)

#PCA loadings
PCAloadings <- data.frame(Variables = rownames(PCA$rotation), PCA$rotation)

#Place label into an object
Country<-data$Country

#PCA biplots
PCA_plot1<-ggbiplot::ggbiplot(PCA, ellipse=TRUE, circle=TRUE, varname.adjust = 2.5, groups=Country, var.scale = 1) +
                     ggtitle("PCA of Acoustic Parameters") +
                     theme(plot.title = element_text(hjust = 0.5)) +
                     theme_minimal() +
                     theme(panel.background = element_blank(), 
                     panel.grid.major = element_blank(), 
                     panel.grid.minor = element_blank(),
                     panel.border = element_blank()) + 
                     geom_vline(xintercept = 0, lty = 2) +
                     geom_hline(yintercept = 0, lty = 2) +
                     theme(axis.line.x = element_line(color="black", size = 0.8),
                     axis.line.y = element_line(color="black", size = 0.8)) +
                     geom_segment(data = PCAloadings, aes(x = 0, y = 0, xend = (PC1*4.6),
                                yend = (PC2*4.6)), arrow = arrow(length = unit(1/2, "picas")),
                                color = "black", alpha=0.75) +
                     scale_color_manual(values=c('#E69F00', '#56B4E9')) 

#The options for styling the plot within the function itself are somewhat limited, but since it produces a 
#ggplot object, we can re-specify the necessary layers. The following code should work on any object 
#output from ggbiplot. First we find the geom segment and geom text layers:
seg <- which(sapply(PCA_plot1$layers, function(x) class(x$geom)[1] == 'GeomSegment'))
txt <- which(sapply(PCA_plot1$layers, function(x) class(x$geom)[1] == 'GeomText'))

#We can change the colour and width of the segments by doing
PCA_plot1$layers[[seg[1]]]$aes_params$colour <- 'black' 
PCA_plot1$layers[[seg[2]]]$aes_params$colour <- 'black'

#To change the labels to have a gray background, we need to overwrite the geom_text layer with a geom_label layer:
PCA_plot1$layers[[txt]] <- geom_label(aes(x = xvar, y = yvar, label = PCAloadings$Variables,
                                         angle = 0.45, hjust = 0.5, fontface = "bold"), 
                                         label.size = NA,
                                         data = PCA_plot1$layers[[txt]]$data, 
                                         fill = '#dddddd80')

PCA_plot1

主成分分析双标图

所需输出

Data

structure(list(Country = structure(c(1L, 1L, 1L, 1L, 1L, 1L, 
1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 
1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L), .Label = c("France", "Germany"
), class = "factor"), Low.Freq = c(1229.098358827, 759.408910773596, 
627.156561121131, 857.914227798394, 816.020512657709, 726.252107003186, 
603.388640229802, 1120.43591201848, 521.916239230762, 66.4277073927702, 
842.827028732445, 1548.00685289626, 743.586603639966, 982.298813187027, 
938.898554484786, 908.067281510105, 1650.51840217509, 435.837013213028, 
905.64518713548, 621.693057238002, 408.874626715846, 763.284854056395, 
1163.36397892984, 1267.90558781017, 1561.05494859439, 269.110242829792, 
1628.20258277437, 1381.52801863709, 1259.64885050619, 582.429604337893
), High.Freq = c(270.037998321385, 673.100410969792, 1354.51641087434, 
582.818682820139, 1949.42791374982, 533.072062804075, 1462.73353623344, 
1475.85981044777, 1672.72713391206, 1360.85064740235, 1027.62671423916, 
1637.72929840934, 555.708652550379, 683.537132648398, 1714.01010661954, 
267.117743854174, 738.883902818488, 842.919932827166, 124.511854388999, 
1940.70836004547, 991.37814311059, 1959.73951887933, 435.882938574683, 
223.944759894009, 827.050231552967, 1929.9835959516, 731.983627515309, 
934.515637669084, 1381.80407878684, 1735.12129509753), Start.Freq = c(209.223178720873, 
1243.93824398519, 714.942866646311, 1230.88587487336, 1133.38920481274, 
655.640254812419, 176.783487591076, 566.793710992312, 1259.4101411541, 
135.19626803044, 1188.65745695622, 1055.06564740433, 145.269654935287, 
994.102001940972, 611.97046714505, 1239.25416627405, 273.254811174704, 
1187.0983873612, 532.369927415851, 730.144132713145, 306.959091815357, 
761.432150933258, 833.35964575595, 633.492439842001, 1011.91529244509, 
1002.6837164403, 874.223664731894, 1039.77329580107, 571.716041690428, 
358.734914494325), End.Freq = c(3100.50977989246, 2865.99128764993, 
3749.07057886566, 1662.75251781181, 3469.5453928947, 1223.29004528624, 
1571.69393815622, 3877.90064918956, 3467.9046701139, 2812.46639335828, 
3344.48917919081, 823.479192696172, 3587.72640978872, 1943.42597579601, 
3726.46938122543, 904.270327650973, 2199.36865174236, 1608.75061469279, 
1233.86988042306, 3573.54022639883, 3840.13648049746, 2696.92512488242, 
2152.58952962537, 2225.74334558365, 2836.8576276391, 3909.86535579565, 
2642.3514330105, 3830.39875611625, 2532.59589574087, 2047.68204963624
), Peak.Freq = c(615.103200058515, 781.386010343022, 1254.22250479111, 
1042.32081012698, 1785.4136370848, 609.196990586287, 936.529532621528, 
628.617072934145, 1138.00887772997, 965.752651960148, 331.381776986669, 
831.243197072226, 1396.09323352817, 796.57855885715, 1434.02692184993, 
581.91826512844, 1482.84787412806, 712.229765737013, 711.849861782499, 
379.432018940052, 1495.87429192735, 1375.38825516007, 1568.51147252198, 
39.6849748542959, 254.973241980045, 526.048000326837, 1599.41223732841, 
1723.40465012645, 461.157566614546, 847.403323972557), Center.Freq = c(-0.00396318509300687, 
0.377462792184857, 1.66350671788962, -0.152573382048654, 0.438259482923988, 
1.62149800844459, 0.501892326424285, -0.166579179714419, 1.06081611813746, 
1.39199162769052, 1.52164843383928, -0.389958351497529, 0.00261034688899059, 
0.0726410215179534, 1.00473421813784, 1.27072495569536, 1.41569796343226, 
0.737375815997266, 0.412628778604207, 0.51099123600198, 1.65512836540775, 
-1.12408230668747, 0.438260531725931, -1.11347230908714, 1.09021071848368, 
1.26465014876586, -0.663254496003035, 0.64384027394782, 1.29816899903361, 
0.0302328674903059), Delta.Freq = c(2374.48934930825, 2535.28648042237, 
930.363518659463, 2372.94461226817, 2578.50041236941, 1652.93682378145, 
2412.64071270543, 1643.35808756239, 1597.6988634255, 2347.87731769764, 
1545.35983248752, 417.894712991398, 676.404759114593, 2717.74464723351, 
2750.52013318133, 1387.50061490775, 1088.18301844773, 208.885548316239, 
982.856603814324, 1304.55461743298, 2064.83914948351, 1454.17493801179, 
1975.72909682146, 1340.40119652782, 1358.81720189322, 398.974468430338, 
1807.83210129773, 197.995771350184, 1458.91300578134, 2459.54002342707
), Delta.Time = c(1.52332103330495, -0.729369599299347, 0.5446606158259, 
-0.0806278952890181, -1.03355982391612, 0.381391555011319, -0.710006011318096, 
0.184876103317229, -0.0939796220798944, 0.878826387745255, 0.889598364118577, 
0.929698941247702, 0.734996499853458, -0.43364546563554, -0.176575903721404, 
0.556057576098353, -0.31543237357059, 1.31950129257089, 1.08676447814548, 
-1.08756351145615, -0.163851619861579, -0.945982375537661, 0.473134073749239, 
-0.231569591521918, -0.565159893817776, 1.14721196081124, -1.14555651287826, 
1.60486934195338, -1.00704726744845, 1.14020903183312)), row.names = c(NA, 
30L), class = "data.frame")

将载荷保存在单独的数据框中，然后使用 ggplot::geom_segment 进行绘图怎么样？像这样：

#You can do a PCA to visualize the difference between the groups using the standardised box cox data
PCA = prcomp(df[2:9], center = TRUE, scale=TRUE, retx = T)

#PCA loadings
PCAloadings <- data.frame(Variables = rownames(PCA$rotation), PCA$rotation)

# add PCA scores to the dataset
df[, c('PC1', 'PC2')] = PCA$x[, 1:2]

# save variable loadings in a separate dataset
rot = as.data.frame(PCA$rotation[, 1:2])
rot$var = rownames(PCA$rotation)

# rescale the loadings to fit nicely within the scatterplot of our data
mult = max(abs(df[, c('PC1', 'PC2')])) / max(abs(rot[, 1:2])) / 2
rot[, 1:2] = rot[, 1:2] * mult

# ggplot the scatterplot and rotation taken from separate data.frames
ggplot(data = rot, aes(x = 0, y = 0, xend = PC1, yend = PC2, label = var)) +
  geom_point(data = df, aes(PC1, PC2), inherit.aes = FALSE) +
  geom_segment(color = 'red', arrow = arrow(length = unit(0.03, "npc"))) +
  geom_label(aes(PC1 * 1.2, PC2 * 1.2)) +
  theme_bw() +
  theme(panel.grid = element_blank())

# if there are many variables to plot, you can play with ggrepel 
library(ggrepel)  
ggplot(data = rot, aes(x = 0, y = 0, xend = PC1, yend = PC2, label = var)) +
  geom_point(data = df, aes(PC1, PC2), inherit.aes = FALSE) +
  geom_segment(color = 'red', arrow = arrow(length = unit(0.03, "npc"))) +
  geom_label_repel(aes(PC1 * 1.2, PC2 * 1.2)) +
  theme_bw() +
  theme(panel.grid = element_blank())