Toothnroll (version 1.11)

ToothPCA: ToothPCA

Description

Perform the Principal Component Analysis on a list of tooth.shape objects

Usage

ToothPCA(
  mpShapeList,
  gamMap = FALSE,
  nrow = 120,
  ncol = 80,
  gdl = 250,
  rem.out = TRUE,
  scaleThick = FALSE,
  relThick = FALSE,
  fac.out = 1.5,
  method = "equiangular",
  scalePCA = TRUE
)

Value

PCscores matrix of PC scores

PCs principal components

variance table of the explained Variance by the PCs

meanMap mean map

CorMaps maps of thickness used as input in the PCA

Arguments

mpShapeList

list: tooth.shape objects

gamMap

logical: if TRUE gamMap spline method is applied

nrow

numeric: number of rows if gamMap is TRUE

ncol

numeric: number of columns if gamMap is TRUE

gdl

numeric: degree of freedom (if gamMap is TRUE)

rem.out

logical: if TRUE outliers are removed

scaleThick

logical: if TRUE thickness values are scaled from 0 to 1

relThick

logical: if TRUE the thickness values are scaled by the diameter from the centroid to the external outline

fac.out

numeric: threshold to define an outlier observation

method

character: "equiangular" or "closest" to define the thickness from evenly spaced or closest semilandmarks between the external and internal outline

scalePCA

logical: indicate whether the variables should be scaled to have unit variance

Author

Antonio Profico; Mathilde Augoyard

Examples

### Example on the canine crown
data("UCcrown")
require(morphomap)
shapeList<-UCcrown
PCA<-ToothPCA(shapeList,gamMap = FALSE,scaleThick = TRUE,scalePCA = TRUE ,relThick = FALSE)
 # \donttest{
#gamMap set on TRUE
PCA<-ToothPCA(shapeList,gamMap = TRUE,scaleThick = TRUE,scalePCA = TRUE,relThick = FALSE)
# }
otu<-substr(names(shapeList),1,2)
pchs <- ifelse(otu == "MH", 16, 17)
cols <- ifelse(otu == "MH", "orange", "darkblue")

plot(PCA$PCscores,col=cols,cex=1, pch = pchs,
     xlab=paste("PC1 (",round(PCA$Variance[1,2],2),"%)"),
     ylab=paste("PC2 (",round(PCA$Variance[2,2],2),"%)"),
     cex.lab=1,cex.axis=1)
title (main="UC (radicular dentine)", font.main= 1,adj = 0, cex.main = 1.2)
legend("topright", legend = c("MH", "NE"), col = c("orange", "darkblue"), pch = c(16,17), cex = 0.8)
abline(v=0,h=0,col="black",lwd=2,lty=3)

hpts1 <- chull(PCA$PCscores[which(otu=="MH"),1:2])
hpts1 <- c(hpts1, hpts1[1])
polygon(PCA$PCscores[which(otu=="MH")[hpts1],1:2 ], col = adjustcolor("orange", 0.3), border = NA)

hpts2 <- chull(PCA$PCscores[which(otu=="NE"),c(1:2)])
hpts2 <- c(hpts2, hpts2[1])
polygon(PCA$PCscores[which(otu=="NE")[hpts2], ], col = adjustcolor("darkblue", 0.3), border = NA)

PC1min<-ToothVariations(PCA,min(PCA$PCscores[,1]),PCA$PCs[,1],asp=0.5,meanmap = FALSE)
PC1max<-ToothVariations(PCA,max(PCA$PCscores[,1]),PCA$PCs[,1],asp=0.5,meanmap = FALSE)

### Example on the canine root
data("UCroot")
require(morphomap)
shapeList<-UCroot
PCA<-ToothPCA(shapeList,gamMap = FALSE,scaleThick = TRUE,scalePCA = TRUE,relThick = FALSE)
otu<-substr(names(shapeList),1,2)
pchs <- ifelse(otu == "MH", 16, 17)
cols <- ifelse(otu == "MH", "orange", "darkblue")

plot(PCA$PCscores,col=cols,cex=1, pch = pchs,
     xlab=paste("PC1 (",round(PCA$Variance[1,2],2),"%)"),
     ylab=paste("PC2 (",round(PCA$Variance[2,2],2),"%)"),
     cex.lab=1,cex.axis=1)
