Issue
I would like to change the scale of the arrows in the PCA biplot (diagram 1) and make them longer and thicker because the labels for the whistle parameters are overlapping and look unclear.
I tried using different combinations of R code (see the R code for the PCA Biplot for diagam 2)., and I managed to produce longer arrows but they overlay over the original arrows and the background gray labels for the whistle parameters are missing. Additionally, the biplot arrows are positioned in the wrong place as they don't line up with the arrows in the original biplot, which was produced from the R code for the PCA Biplot for diagam 1` (see below)
Aims
I would like to modify the R code that I used to create the PCA Biplot in diagram 1 to produce the same characteristics as diagram 3 because I really like this visual representation. I would like to make the arrows longer and thicker, and for the labels with the grey background to not overlap with each other, and to adjust the position of the labels so they are neatly at the end of each arrowhead. I used the varname.adjust() function for diagram 1 but I am not sure how to apply this for the labels in the geom_label() function in digram 2.
Unfortunately, I cannot share my data, so I have produced a Dummy Data frame, so the resulting PCA biplot will look very different to diagram 1 (see below).
If anyone can help, I would be deeply appreciative.
Many thanks in advance
Dummy Data
#Dummy data
#Create a cluster column with dummy data (clusters = 3)
f1 <- gl(n = 2, k=167.5); f1
#Produce a data frame for the dummy level data
f2<-as.data.frame(f1)
#Rename the column f2
colnames(f2)<-"Country"
#How many rows
nrow(f2)
#Rename the levels of the dependent variable 'Country' as classifiers
#prefer the inputs to be factors
levels(f2$Country) <- c("France", "Germany")
#Create random numbers
Start.Freq<-runif(335, min=1.195110e+02, max=23306.000000)
End.Freq<-runif(335, min=3.750000e+02, max=65310.000000)
Delta.Time<-runif(335, min=2.192504e-02, max=3.155762)
Low.Freq<-runif(335, min=6.592500e+02, max=20491.803000)
High.Freq<-runif(335, min=2.051000e+03, max=36388.450000)
Peak.Freq<-runif(335, min=7.324220+02, max=35595.703000)
Center.Freq<-runif(335, min=2.190000e-02, max=3.155800)
Delta.Freq<-runif(335, min=1.171875+03, max=30761.719000)
Delta.Time<-runif(335, min=2.192504e-02, max=3.155762)
#Bind the columns together
Bind<-cbind(f2, Start.Freq, End.Freq, Low.Freq, High.Freq, Peak.Freq, Center.Freq, Delta.Freq, Delta.Time)
#Rename the columms
colnames(Bind)<-c('Country', 'Low.Freq', 'High.Freq', 'Start.Freq', 'End.Freq', 'Peak.Freq', 'Center.Freq',
'Delta.Freq', 'Delta.Time')
#Produce a dataframe
Whistle_Parameters<-as.data.frame(Bind)
Whistle_Parameters
Data Transformation
#Open library packages
library(MASS)
library(car)
#Create a dataframe format for the Yeo transform
Box<-as.data.frame(Whistle_Parameters)
Box
#Check the structure of the dataframe 'Box'
str(Box)
#Use the function powerTransform(), specifying family = "bcPower", to obtain an optimal Box Cox transformation
transform_Low.Freq.box=car::powerTransform(Box$Low.Freq, family= "bcPower")
transform_Low.Freq.box
transform_High.Freq.box=car::powerTransform(Box$High.Freq, family= "bcPower")
transform_High.Freq.box
transform_Start.Freq.box=car::powerTransform(Box$Start.Freq, family= "bcPower")
transform_Start.Freq.box
transform_End.Freq.box=car::powerTransform(Box$End.Freq, family= "bcPower")
transform_End.Freq.box
transform_Peak.Freq.box=car::powerTransform(Box$Peak.Freq, family= "bcPower")
transform_Peak.Freq.box
transform_Center.Freq.box=car::powerTransform(Box$Center.Freq, family= "bcPower")
transform_Center.Freq.box
transform_Delta.Freq.box=car::powerTransform(Box$Delta.Freq, family= "bcPower")
transform_Delta.Freq.box
transform_Delta.Time.box=car::powerTransform(Box$Delta.Time, family= "bcPower")
transform_Delta.Time.box
#save transformed Box Cox data in strand_box to compare both
stand_box=Box
stand_box[,5]=bcPower(Box[,5],transform_Low.Freq.box$lambda)
stand_box[,6]=bcPower(Box[,6],transform_High.Freq.box$lambda)
stand_box[,7]=bcPower(Box[,7],transform_Start.Freq.box$lambda)
stand_box[,8]=bcPower(Box[,8],transform_End.Freq.box$lambda)
stand_box[,9]=bcPower(Box[,9],transform_Peak.Freq.box$lambda)
stand_box[,10]=bcPower(Box[,10],transform_Center.Freq.box$lambda)
stand_box[,11]=bcPower(Box[,11],transform_Delta.Freq.box$lambda)
stand_box[,12]=bcPower(Box[,12],transform_Delta.Time.box$lambda)
#Check the structure of the new stand_box Yeo-Johnson transformed data
str(stand_box)
#Produce a dataframe object
Box_Cox_Transformation<-as.data.frame(stand_box)
Box_Cox_Transformation
#Check the structure of the new stand_trans Yeo-Johnson transformed data
str(Box_Cox_Transformation)
PCA Biplot for diagam 1
install.packages("remotes")
remotes::install_github("vqv/ggbiplot")
install_github("vqv/ggbiplot")
#install.packages("devtools")
library(devtools)
library(ggbiplot)
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 biplot
PCA_plot<-ggbiplot(PCA, ellipse=TRUE, circle=TRUE, varname.adjust = 2.5, groups=Box_Cox_Stan_Dataframe$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()) +
theme(axis.line.x = element_line(color="black", size = 0.8),
axis.line.y = element_line(color="black", size = 0.8))
#Place the arrows in the forefront of the points
PCA_plot$layers <- c(PCA_plot$layers, PCA_plot$layers[[2]])
#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_plot$layers, function(x) class(x$geom)[1] == 'GeomSegment'))
txt <- which(sapply(PCA_plot$layers, function(x) class(x$geom)[1] == 'GeomText'))
#We can change the colour and width of the segments by doing
PCA_plot$layers[[seg[1]]]$aes_params$colour <- 'black'
PCA_plot$layers[[seg[2]]]$aes_params$colour <- 'black'
#Labels
# Extract loadings of the variables
PCAloadings <- data.frame(Variables = rownames(PCA$rotation), PCA$rotation)
#To change the labels to have a gray background, we need to overwrite the geom_text layer with a geom_label layer:
PCA_plot$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_plot$layers[[txt]]$data,
fill = '#dddddd80')
PCA_plot
PCA Biplot for diagam 2
# Extract loadings of the variables
PCAloadings <- data.frame(Variables = rownames(PCA$rotation), PCA$rotation)
#PCA biplots
PCA_plot1<-ggbiplot(PCA, ellipse=TRUE, circle=TRUE, varname.adjust = 2.5, groups=Box_Cox_Stan_Dataframe$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()) +
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*5),
yend = (PC2*5)), arrow = arrow(length = unit(1/2, "picas")),
color = "black") +
annotate("text", x = (PCAloadings$PC1*5), y = (PCAloadings$PC2*5),
label = PCAloadings$Variables)
#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 = PCA_plot1$Variables,
angle = 0.45, hjust = 0.5, fontface = "bold"),
label.size = NA,
data = PCA_plot1$layers[[txt]]$data,
fill = '#dddddd80')
PCA_plot1
Diagram 1
Diagram 2 - This arrows overlay the original biplot and are positioned incorrectly
Diagram 3 - Desired Output
