R: ToothPCA

ToothPCA {Toothnroll}

R Documentation

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
)

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

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

Author(s)

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)
 
#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)

[Package Toothnroll version 1.11 Index]