title (main="UC (radicular dentine)", font.main= 1,adj = 0, cex.main = 1.2)
legend("topright", legend = c("MH", "NE"), col = c("orange", "darkblue"), pch = c(16,17), cex = 0.8)
abline(v=0,h=0,col="black",lwd=2,lty=3)

hpts1 <- chull(PCA$PCscores[which(otu=="MH"),1:2])
hpts1 <- c(hpts1, hpts1[1])
polygon(PCA$PCscores[which(otu=="MH")[hpts1],1:2 ], col = adjustcolor("orange", 0.3), border = NA)

hpts2 <- chull(PCA$PCscores[which(otu=="NE"),c(1:2)])
hpts2 <- c(hpts2, hpts2[1])
polygon(PCA$PCscores[which(otu=="NE")[hpts2], ], col = adjustcolor("darkblue", 0.3), border = NA)

PC1min<-ToothVariations(PCA,min(PCA$PCscores[,1]),PCA$PCs[,1],asp=0.5,meanmap = FALSE)
PC1max<-ToothVariations(PCA,max(PCA$PCscores[,1]),PCA$PCs[,1],asp=0.5,meanmap = FALSE)

### Example on the central upper incisor (crown)
data("UI1crown")
require(morphomap)
shapeList<-UI1crown
PCA<-ToothPCA(shapeList,gamMap = FALSE,scaleThick = TRUE,scalePCA = TRUE ,relThick = FALSE)
otu<-substr(names(shapeList),1,2)
pchs <- ifelse(otu == "MH", 16, 17)
cols <- ifelse(otu == "MH", "orange", "darkblue")

plot(PCA$PCscores,col=cols,cex=1, pch = pchs,
     xlab=paste("PC1 (",round(PCA$Variance[1,2],2),"%)"),
     ylab=paste("PC2 (",round(PCA$Variance[2,2],2),"%)"),
     cex.lab=1,cex.axis=1)
title (main="UC (radicular dentine)", font.main= 1,adj = 0, cex.main = 1.2)
legend("topright", legend = c("MH", "NE"), col = c("orange", "darkblue"), pch = c(16,17), cex = 0.8)
abline(v=0,h=0,col="black",lwd=2,lty=3)

hpts1 <- chull(PCA$PCscores[which(otu=="MH"),1:2])
hpts1 <- c(hpts1, hpts1[1])
polygon(PCA$PCscores[which(otu=="MH")[hpts1],1:2 ], col = adjustcolor("orange", 0.3), border = NA)

hpts2 <- chull(PCA$PCscores[which(otu=="NE"),c(1:2)])
hpts2 <- c(hpts2, hpts2[1])
polygon(PCA$PCscores[which(otu=="NE")[hpts2], ], col = adjustcolor("darkblue", 0.3), border = NA)

PC1min<-ToothVariations(PCA,min(PCA$PCscores[,1]),PCA$PCs[,1],asp=0.5,meanmap = FALSE)
PC1max<-ToothVariations(PCA,max(PCA$PCscores[,1]),PCA$PCs[,1],asp=0.5,meanmap = FALSE)

### Example on the upper central incisor (root)
data("UI1root")
require(morphomap)
shapeList<-UI1root
PCA<-ToothPCA(shapeList,gamMap = FALSE,scaleThick = TRUE,scalePCA = TRUE,relThick = FALSE)
otu<-substr(names(UI1root),1,2)
pchs <- ifelse(otu == "MH", 16, 17)
cols <- ifelse(otu == "MH", "orange", "darkblue")

plot(PCA$PCscores,col=cols,cex=1, pch = pchs,
     xlab=paste("PC1 (",round(PCA$Variance[1,2],2),"%)"),
     ylab=paste("PC2 (",round(PCA$Variance[2,2],2),"%)"),
     cex.lab=1,cex.axis=1)
title (main="UC (radicular dentine)", font.main= 1,adj = 0, cex.main = 1.2)
legend("topright", legend = c("MH", "NE"), col = c("orange", "darkblue"), pch = c(16,17), cex = 0.8)
abline(v=0,h=0,col="black",lwd=2,lty=3)

hpts1 <- chull(PCA$PCscores[which(otu=="MH"),1:2])
hpts1 <- c(hpts1, hpts1[1])
polygon(PCA$PCscores[which(otu=="MH")[hpts1],1:2 ], col = adjustcolor("orange", 0.3), border = NA)

