Search code examples
r3dplotlypca

3D Biplot in plotly - R


I want to build a 3D PCA bi-plot using plotly package because the graph is nice and interactive in html format (something that I need).

My difficulty is to add the loading. I want the loading to be presented as straight lines from the point (0,0,0) (i.e. the equivalent to 2D biplots)

So all in all I don't know how to add straight lines starting from the centre of the 3D graph.

I have calculated the scores and loading using the PCA function;

pca1 <- PCA (dat1, graph = F)

for scores:

ind1 <- pca1$ind$coord[,1:3]
x <- ind1[,1] ; y <- ind1[,2] ; z <- ind1[,3]

for loadings:

var1 <- pca1$var$coord[,1:3]
xl <- var1[,1] ; yl <- var1[,2] ; zl <- var1[,3]

and using the code bellow the 3D score plot is generated;

p <- plot_ly( x=x, y=y, z=z, 
 marker = list(opacity = 0.7, color=y  , colorscale = c('#FFE1A1', '#683531'), showscale = F)) %>% 
  layout(title = "3D Prefmap",
         scene = list(
           xaxis = list(title = "PC 1"), 
           yaxis = list(title = "PC 2"), 
           zaxis = list(title = "PC 3")))

Solution

  • Here are some ideas that could be useful for the development of a 3D biplot.

    # Data generating process
    library(MASS)
    set.seed(6543)
    n <- 500
    mu <- c(1,-2,3,-1,3,4)
    Sigma <- diag(rep(1,length(mu)))
    Sigma[3,1] <- Sigma[1,3] <- 0.1
    Sigma[4,6] <- Sigma[6,4] <- 0.1
    X <- as.data.frame(mvrnorm(n, mu=mu, Sigma=Sigma))
    
    # PCA
    pca <- princomp(X, scores=T, cor=T)
    
    # Scores
    scores <- pca$scores
    x <- scores[,1]
    y <- scores[,2]
    z <- scores[,3]
    
    # Loadings
    loads <- pca$loadings
    
    # Scale factor for loadings
    scale.loads <- 5
    
    # 3D plot
    library(plotly)
    p <- plot_ly() %>%
      add_trace(x=x, y=y, z=z,
                type="scatter3d", mode="markers",
                marker = list(color=y, 
                   colorscale = c("#FFE1A1", "#683531"), 
                   opacity = 0.7)) 
    
    for (k in 1:nrow(loads)) {
       x <- c(0, loads[k,1])*scale.loads
       y <- c(0, loads[k,2])*scale.loads
       z <- c(0, loads[k,3])*scale.loads
       p <- p %>% add_trace(x=x, y=y, z=z,
                type="scatter3d", mode="lines",
                line = list(width=8),
                opacity = 1) 
    }
    print(p)
    

    enter image description here