MorphoTools2
Multivariate Morphometric Analysis

Package index
Search the MorphoTools2 package
Vignettes
Functions
203
Source code
110
Man pages
45
Home
/
CRAN
/
MorphoTools2
/
inst/doc/MorphoTools2_tutorial.R

inst/doc/MorphoTools2_tutorial.R
In MorphoTools2: Multivariate Morphometric Analysis 

## ---- eval=TRUE, include = FALSE----------------------------------------------
knitr::opts_chunk$set(
  dev="pdf",
  highlight = TRUE,
  dpi = 1,
  collapse = TRUE,
  comment = "#>",
  rownames = FALSE, 
  #fig.width   = 6,      
  #fig.height  = 5,      
  # fig.path    = 'figs/', 
  fig.align   = 'center'
  #out.width='\\textwidth'
  )
old.par <- par(no.readonly = TRUE)  

## ----eval=FALSE, include=TRUE-------------------------------------------------
#  install.packages("MorphoTools2")
#  library("MorphoTools2")
#  

## ----include=FALSE, eval=TRUE-------------------------------------------------
library(MorphoTools2)

## ----include=TRUE, eval=FALSE-------------------------------------------------
#  install.packages("devtools")
#  devtools::install_github("MarekSlenker/MorphoTools2")

## ----eval = TRUE, echo = TRUE-------------------------------------------------
data(centaurea)

## ----eval = FALSE, echo = TRUE------------------------------------------------
#  centaurea = read.morphodata(file = "<PATH>/centaurea.txt", dec = ".", sep = "\t")
#  centaurea = read.morphodata(file = "clipboard")