hpts2 <- chull(PCA$PCscores[which(otu=="NE"),c(1:2)])
hpts2 <- c(hpts2, hpts2[1])
polygon(PCA$PCscores[which(otu=="NE")[hpts2], ], col = adjustcolor("darkblue", 0.3), border = NA)

PC1min<-ToothVariations(PCA,min(PCA$PCscores[,1]),PCA$PCs[,1],asp=0.5,meanmap = FALSE)
PC1max<-ToothVariations(PCA,max(PCA$PCscores[,1]),PCA$PCs[,1],asp=0.5,meanmap = FALSE)

### Example on the lateral upper incisor (crown)
data("UI2crown")
require(morphomap)
shapeList<-UI2crown
PCA<-ToothPCA(shapeList,gamMap = FALSE,scaleThick = TRUE,scalePCA = TRUE ,relThick = FALSE)
otu<-substr(names(shapeList),1,2)
pchs <- ifelse(otu == "MH", 16, 17)
cols <- ifelse(otu == "MH", "orange", "darkblue")

plot(PCA$PCscores,col=cols,cex=1, pch = pchs,
     xlab=paste("PC1 (",round(PCA$Variance[1,2],2),"%)"),
     ylab=paste("PC2 (",round(PCA$Variance[2,2],2),"%)"),
     cex.lab=1,cex.axis=1)
title (main="UC (radicular dentine)", font.main= 1,adj = 0, cex.main = 1.2)
legend("topright", legend = c("MH", "NE"), col = c("orange", "darkblue"), pch = c(16,17), cex = 0.8)
abline(v=0,h=0,col="black",lwd=2,lty=3)

hpts1 <- chull(PCA$PCscores[which(otu=="MH"),1:2])
hpts1 <- c(hpts1, hpts1[1])
polygon(PCA$PCscores[which(otu=="MH")[hpts1],1:2 ], col = adjustcolor("orange", 0.3), border = NA)

hpts2 <- chull(PCA$PCscores[which(otu=="NE"),c(1:2)])
hpts2 <- c(hpts2, hpts2[1])
polygon(PCA$PCscores[which(otu=="NE")[hpts2], ], col = adjustcolor("darkblue", 0.3), border = NA)

PC1min<-ToothVariations(PCA,min(PCA$PCscores[,1]),PCA$PCs[,1],asp=0.5,meanmap = FALSE)
PC1max<-ToothVariations(PCA,max(PCA$PCscores[,1]),PCA$PCs[,1],asp=0.5,meanmap = FALSE)

### Example on the upper lateral incisor (root)
data("UI2root")
require(morphomap)
shapeList<-UI2root
PCA<-ToothPCA(shapeList,gamMap = FALSE,scaleThick = TRUE,scalePCA = TRUE,relThick = FALSE)
otu<-substr(names(UI2root),1,2)
pchs <- ifelse(otu == "MH", 16, 17)
cols <- ifelse(otu == "MH", "orange", "darkblue")

plot(PCA$PCscores,col=cols,cex=1, pch = pchs,
     xlab=paste("PC1 (",round(PCA$Variance[1,2],2),"%)"),
     ylab=paste("PC2 (",round(PCA$Variance[2,2],2),"%)"),
     cex.lab=1,cex.axis=1)
title (main="UC (radicular dentine)", font.main= 1,adj = 0, cex.main = 1.2)
legend("topright", legend = c("MH", "NE"), col = c("orange", "darkblue"), pch = c(16,17), cex = 0.8)
abline(v=0,h=0,col="black",lwd=2,lty=3)

hpts1 <- chull(PCA$PCscores[which(otu=="MH"),1:2])
hpts1 <- c(hpts1, hpts1[1])
polygon(PCA$PCscores[which(otu=="MH")[hpts1],1:2 ], col = adjustcolor("orange", 0.3), border = NA)

hpts2 <- chull(PCA$PCscores[which(otu=="NE"),c(1:2)])
hpts2 <- c(hpts2, hpts2[1])
polygon(PCA$PCscores[which(otu=="NE")[hpts2], ], col = adjustcolor("darkblue", 0.3), border = NA)

PC1min<-ToothVariations(PCA,min(PCA$PCscores[,1]),PCA$PCs[,1],asp=0.5,meanmap = FALSE)
PC1max<-ToothVariations(PCA,max(PCA$PCscores[,1]),PCA$PCs[,1],asp=0.5,meanmap = FALSE)