R/LMK_Viz.R

In ehrlichd/lmkCHK: Tools to Visualize and Screen 2D/3D Landmark Data

#'Shape Change Visualizations
#'
#'Easily visualize shape change and create relative warps for LMK data
#'
#'Attempt to combine all of these into a single function
#'@param dat Some form of landmark data of class array (p x k x n); gpagen (geomorph); PCA/CVA (morpho)
#'
#'@param ... Additional arguments to pass to subsequent functions based on input data
#'
#'@return will return a list of helpful information and some nice plots
#'
#'



### NOTE: geomorph doesn't correctlly handle working with residuals, this function takes a reference specimen (presumbaly consensus) and a particular analysis (PCA, CVA, PLS) and applies the transformations manually to warp to min/max(default) or specified position.


LMK_viz <- function(dat, ...){
  

  if (class(dat)=="array"){
    
  }
}


#' CVA 2D Shape Change
#' 
#' Visualize Shape change in two dimensions of Morpho object.class 'CVA'
#' 
#' @param CVA object of class CVA generated by Morpho::CVA
#' @param variate The canonical variate to be visualized (default = 1)
#' @param scale A scaling factor to emphasize shape change (default = 5)
#' 
#' @export
#' 
#' @return Plots the mean landmark configuration of a CVA an vectors representing the shape change along a given variate, by a given scale
#' 
#' 
LMK_CVA_2D <- function(CVA, variate = 1, scale = 5){
  #Function to visualize CVA shape changes of landmarks 
  #where CVA is an object of class 'CVA' from Morpho
  
  ref <- CVA$Grandm
  target <- scale*matrix(CVA$CVvis[,variate], nrow(CVA$Grandm), ncol(CVA$Grandm)) + CVA$Grandm
  
  plot(ref, asp=1, xlab = "", ylab = "", axes = F)
  for (i in 1:nrow(ref)){
    lines(rbind(ref[i,], target[i,]), col = "red")
  }
  
}

#'CVA 3D Shape Chance
#'
#'Visualize Shape change in three dimensions of Morpho object.class 'CVA'
#'
#'@param CVA object of class CVA generated by Morpho::CVA
#'@param variate The canonical variate to be visualized (default = 1)
#'@param scale A scaling factor to emphasize shape change (default = 5)
#'@param links A wireframe for visualizing. WIP
#' 
#'@export
#' 
#'@return Plots the mean landmark configuration of a CVA an vectors representing the shape change along a given variate, by a given scale
#'
#'
#'
#####and 3D plot#####
####Note: scale makes spheres too big, add an inverse scaling factor to those plots.
####Also, open3d means multi plots are impossible
###Need to combine 2D and 3D into a single function, possibly with PCA visualization as well

LMK_CVA_3D <- function(CVA, variate = 1, scale = 5, links = NULL){
  ref <- CVA$Grandm
  target <- scale*matrix(CVA$CVvis[,variate], nrow(CVA$Grandm), ncol(CVA$Grandm)) + CVA$Grandm
  r <- range(ref[,1])*1.1
  
  open3d()
  rgl.clear()
  plot3d(ref, xlim = r, ylim = r, zlim = r, axes = F, type = "p", size = abs(scale)*1.5)
  
  for (i in 1:nrow(ref)){
    lines3d(rbind(ref[i,],target[i,]), col = "red", lwd = 1.5)
  }
  
}


#####

###Combine shapepca with CVA as LMK_viz

###Implement 3D class

###Implement eigen graph as well
##Figure out a function to graph and identify REASONABLE number of eigen values
#IE broken stick, how to calc?
##Output table of eigenvalues and add to plott as well

##add scaling parameter/additional parameters IE should the axes be scaled by eigenloadings (probably)

#'Shapespace PCA
#'
#'Plot 2D or 3D scatter plot of tangent shape-space for a GPA object (of gpagen())
#'
#'@param A A 3d landmark array
#'@param xPC an integer indicating which PC to plot, default = 1
#'@param yPC an integer indicating which PC to plot, default = 2
#'@param zPC an integer indicating which PC to plot, default = NULL (2D)
#'@param grp a grouping factor
#'
#'@export
#'
#'
LMK_PCA_plot <- function(A, xPC = 1, yPC = 2, zPC = NULL, grp){
  f.PCA <- geomorph::plotTangentSpace(A, warpgrids = F)
  grp <- as.factor(grp)
  l <- length(levels(grp))
  
  ##Calculate means
  Mean.tab <- matrix(nrow = l+1, ncol = 10)
  for (i in 1:l){
    Mean.tab[i,] <- colMeans(f.PCA$pc.scores[as.integer(grp) == i, 1:10 ])
  }
  Mean.tab[l+1,] <- colMeans(f.PCA$pc.scores[,1:10]) 
  rownames(Mean.tab) <- c(levels(grp),"GrandM")
  colnames(Mean.tab) <- paste("PC",1:10, sep=".")
  
  if (is.null(zPC)){
    plot(f.PCA$pc.scores[,c(xPC, yPC)], col = LMK_colramp(grp), pch = 16)
    points(Mean.tab[,c(xPC, yPC)], pch = 21, bg = c(rainbow(l, s = .4), "grey"), cex = 1.5)
    legend("topleft", legend = c(levels(grp), "G.mean"), pch = 16, col = c(rainbow(l, s=.4), "grey"))
  } #implement 3D plot
  
  
  
}