## ----echo = FALSE, eval = TRUE------------------------------------------------
summary<-function(object){
  cat("Object of class \'morphodata\'\
- contains 33 populations
- contains 4 taxa (defined groups)

Populations: BABL, BABU, BOL, BRT, BUK, CERM, CERV, CZLE, DEB, DOM, DUB, HVLT, KASH,
 KOT, KOZH, KRO, LES, LIP, MIL, NEJ, NSED, OLE1, OLE2, PREL, PRIS, PROS, RTE, RUS,
 SOK, STCV, STGH, VIT, VOL
Taxa (defined groups): hybr, ph, ps, st\n")
}

## ----echo = TRUE, eval=TRUE, collapse=TRUE------------------------------------
summary(centaurea)

## ----echo = FALSE, eval = TRUE------------------------------------------------
rm(summary)

## ----include=F----------------------------------------------------------------
options(max.print = 78)

## ----echo = TRUE, eval=TRUE---------------------------------------------------
samples(centaurea)

## ----echo = TRUE, eval=TRUE---------------------------------------------------
populations(centaurea)

## ----echo = TRUE, eval=TRUE---------------------------------------------------
taxa(centaurea)

## ----echo = TRUE, eval=TRUE---------------------------------------------------
characters(centaurea)

## ----echo = TRUE, eval=FALSE--------------------------------------------------
#  viewMorphodata(centaurea)

## ----include=F----------------------------------------------------------------
options(max.print = 28)

## ----echo = TRUE, eval=TRUE---------------------------------------------------
shapiroWilkTest(centaurea)


## ----echo = TRUE, eval=FALSE--------------------------------------------------
#  swTest = shapiroWilkTest(centaurea)
#  exportRes(swTest, file = "clipboard")
#  exportRes(swTest, file = "D:/Projects/Centaurea/morpho/shapiroWilkTest.txt")

## ----histCharacter, echo = TRUE, eval=TRUE, out.width = '320px'---------------
histCharacter(centaurea, character = "SF")

## ----echo = TRUE, eval=FALSE--------------------------------------------------
#  histAll(centaurea, folderName = "histograms")

## ----qqnormCharacter, echo = TRUE, eval=TRUE, out.width = '320px', out.height= '300px'----
qqnormCharacter(centaurea, character = "SF")

## ----echo = TRUE, eval=FALSE--------------------------------------------------
#  qqnormAll(centaurea, folderName = "qqnormPlots")

## ----transformations, echo = FALSE, eval=TRUE, out.width = '320px', out.height= '300px'----

par(mfrow=c(2,2))
par(mar=c(4,4,2,1))
par(mgp=c(2,0.8,0))

centSquareRoot = transformCharacter(centaurea, character = "SF", FUN = sqrt)
centLog = transformCharacter(centaurea, character = "SF", FUN = function(x) log(x+1))
centCubeRoot = transformCharacter(centaurea, character = "SF", FUN = function(x) x^(1/3))



stats::qqnorm(as.matrix( na.omit(centaurea$data["SF"])), main = "original data", cex = 0.9, bty="n")
stats::qqline(as.matrix( na.omit(centaurea$data["SF"])), lwd=2)


stats::qqnorm(as.matrix( na.omit(centSquareRoot$data["SF"])), main = "sqrt transformed", cex = 0.9, bty="n")
stats::qqline(as.matrix( na.omit(centSquareRoot$data["SF"])), lwd=2)

stats::qqnorm(as.matrix( na.omit(centLog$data["SF"])), main = "log(x+1) transformed",cex = 0.9, bty="n")
stats::qqline(as.matrix( na.omit(centLog$data["SF"])), lwd=2)

stats::qqnorm(as.matrix( na.omit(centCubeRoot$data["SF"])), main = "x^(1/3) transformed", cex = 0.9, bty="n")
stats::qqline(as.matrix( na.omit(centCubeRoot$data["SF"])), lwd=2)



## ----echo = TRUE, eval = FALSE------------------------------------------------
#  centaurea = transformCharacter(centaurea, character = "SF", newName = "SF.sqrt",
#                                 FUN = function(x) sqrt(x))

## ----echo = TRUE, eval=FALSE--------------------------------------------------
#  boxplotCharacter(centaurea, character="AL", col=c("blue","green","red","orange"))

## ----boxplotCharacter1, echo = FALSE, eval=TRUE, fig.width= 5, fig.height=3----
graphics::par(mar=c(3, 4.1, 1.8, 2.1), mgp=c(1.7, 0.6, 0), cex.axis=0.8, cex.lab=0.8, lwd=0.9)
boxplotCharacter(centaurea, character = "AL", col = c("blue","green","red","orange"), cex.main=1.3)


## ----echo = TRUE, eval=FALSE--------------------------------------------------
#  boxplotCharacter(centaurea, character = "AL", pch = 1,
#                   lowerWhisker = 0.1, upperWhisker = 1)

## ----boxplotCharacter2, echo = FALSE, eval=TRUE, fig.width= 5, fig.height=3----
graphics::par(mar=c(3, 4.1, 1.8, 2.1), mgp=c(1.7, 0.6, 0), cex.axis=0.8, cex.lab=0.8, lwd=0.9)
boxplotCharacter(centaurea, character = "AL", pch = 1, cex.main=1.3,
                 lowerWhisker = 0.1, upperWhisker = 1)
                 

## ----echo = TRUE, eval=FALSE--------------------------------------------------
#  boxplotCharacter(centaurea, character = "AL", outliers = FALSE,
#                   frame = FALSE, horizontal = T, notch = TRUE)

## ----boxplotCharacter3, echo = FALSE, eval=TRUE, fig.width= 5, fig.height=3----
graphics::par(mar=c(3, 4.1, 1.8, 2.1), mgp=c(1.7, 0.6, 0), cex.axis=0.8, cex.lab=0.8, lwd=0.9)
boxplotCharacter(centaurea, character = "AL", outliers = FALSE,cex.main=1.3,
                 frame = FALSE, horizontal = T, notch = TRUE)
                 

## ----echo = TRUE, eval=FALSE--------------------------------------------------
#  boxplotAll(centaurea, folderName = "boxplots")

## ----include=F----------------------------------------------------------------
options(max.print = 36)

## ----echo = TRUE, eval=TRUE---------------------------------------------------
descrTaxon(centaurea, format = "($MEAN ± $SD)", decimalPlaces = 2)

## ----eval=FALSE, include=TRUE-------------------------------------------------
#  descrTax = descrTaxon(centaurea, format = "($MEAN ± $SD)", decimalPlaces = 2)
#  
#  exportRes(descrTax, file = "clipboard")
#  exportRes(descrTax, file = "descrTax.txt")

## ----echo = TRUE, eval=FALSE--------------------------------------------------
#  correlations.s = cormat(centaurea, method = "spearman")
#  exportRes(correlations.s, file = "correlations.spearman.txt")

## ----echo = TRUE, eval=FALSE--------------------------------------------------
#  correlations.s.signifTest = cormatSignifTest(centaurea, method = "spearman")

## ----echo = FALSE, eval = TRUE------------------------------------------------
populOTU <-function(object, crossval="indiv"){
cat("Warning: Unable to calculate the means of characters AL AW ALW AP in
populations LIP PREL. Values are NA.")
}

## ----echo = TRUE, eval=TRUE---------------------------------------------------
pops = populOTU(centaurea)

## ----echo = FALSE, eval = TRUE------------------------------------------------
rm(populOTU)

## ----echo = FALSE, eval=TRUE--------------------------------------------------
pops = suppressWarnings(populOTU(centaurea))

## ----include = FALSE----------------------------------------------------------
options(max.print = 800)
centaurea = removePopulation(centaurea, populationName = c("BRT", "CERV", "HVLT", "KASH", "KRO", "MIL", "NSED", "CERM", "BABL", "OLE1", "OLE2", "PRIS", "PROS", "SOK", "STGH"))
# centaurea = removeCharacter(centaurea, characterName = c("SF", "ST", "IW", "ILW", "MW", "MLW", "AL", "ALW"))

## ----echo = TRUE, eval=TRUE---------------------------------------------------
# For demonstration only. Not all populations are displayed.
missingCharactersTable(centaurea, level = "pop")

## ----include = FALSE----------------------------------------------------------
centaurea$data = centaurea$data[-seq(4,10,1)]
centaurea = removeCharacter(centaurea, characterName = c("SF", "ST", "IW", "ILW", "MW", "MLW", "AL", "ALW", "AW", "IL"))

## ----echo = TRUE, eval = TRUE-------------------------------------------------
# For demonstration purposes only. Only a subset of data is displayed.
missingSamplesTable(centaurea, level = "pop")

## ----include = FALSE----------------------------------------------------------
data("centaurea")
options(max.print = 60)

## ----echo = TRUE, eval=TRUE---------------------------------------------------
centaurea = removePopulation(centaurea, populationName = c("LIP", "PREL"))
pops = removePopulation(pops, populationName = c("LIP", "PREL"))

## ----echo = TRUE, eval=FALSE--------------------------------------------------
#  centaurea = naMeanSubst(centaurea)

## ----include = FALSE----------------------------------------------------------
centaurea = suppressWarnings(naMeanSubst(centaurea))


## ----echo = TRUE, eval=FALSE--------------------------------------------------
#  hierClust = clust(pops, distMethod = "Euclidean", clustMethod = "UPGMA")
#  plot(hierClust, hang = -1, sub = "", xlab = "", ylab = "distance")

## ----hierClust, echo = FALSE, eval=TRUE, fig.width= 5, fig.height=3-----------
graphics::par(mar=c(3, 4.1, 1.5, 2.1), mgp=c(1.7, 0.6, 0), cex.axis=0.8, cex.lab=0.8, lwd=0.9)
hierClust = clust(pops, distMethod = "Euclidean", clustMethod = "UPGMA")
plot(hierClust, hang = -1, sub = "", xlab = "", ylab = "distance", cex=0.6, cex.main=1)


## ----echo = TRUE, eval=TRUE---------------------------------------------------
pca.centaurea = pca.calc(centaurea)

## ----include=F----------------------------------------------------------------
options(max.print = 64)

## ----echo = TRUE, eval=TRUE---------------------------------------------------
summary(pca.centaurea)

## ----echo = TRUE, eval=FALSE--------------------------------------------------
#  plotPoints(pca.centaurea, col = c("blue","green","red","orange"), axes=c(1,2),
#             pch = c(8,17,20,18), legend = T, ncol = 2, legend.pos="bottomright")
#  

## ----pca.centaurea1, echo = FALSE, eval=TRUE, fig.width= 5, fig.height=3------
graphics::par(mar=c(3, 4.1, 0, 2.1), mgp=c(1.7, 0.6, 0), cex.axis=0.8, cex.lab=0.8, lwd=0.9)
plotPoints(pca.centaurea, col = c("blue","green","red","orange"), axes=c(1,2), cex = 0.9,
           pch = c(8,17,20,18))
plotAddLegend(pca.centaurea, col = c("blue","green","red","orange"), box.lwd = 0.9,
x = "bottomright", cex = 0.8, ncol = 2)


## ----echo = TRUE, eval=FALSE--------------------------------------------------
#  exportRes(pca.centaurea$objects$scores, file="scoresPCA.centaurea.txt")

## ----echo = TRUE, eval=FALSE--------------------------------------------------
#  plotCharacters(pca.centaurea)
#  

## ----plotCharacters.pca1, echo = FALSE, eval=TRUE, fig.width= 3.8, fig.height=3.3----
graphics::par(mar=c(3, 4.1, 2, 2.1), mgp=c(1.7, 0.6, 0), cex.axis=0.8, cex.lab=0.8, lwd=0.9)
plotCharacters(pca.centaurea, cex = 0.5, xlim=c(-0.5, 0.5),ylim=c(-0.5, 0.5), cex.main=0.9)


## ----echo = TRUE, eval=FALSE--------------------------------------------------
#  exportRes(pca.centaurea$eigenvectors, file="eigenvectors.centaurea.txt")

## ----echo = TRUE, eval=FALSE--------------------------------------------------
#  pca.pops = pca.calc(pops)
#  plotPoints(pca.pops, col = c("blue","green","red","orange"), pch=c(8,17,20,18),
#              legend = FALSE, labels = FALSE)
#  plotAddLabels.points(pca.pops, labels=c("PROS","SOK","KASH","BOL","KRO","DUB",
#            "MIL","CERM","DOM","KOZH","KOT"), include=FALSE, pos=4, cex=0.7)
#  plotAddLabels.points(pca.pops, labels=c("PROS","SOK","KASH","BOL","CERM","DOM"),
#                        pos = 2, cex = 0.7)

## ----pca.pops1, echo = FALSE, eval=TRUE, fig.width= 5, fig.height=3-----------
graphics::par(mar=c(3, 4.1, 0, 2.1), mgp=c(1.7, 0.6, 0), cex.axis=0.8, cex.lab=0.8, lwd=0.9)
pca.pops = pca.calc(pops)
plotPoints(pca.pops, col = c("blue","green","red","orange"), pch=c(8,17,20,18), 
            legend = FALSE, labels = FALSE)
plotAddLabels.points(pca.pops, labels=c("PROS","SOK","KASH","BOL","KRO","DUB",
          "MIL","CERM","DOM","KOZH","KOT"), include=FALSE, pos=4, cex=0.7)
plotAddLabels.points(pca.pops, labels=c("PROS","SOK","KASH","BOL","CERM","DOM"), 
                      pos = 2, cex = 0.75)
                      

## ----echo = TRUE, eval=FALSE--------------------------------------------------
#  plotCharacters(pca.pops, labels = FALSE)
#  plotAddLabels.characters(pca.pops,labels=c("ILW","MLW","LBA"),pos=4,cex=0.75)
#  plotAddLabels.characters(pca.pops,labels=c("IW","SFT"),pos=2,offset=0.7)

## ----pca.pops.characters, echo = FALSE, eval=TRUE, fig.width= 3.8, fig.height=3.3----
graphics::par(mar=c(3, 4.1, 2, 2.1), mgp=c(1.7, 0.6, 0), cex.axis=0.8, cex.lab=0.8, lwd=0.9)
plotCharacters(pca.pops, labels = FALSE, cex = 0.5, xlim=c(-0.5, 0.5),ylim=c(-0.5, 0.5), cex.main=0.9)

plotAddLabels.characters(pca.pops,labels=c("ILW","MLW","LBA"),pos=4,cex=0.75)
plotAddLabels.characters(pca.pops,labels=c("IW","SFT"),pos=2,offset=0.7)


## ----echo = TRUE, eval=FALSE--------------------------------------------------
#  plotPoints(pca.centaurea, col = c("blue","green","red","orange"), cex = 0.5)
#  plotAddLegend(pca.centaurea, col = c("blue","green","red","orange"),
#                 x = "bottomright", cex = 0.8, box.type = "n", ncol = 2)
#  
#  # Semi-transparent spiders
#  plotAddSpiders(pca.centaurea, col=c(rgb(0,0,255, max=255, alpha=50), # blue
#                                      rgb(0,255,0, max=255, alpha=50), # green
#                                      rgb(255,0,0, max=255, alpha=50), # red
#                                      # orange
#                                      rgb(255,102,0, max=255, alpha=50)))

## ----pca.spiders1, echo = FALSE, eval=TRUE, fig.width= 5, fig.height=3--------
graphics::par(mar=c(3, 4.1, 0, 2.1), mgp=c(1.7, 0.6, 0), cex.axis=0.8, cex.lab=0.8, lwd=0.9)

plotPoints(pca.centaurea, col = c("blue","green","red","orange"), cex = 0.5)
plotAddLegend(pca.centaurea, col = c("blue","green","red","orange"), 
               x = "bottomright", cex = 0.8, box.type = "n", ncol = 2)

# Semi-transparent spiders
plotAddSpiders(pca.centaurea, col=c(rgb(0,0,255, max=255, alpha=50), # blue
                                    rgb(0,255,0, max=255, alpha=50), # green
                                    rgb(255,0,0, max=255, alpha=50), # red
                                    rgb(255,102,0, max=255, alpha=50))) # orange


## ----echo = TRUE, eval=FALSE--------------------------------------------------
#  plotPoints(pca.centaurea, col = c("blue","green","red","orange"), cex = 0.5)
#  
#  plotAddSpiders(pca.centaurea, col=c(NA,NA,NA,rgb(255,102,0,max=255,alpha=100)))

## ----pca.spiders2, echo = FALSE, eval=TRUE, fig.width= 5, fig.height=3--------
graphics::par(mar=c(3, 4.1, 0, 2.1), mgp=c(1.7, 0.6, 0), cex.axis=0.8, cex.lab=0.8, lwd=0.9)
plotPoints(pca.centaurea, col = c("blue","green","red","orange"), cex = 0.5)

plotAddSpiders(pca.centaurea, col=c(NA,NA,NA,rgb(255,102,0,max=255,alpha=100)))


## ----echo = TRUE, eval=FALSE--------------------------------------------------
#  plotPoints(pca.centaurea, col = c("blue","green","red","orange"), cex = 0.7)
#  plotAddLegend(pca.centaurea, col = c("blue","green","red","orange"),
#                 x = "bottomright", pt.cex = 1.3, box.type = "n", ncol = 2)
#  
#  plotAddEllipses(pca.centaurea, col = c("blue","green","red","orange"), lwd = 2)

## ----pca.ellipses, echo = FALSE, eval=TRUE, fig.width= 5, fig.height=3--------
graphics::par(mar=c(3, 4.1, 0, 2.1), mgp=c(1.7, 0.6, 0), cex.axis=0.8, cex.lab=0.8, lwd=0.9)
plotPoints(pca.centaurea, col = c("blue","green","red","orange"), cex = 0.7)
plotAddLegend(pca.centaurea, col = c("blue","green","red","orange"), 
               x = "bottomright", cex = 0.7, pt.cex = 1.3, box.type = "n", ncol = 2)


plotAddEllipses(pca.centaurea, col = c("blue","green","red","orange"), lwd = 2)


## ----echo = TRUE, eval=FALSE--------------------------------------------------
#  plotPoints(pca.centaurea, type = "n", xlim = c(-5,7.5), ylim = c(-5,4))
#  
#  plotAddEllipses(pca.centaurea, col = c("blue","green","red","orange"), lwd = 2)
#  
#  plotAddLegend(pca.centaurea, col = c("blue","green","red","orange"),
#                         x = "bottomright", box.type = "n", ncol = 2)

## ----pca.legend, echo = FALSE, eval=TRUE, fig.width= 5, fig.height=3----------
graphics::par(mar=c(3, 4.1, 0, 2.1), mgp=c(1.7, 0.6, 0), cex.axis=0.8, cex.lab=0.8, lwd=0.9)
plotPoints(pca.centaurea, type = "n", xlim = c(-5,7.5), ylim = c(-5,4))

plotAddEllipses(pca.centaurea, col = c("blue","green","red","orange"), lwd = 2)

plotAddLegend(pca.centaurea, col = c("blue","green","red","orange"), 
              x = "bottomright", pt.cex = 0.8, cex = 0.8, box.type = "n", ncol = 2)
              

## ----echo = TRUE, eval=FALSE--------------------------------------------------
#  plot3Dpoints(pca.centaurea, col = c("blue","green","red","orange"),
#               phi = 20, theta = 30)

## ----pca.3D, echo = FALSE, eval=TRUE, fig.width= 5, fig.height=3--------------
graphics::par(mar=c(3, 4.1, 0, 2.1), mgp=c(1.7, 0.6, 0), cex.axis=0.8, cex.lab=0.8, lwd=0.9)
plot3Dpoints(pca.centaurea, col = c("blue","green","red","orange"), cex = 0.8,
             phi = 20, theta = 30)
             

## ----echo = TRUE, eval=FALSE--------------------------------------------------
#  plot3Dpoints(pca.pops, col = c("blue","green","red","orange"), labels = T)

## ----pca.3D2, echo = FALSE, eval=TRUE, fig.width= 5, fig.height=3-------------
graphics::par(mar=c(3, 4.1, 0, 2.1), mgp=c(1.7, 0.6, 0), cex.axis=0.8, cex.lab=0.8, lwd=0.9)
plot3Dpoints(pca.pops, col = c("blue","green","red","orange"), labels = T, cex = 0.8)


## ----echo = FALSE, eval=TRUE--------------------------------------------------
summary.pcoadata <- function(object) {

  cat("Object of class 'pcoadata'; storing results of principal coordinates analysis\n")
  cat("Resemblance coefficient: ", object$distMethod,"\n")
  cat("\nVariation explained by individual axes")
  if (object$rank>3) {
    cat(" (listing of axes is truncated):\n")
  } else {
    cat(":\n")
  }

  descrTable = data.frame(row.names = names(object$eigenvaluesAsPercentages[1: min(object$rank, 3)]),
                          "Eigenvalues" = round(object$eigenvalues[1: min(object$rank, 3)], digits = 4),
                          "Eigenvalues as percentages" = round(object$eigenvaluesAsPercentages[1: min(object$rank, 3)], digits = 4),
                          "Cumulative percentage of eigenvalues" = round(object$cumulativePercentageOfEigenvalues[1: min(object$rank, 3)], digits = 4)
  )
  names(descrTable) = gsub(pattern = '\\.' , replacement = " ", x = names(descrTable))
  descrTable = t(descrTable)

  print(descrTable)
}

## ----echo = TRUE, eval=TRUE---------------------------------------------------
pcoa.res = pcoa.calc(centaurea, distMethod = "Manhattan")
summary(pcoa.res)

## ----echo = TRUE, eval=FALSE--------------------------------------------------
#  plot3Dpoints(pcoa.res, col = c("blue","green","red","orange"), pch = c(8,17,20,18),
#               phi = 20, theta = 70, legend = T)

## ----pcoa.3d, echo = FALSE, eval=TRUE, fig.width= 5, fig.height=3-------------
graphics::par(mar=c(3, 4.1, 0, 2.1), mgp=c(1.7, 0.6, 0), cex.axis=0.8, cex.lab=0.8, lwd=0.9)
plot3Dpoints(pcoa.res, col = c("blue","green","red","orange"), pch = c(8,17,20,18), 
             phi = 20, theta = 70, legend = F)
plotAddLegend(pca.centaurea, col = c("blue","green","red","orange"), box.lwd = 0.9,
              x = "topright", cex = 0.8)


## ----echo = TRUE, eval=TRUE, out.width = '320px'------------------------------
nmds.res = nmds.calc(centaurea, distMethod = "Euclidean", k = 3)
summary(nmds.res)

## ----echo = TRUE, eval=FALSE--------------------------------------------------
#  plotPoints(nmds.res, col = c("blue","green","red","orange"), pch=c(8,17,20,18))

## ----nmds, echo = FALSE, eval=TRUE, fig.width= 5, fig.height=2.7--------------
graphics::par(mar=c(2.8, 4.1, 0, 2.1), mgp=c(1.7, 0.6, 0), cex.axis=0.8, cex.lab=0.8, lwd=0.9)
plotPoints(nmds.res, col = c("blue","green","red","orange"), pch = c(8,17,20,18))


## ----include=F----------------------------------------------------------------
options(max.print = 260)

## ----echo = TRUE, eval=TRUE---------------------------------------------------
stepdisc.calc(centaurea)

## ----include=F----------------------------------------------------------------
options(max.print = 60)


## ----include=F----------------------------------------------------------------
options(max.print = 34)


## ----echo = TRUE, eval=TRUE, out.width = '320px'------------------------------
cda.centaurea = cda.calc(centaurea)

summary(cda.centaurea)

## ----echo=TRUE, eval=FALSE----------------------------------------------------
#  plotPoints(cda.centaurea, col = c("blue","green","red","orange"), axes = c(1, 2),
#             pch = c(8,17,20,18), legend = T, ncol = 2, legend.pos="bottomright")

## ----cda.points1, echo = FALSE, eval=TRUE, fig.width= 5, fig.height=3---------
graphics::par(mar=c(3, 4.1, 0, 2.1), mgp=c(1.7, 0.6, 0), cex.axis=0.8, cex.lab=0.8, lwd=0.9)
plotPoints(cda.centaurea, col = c("blue","green","red","orange"), axes = c(1, 2),
           pch = c(8,17,20,18), legend = F)
plotAddLegend(cda.centaurea, col = c("blue","green","red","orange"), box.lwd = 0.9,
              x = "bottomright", cex = 0.8, ncol = 2)

## ----echo = TRUE, eval=FALSE--------------------------------------------------
#  plotPoints(cda.centaurea, col = c(NA, "green", NA, NA), cex = 0.8)
#  plotAddSpiders(cda.centaurea, col = c(rgb(0,0,255,max=255,alpha=130), # blue
#                                        NA, # green
#                                        rgb(255,0,0,max=255,alpha=130), # red
#                                        rgb(255,102,0,max=255,alpha=130))) # orange

## ----cda.points.spiders, echo = FALSE, eval=TRUE, fig.width= 5, fig.height=3----
graphics::par(mar=c(3, 4.1, 0, 2.1), mgp=c(1.7, 0.6, 0), cex.axis=0.8, cex.lab=0.8, lwd=0.9)
plotPoints(cda.centaurea, col = c(NA, "green", NA, NA), cex = 0.8)
plotAddSpiders(cda.centaurea, col = c(rgb(0,0,255,max=255,alpha=130), # blue
                                      NA, # green
                                      rgb(255,0,0,max=255,alpha=130), # red
                                      rgb(255,102,0,max=255,alpha=130))) # orange

## ----echo = TRUE, eval=FALSE--------------------------------------------------
#  plotPoints(cda.centaurea, col = c(NA, "green", NA, NA), cex = 0.8)
#  plotAddEllipses(cda.centaurea, col = c("blue", NA, "red", "orange"), lwd = 2)
#  

## ----cda.points.ellipses, echo = FALSE, eval=TRUE, fig.width= 5, fig.height=3----
graphics::par(mar=c(3, 4.1, 0, 2.1), mgp=c(1.7, 0.6, 0), cex.axis=0.8, cex.lab=0.8, lwd=0.9)
plotPoints(cda.centaurea, col = c(NA, "green", NA, NA), cex = 0.8)
plotAddEllipses(cda.centaurea, col = c("blue", NA, "red", "orange"), lwd = 2)


## ----echo = TRUE, eval=FALSE--------------------------------------------------
#  plotPoints(cda.centaurea, col = c("blue","green","red","orange"), cex = 0.4)
#  plotAddEllipses(cda.centaurea, col = c("blue","green","red","orange"), lwd = 2)
#  plotAddSpiders(cda.centaurea, col = c(rgb(0,0,255,max=255,alpha=130), # blue
#                                        rgb(0,255,0,max=255,alpha=130), # green
#                                        rgb(255,0,0,max=255,alpha=130), # red
#                                        rgb(255,102,0,max=255,alpha=130))) # orange

## ----cda.points.ellipses2, echo = FALSE, eval=TRUE, fig.width= 5, fig.height=3----
graphics::par(mar=c(3, 4.1, 0, 2.1), mgp=c(1.7, 0.6, 0), cex.axis=0.8, cex.lab=0.8, lwd=0.9)
plotPoints(cda.centaurea, col = c("blue","green","red","orange"), cex = 0.4)
plotAddEllipses(cda.centaurea, col = c("blue","green","red","orange"), lwd = 2)
plotAddSpiders(cda.centaurea, col = c(rgb(0,0,255,max=255,alpha=130), # blue
                                      rgb(0,255,0,max=255,alpha=130), # green
                                      rgb(255,0,0,max=255,alpha=130), # red
                                      rgb(255,102,0,max=255,alpha=130))) # orange

## ----echo = TRUE, eval=FALSE--------------------------------------------------
#  plotCharacters(cda.centaurea, cex = 1.2)

## ----cad.characters, echo = FALSE, eval=TRUE, fig.width= 3.8, fig.height=3.3----
graphics::par(mar=c(3, 4.1, 2, 2.1), mgp=c(1.7, 0.6, 0), cex.axis=0.8, cex.lab=0.8, lwd=0.9)
plotCharacters(cda.centaurea, cex = 0.7, xlim=c(-1, 1),ylim=c(-1, 1), cex.main=0.9)

## ----include=F----------------------------------------------------------------
options(max.print = 100)

## ----echo = TRUE, eval=FALSE--------------------------------------------------
#  exportRes(cda.centaurea$totalCanonicalStructure, file = "centaurea_TCS.txt")

## ----echo = FALSE , eval=TRUE-------------------------------------------------
cda.centaurea$totalCanonicalStructure = cda.centaurea$totalCanonicalStructure[c(1,2,3,6,11,13,14,16, 17, 18,21,24,25),]

## ----echo = TRUE, eval=TRUE---------------------------------------------------
# For demonstration purposes only. Only a subset of data is displayed.
cda.centaurea$totalCanonicalStructure


## ----echo = TRUE, eval=FALSE--------------------------------------------------
#  plot3Dpoints(cda.centaurea, col = c("blue","green","red","orange"),
#                              phi = 12, theta = 25)

## ----cda.3D, echo = FALSE, eval=TRUE, fig.width= 5, fig.height=3--------------
graphics::par(mar=c(3, 4.1, 0, 2.1), mgp=c(1.7, 0.6, 0), cex.axis=0.8, cex.lab=0.8, lwd=0.9)
plot3Dpoints(cda.centaurea, col = c("blue","green","red","orange"), phi = 12, theta = 25)

## ----echo = TRUE, eval=TRUE, out.width = '320px'------------------------------
stPsHybr = removeTaxon(centaurea, taxonName = "ph")
cda.stPsHybr = cda.calc(stPsHybr)

## ----echo = TRUE, eval=FALSE--------------------------------------------------
#  plotPoints(cda.stPsHybr, col = c("blue","red","orange"), pch = c(8,20,18),
#              legend = T, ncol = 2, legend.pos="bottomright")

## ----cda.stPsHybr1, echo = FALSE, eval=TRUE, fig.width= 5, fig.height=3-------
graphics::par(mar=c(3, 4.1, 0, 2.1), mgp=c(1.7, 0.6, 0), cex.axis=0.8, cex.lab=0.8, lwd=0.9)
plotPoints(cda.stPsHybr, col = c("blue","red","orange"), pch = c(8,20,18), 
            legend = F)
plotAddLegend(cda.stPsHybr, col = c("blue","red","orange"), box.lwd = 0.9,
              x = "bottomright", cex = 0.75, ncol = 2)

## ----echo = TRUE, eval=TRUE---------------------------------------------------
cda.stPsHybr$totalCanonicalStructure

## ----echo = TRUE, eval=FALSE--------------------------------------------------
#  
#  cda.stPs_passiveHybr = cda.calc(stPsHybr, passiveSamples = "hybr")
#  
#  plotPoints(cda.stPs_passiveHybr, legend = T, breaks = 0.2,
#                  col = c(rgb(0,0,255, alpha=255, max=255), # blue
#                          rgb(255,0,0, alpha=160, max=255), # red
#                          rgb(255,102,0, alpha=160, max=255))) # orange,

## ----cda.stPsHybr2, echo = FALSE, eval=TRUE, fig.width= 5, fig.height=3-------
graphics::par(mar=c(3, 4.1, 0, 2.1), mgp=c(1.7, 0.6, 0), cex.axis=0.8, cex.lab=0.8, lwd=0.9)

cda.stPs_passiveHybr = cda.calc(stPsHybr, passiveSamples = "hybr")

plotPoints(cda.stPs_passiveHybr, legend = F, breaks = 0.2,
                col = c(rgb(0,0,255, alpha=255, max=255), # blue
                        rgb(255,0,0, alpha=160, max=255), # red
                        rgb(255,102,0, alpha=160, max=255))) # orange, 
plotAddLegend(cda.stPs_passiveHybr, pch = 22, col = "black", box.lwd = 0.9, pt.bg= c("blue","red","orange"),
              x = "topright", cex = 0.8, ncol = 1)

## ----echo = TRUE, eval=FALSE--------------------------------------------------
#  plotPoints(cda.stPs_passiveHybr, breaks = 0.2,
#                  col = c(rgb(0,0,0, alpha=255, max=255), # hybr - black
#                          rgb(255,255,255, alpha=80, max=255), # ps - white
#                          rgb(255,255,255, alpha=80, max=255))) # st - white

## ----cda.stPsHybr3, echo = FALSE, eval=TRUE, fig.width= 5, fig.height=3-------
graphics::par(mar=c(3, 4.1, 0, 2.1), mgp=c(1.7, 0.6, 0), cex.axis=0.8, cex.lab=0.8, lwd=0.9)
plotPoints(cda.stPs_passiveHybr, breaks = 0.2,
                col = c(rgb(0,0,0, alpha=255, max=255), # hybr - black
                        rgb(255,255,255, alpha=80, max=255), # ps - white
                        rgb(255,255,255, alpha=80, max=255))) # st - white 

## ----include=F----------------------------------------------------------------
options(max.print = 460)

## ----echo = TRUE, eval=TRUE---------------------------------------------------
stepdisc.calc(centaurea)

partialCent = keepCharacter(centaurea, c("MLW", "ML", "IW", "LS", "IV",
                          "MW", "MF", "AP", "IS", "LBA", "LW", "AL", "ILW",
                          "LBS","SFT", "CG", "IL", "LM", "ALW", "AW", "SF"))

descrTaxon(partialCent, format = "$SD")

partialCent$data[ partialCent$Taxon == "hybr", "LM" ][1] =
             partialCent$data[partialCent$Taxon=="hybr","LM"][1] + 0.000001
partialCent$data[ partialCent$Taxon == "ph", "IV" ][1] =
             partialCent$data[partialCent$Taxon=="ph","IV"][1] + 0.000001
partialCent$data[ partialCent$Taxon == "st", "LBS"][1] =
             partialCent$data[partialCent$Taxon=="st","LBS"][1] + 0.000001

## ----echo = TRUE, eval=TRUE---------------------------------------------------
boxMTest(partialCent)


## ----echo = TRUE, eval=TRUE---------------------------------------------------
classifRes.lda = classif.lda(partialCent)

## ----include=F----------------------------------------------------------------
options(max.print = 185)

## ----echo = TRUE, eval=TRUE---------------------------------------------------
summary(classifRes.lda)

## ----echo = TRUE, eval=TRUE---------------------------------------------------
classif.matrix(classifRes.lda, level = "taxon")

## ----include=F----------------------------------------------------------------
options(max.print = 250)

## ----echo = TRUE, eval=TRUE---------------------------------------------------
classif.matrix(classifRes.lda, level = "pop")

## ----echo = TRUE, eval=TRUE---------------------------------------------------
classifRes.qda = classif.qda(partialCent)


classif.matrix(classifRes.qda, level = "taxon")

## ----echo = TRUE, eval=FALSE--------------------------------------------------
#  classif_qda = classif.matrix(classifRes.qda, level = "indiv")
#  
#  exportRes(object = classif_qda, file = "qda_classifMatrix.txt")

## ----echo = FALSE, eval = TRUE------------------------------------------------
knn.select<-function(object, crossval="indiv"){
  k = as.numeric(1:30)
  ksel = matrix(c(419,419,419,419,419,419,419,419,419,419,416,434,420,407,418,423,426,423,413,417,441,442,438,441,440,440,443,441,439,442,446,447,455,447,446,443,445,435,445,444,457,458,457,459,457,458,456,461,458,462,455,457,452,456,455,459,454,459,451,464,460,458,462,455,461,459,459,458,459,460,458,458,460,463,458,456,461,465,456,464,462,461,458,457,459,460,460,458,461,460,464,459,463,461,460,464,462,462,459,463,457,456,461,459,459,455,458,458,458,458,459,464,466,465,464,458,460,462,462,460,462,461,460,460,462,464,462,463,464,461,460,462,462,464,461,460,460,458,460,463,464,467,467,465,466,466,468,466,470,466,459,460,456,463,457,458,457,458,464,457,456,455,458,459,459,454,455,455,456,457,452,458,454,460,457,456,458,459,453,453,456,457,459,456,457,458,457,454,455,453,450,454,455,451,455,452,452,451,455,454,455,453,455,453,456,454,454,455,454,454,454,455,453,453,453,454,450,452,450,455,454,453,455,455,457,455,455,455,453,455,458,455,454,455,456,457,454,455,457,455,459,460,458,458,457,455,458,460,458,460,458,461,459,460,461,459,459,456,457,458,461,463,461,461,460,463,461,460,459,459,456,455,455,457,454,458,457,454,456,456,453,450,451,453,456,451,453,456,450,456,451,449,453,452,450,449,450,451,448,450), byrow = T, ncol = 10)
  
  ksel = t(ksel)
  
  for (j in seq(10,100,10))
  {
    cat("Tested ", j, "% of Ks \n")
  }
  
  kselmean = apply(ksel, MARGIN = 2, FUN = mean)
  kselmax = apply(ksel, MARGIN = 2, FUN = max)
  kselmin = apply(ksel, MARGIN = 2, FUN = min)
  graphics::plot(kselmean,type="p",pch=16,xlab="K",ylab="correct classifications", ylim=c(min(kselmin),max(kselmax)))

  sapply(k[-1],function(x) graphics::arrows(x, kselmin[x], x, kselmax[x], code = 3, angle = 90, length = 0.07))

  cat("\nThe highest number of correct classifications is at k = 15.\n")
}

## ----echo = TRUE, eval=FALSE--------------------------------------------------
#  knn.select(partialCent, crossval = "pop")

## ----knn, echo = FALSE, eval=TRUE, fig.width= 5, fig.height=3-----------------
graphics::par(mar=c(3, 4.1, 0.5, 2.1), mgp=c(1.7, 0.6, 0), cex.axis=0.8, cex.lab=0.8, lwd=0.9)
knn.select(partialCent, crossval = "pop")

## ----echo = TRUE, eval=TRUE---------------------------------------------------
classifRes.knn = classif.knn(partialCent, crossval = "pop", k = 15)

classif.matrix(classifRes.knn, level = "taxon")

## ----echo = TRUE, eval=FALSE--------------------------------------------------
#  popClassifMatrix = classif.matrix(classifRes.knn, level = "taxon")
#  
#  exportRes(popClassifMatrix, file = "clipboard")

## ----echo = TRUE, eval=TRUE---------------------------------------------------
trainingSet = removePopulation(partialCent, populationName = "LES")
typeSpecimen = keepSample(partialCent, "LES1116")

classifSample.lda(typeSpecimen, trainingSet)

classifSample.qda(typeSpecimen, trainingSet)

classifSample.knn(typeSpecimen, trainingSet, k = 4)


## ----echo = FALSE, eval=TRUE--------------------------------------------------
par(old.par)

Try the MorphoTools2 package in your browser

Any scripts or data that you put into this service are public.

MorphoTools2 documentation built on March 7, 2023, 6:18 p.m.

R Package Documentation

rdrr.io home R language documentation Run R code online

Browse R Packages

CRAN packages Bioconductor packages R-Forge packages GitHub packages

We want your feedback!

Note that we can't provide technical support on individual packages. You should contact the package authors for that.
GitHub issue tracker
ian@mutexlabs.com
Personal blog

 
Embedding an R snippet on your website

Add the following code to your website.

For more information on customizing the embed code, read Embedding Snippets.

Close