Fonctional anatomy of the inner and middle ear in Rodentia
mars 06, 2026
Data preparation
Load packages
library(readxl)
library(MASS)
library(phytools)
library(geomorph)
library(Morpho)Prepare the new data set
Load data set
Rodentia_IE <- read_excel("Rodentia_IE.xls")Separate Linnean name and specimen ID
spec <- strsplit(Rodentia_IE$Taxa, " ")
LinneanName <- rep(NA, length(spec))
SpecID <- rep(NA, length(spec))
for (i in 1:length(spec)) {
LinneanName[i] <- paste(spec[[i]][1], spec[[i]][2], sep = "_")
if (length(spec[[i]]) == 3) { SpecID[i] <- spec[[i]][3] }
if (length(spec[[i]]) == 4) { SpecID[i] <- spec[[i]][4] }
}Find variables with missing values
var_miss <- rep(F, ncol(Rodentia_IE))
for (i in 1:length(var_miss)){
if (anyNA(Rodentia_IE[, i]) == T) { var_miss[i] <- T }
}
colnames(Rodentia_IE)[which(var_miss == T)]## [1] "phylTree" "V_IE" "V_CO" "V_SCC" "V_ma" "V_in" "V_st"Find variables with zeros (only secondary common crus: length = 0 when absent)
var_null <- rep(F, ncol(Rodentia_IE))
for (i in 1:length(var_null)){
if (var_miss[i] == F) {
for (j in 1:nrow(Rodentia_IE)) {
if (Rodentia_IE[[i]][j] == 0) { var_null[i] <- T }
}
}
}
colnames(Rodentia_IE)[which(var_null == T)]## [1] "LsCc"New data set
data.rod <- cbind(LinneanName, SpecID, Rodentia_IE)
rownames(data.rod) <- data.rod$TaxaCategorical variables
# Locomotion
data.rod$Loco <- factor(data.rod$Loco)
table(data.rod$Loco)##
## arb fos gen gli unb
## 21 15 1 8 9# Clade
data.rod$Clade <- factor(data.rod$Clade)
table(data.rod$Clade)##
## an der gl ma mu sq tu
## 1 1 7 1 1 42 1Create a data set with standardized variables
Standardization:
- divide all linear dimensions (height, width, diameter of each canal
+ cochlea length) by the skull length SL
- divide all volumes by SL^3
Find variables to standardize
# Selection of variables: semicircular canals
asc <- grep("ASC", colnames(data.rod)) # ASC measurements
psc <- grep("PSC", colnames(data.rod)) # PSC measurements
lsc <- grep("LSC", colnames(data.rod)) # LSC measurements
# Selection of variables: primary and secondary common crus
cc <- which(colnames(data.rod) %in% c("LCc", "LsCc"))
# Selection of variables: cochlea length
co_l <- which(colnames(data.rod) == "CO_l")
# Selection of variables: volumes
vol <- grep("V", colnames(data.rod))New data set with standardized variables
# Create new data set
data.rod.sl <- data.rod
# Standardize variables
varStd1 <- c(asc, psc, lsc, cc, co_l)
data.rod.sl[, varStd1] <- data.rod.sl[, varStd1] / data.rod.sl$SL # divide by SL
data.rod.sl[, vol] <- data.rod.sl[, vol] / data.rod.sl$SL^3 # divide by SL^3
# Give new variable names
names(data.rod.sl)[varStd1] <- paste(names(data.rod.sl)[varStd1], "_SL", sep = "") # linear measurements
names(data.rod.sl)[vol] <- paste(names(data.rod.sl)[vol], "_SL3", sep = "") # volumesSet the graphical parameters
Define fossils for visualization
fos <- which(data.rod$Loco == "unb")Locomotion
# Categories
loco <- data.frame(abb = levels(data.rod$Loco),
names = c("arboreal", "fossorial", "generalist", "gliding", "unknown"),
col = c("lightgreen", "orange", "purple", "blue", "black"),
pch = c(24, 25, 21, 22, 23))
# Categories without fossils
loco.noFos <- data.frame(names = c("arboreal", "fossorial", "generalist", "gliding"),
col = c("lightgreen", "orange", "purple", "blue"),
pch = c(24, 25, 21, 22))
# By specimen
col.loco <- rep("black", nrow(data.rod))
pch.loco <- rep(23, nrow(data.rod))
for (i in 1:nrow(data.rod)) {
loco_i = which(loco$abb == data.rod$Loco[i])
col.loco[i] <- loco$col[loco_i]
pch.loco[i] <- loco$pch[loco_i]
}Clade
# Categories
clade <- data.frame(abb = levels(data.rod$Clade),
names = c("Anomalurops", "Dermoptera", "Glirid", "Marsupialia", "Murid", "Squirrel", "Tupaia"),
col = c("red", "turquoise", "pink", "gold", "brown", "orange", "green"),
pch = c(3, 4, 24, 1, 2, 25, 5))
# By specimen
col.clade <- rep("black", nrow(data.rod))
pch.clade <- rep(23, nrow(data.rod))
for (i in 1:nrow(data.rod)) {
clade_i = which(clade$abb == data.rod$Clade[i])
col.clade[i] <- clade$col[clade_i]
pch.clade[i] <- clade$pch[clade_i]
}Linear and angular measurements for the inner ear
In this section, we used variables standardized by skull length. Volumes are excluded from the analysis.
Principal component analysis
Prepare variable matrices
Select variables
# Matrix of variables (SL excluded)
M1.sl <- as.matrix(data.rod.sl[, 9:ncol(data.rod.sl)])
rownames(M1.sl) <- data.rod.sl$AbbrRemove variables with missing values (volumes)
v2 <- grep("V_", colnames(M1.sl))
M2.sl <- M1.sl[,-v2] # raw variables, no volumesPrincipal component analysis (PCA)
Do the PCA
# PCA on centered and scales variables
pca.rod.sl <- prcomp(M2.sl, center = T, scale. = T)
summary(pca.rod.sl)## Importance of components:
## PC1 PC2 PC3 PC4 PC5 PC6 PC7
## Standard deviation 2.6864 1.5203 1.4263 1.11270 0.97042 0.81664 0.66289
## Proportion of Variance 0.4511 0.1444 0.1272 0.07738 0.05886 0.04168 0.02746
## Cumulative Proportion 0.4511 0.5955 0.7227 0.80005 0.85891 0.90059 0.92805
## PC8 PC9 PC10 PC11 PC12 PC13 PC14
## Standard deviation 0.62453 0.47696 0.35664 0.32669 0.3020 0.283 0.26128
## Proportion of Variance 0.02438 0.01422 0.00795 0.00667 0.0057 0.005 0.00427
## Cumulative Proportion 0.95243 0.96665 0.97460 0.98127 0.9870 0.992 0.99624
## PC15 PC16
## Standard deviation 0.18863 0.15687
## Proportion of Variance 0.00222 0.00154
## Cumulative Proportion 0.99846 1.00000Scree plot
# Variance explained (precentage)
pca.rod.sl$var <- 100*pca.rod.sl$sdev^2 / sum(pca.rod.sl$sdev^2)
names(pca.rod.sl$var) <- 1:length(pca.rod.sl$var)
barplot(pca.rod.sl$var, col = "darkblue", las = 1,
main = "Scree plot of the PCA",
xlab = "Dimension", ylab = "% of tot. var.")
PC space: PC1 vs. PC2
# PC scores
pc <- c(1, 2)
plot(pca.rod.sl$x[, pc[1]], pca.rod.sl$x[, pc[2]],
col = col.loco, bg = col.loco,
las = 1, pch = pch.clade,
main = "PC1 vs. PC2",
xlab = paste("PC", pc[1], sep = ""),
ylab = paste("PC", pc[2], sep = ""))
abline(h = 0, lty = "dashed") ; abline(v = 0, lty = "dashed")
text(pca.rod.sl$x[ , pc[1]], pca.rod.sl$x[ , pc[2]],
labels = data.rod$Abbr, pos = 4, cex = .7, col = col.loco)
legend("topleft", # position of the legend
title = "Clade", # title of the legend
legend = clade$names, # text of the legend
pch = clade$pch, # symbols of the legend
pt.bg = "black",
cex = .6,
border = F) # color of the legend
PC space: PC2 vs. PC3
# PC scores
pc <- c(2,3)
plot(pca.rod.sl$x[, pc[1]], pca.rod.sl$x[, pc[2]],
col = col.loco, bg = col.loco,
las = 1, pch = pch.clade,
main = "PC2 vs. PC3",
xlab = paste("PC", pc[1], sep = ""),
ylab = paste("PC", pc[2], sep = ""))
abline(h = 0, lty = "dashed") ; abline(v = 0, lty = "dashed")
text(pca.rod.sl$x[ , pc[1]], pca.rod.sl$x[ , pc[2]],
labels = data.rod$Abbr, pos = 4, cex = .7, col = col.loco)
legend("bottomleft", # position of the legend
title = "Clade", # title of the legend
legend = clade$names, # text of the legend
pch = clade$pch, # symbols of the legend
pt.bg = "black",
cex = .6,
border = F) # color of the legend
PC loadings
pci <- 1
barplot(pca.rod.sl$rotation[, pci], col = "darkblue", las = 2,
xlab = "Variables", ylab = "Loadings", cex.names = .7,
main = paste("Dimension", pci))
pci <- 2
barplot(pca.rod.sl$rotation[, pci], col = "darkblue", las = 2,
xlab = "Variables", ylab = "Loadings", cex.names = .7,
main = paste("Dimension", pci))
pci <- 3
barplot(pca.rod.sl$rotation[, pci], col = "darkblue", las = 2,
xlab = "Variables", ylab = "Loadings", cex.names = .7,
main = paste("Dimension", pci))
Allometric changes
In this section we test the association between the first principal component and skull length, with or without the effect of clade.
Model 1: PC1 on SL
Build the data frame
rod.sl.df <- data.frame(clade = data.rod.sl$Clade,
loco = data.rod.sl$Loco,
sl = data.rod.sl$SL,
pc1 = pca.rod.sl$x[,1],
pc2 = pca.rod.sl$x[,2],
pc3 = pca.rod.sl$x[,3],
pc4 = pca.rod.sl$x[,4])
rownames(rod.sl.df) <- rownames(data.rod.sl)Linear regression of PC1 on SL
rod.sl.mod1 <- lm(pc1~sl, data = rod.sl.df)
summary(rod.sl.mod1)##
## Call:
## lm(formula = pc1 ~ sl, data = rod.sl.df)
##
## Residuals:
## Min 1Q Median 3Q Max
## -7.5033 -1.2194 0.3689 1.0589 4.7082
##
## Coefficients:
## Estimate Std. Error t value Pr(>|t|)
## (Intercept) 5.53392 1.01124 5.472 1.29e-06 ***
## sl -0.12546 0.02197 -5.711 5.48e-07 ***
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## Residual standard error: 2.126 on 52 degrees of freedom
## Multiple R-squared: 0.3855, Adjusted R-squared: 0.3737
## F-statistic: 32.62 on 1 and 52 DF, p-value: 5.483e-07Visualization
# Scatter plot
plot(pc1~sl, data = rod.sl.df,
asp = 1, las = 1,
col = col.loco, bg = col.loco, # color
pch = pch.clade,
main = "PC1 = f(SL)",
xlab = "SL (mm)", ylab = "PC1")
# Names
text(rod.sl.df$sl, rod.sl.df$pc1,
labels = data.rod$Abbr, pos = 4, cex = .7, col = col.loco)
# Regression line
lines(rod.sl.mod1$fitted.values~rod.sl.mod1$model$sl,
col = "red", lty = 1, lwd = 1)
# Add a legend
legend("topright", title = "Clade", legend = clade$names,
pch = clade$pch, pt.bg = "black", cex = .6, border = F)
Models 2 and 3: Effect of clade
Define the subset (specimen removed when only 1 case per group)
rod.sl.df.clade <- subset(rod.sl.df, clade %in% c("gl", "sq"))
rod.sl.df.clade$clade <- factor(rod.sl.df.clade$clade)Linear regression on SL and clade:
# Linear regression on SL and clade: additive effects
rod.sl.mod2 <- lm(pc1~sl+clade, data = rod.sl.df.clade)
summary(rod.sl.mod2)##
## Call:
## lm(formula = pc1 ~ sl + clade, data = rod.sl.df.clade)
##
## Residuals:
## Min 1Q Median 3Q Max
## -3.9843 -0.9692 0.1116 0.6741 3.9001
##
## Coefficients:
## Estimate Std. Error t value Pr(>|t|)
## (Intercept) 4.9069 0.8353 5.875 4.46e-07 ***
## sl -0.1453 0.0222 -6.544 4.42e-08 ***
## cladesq 2.1202 0.8252 2.569 0.0135 *
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## Residual standard error: 1.652 on 46 degrees of freedom
## Multiple R-squared: 0.4944, Adjusted R-squared: 0.4724
## F-statistic: 22.49 on 2 and 46 DF, p-value: 1.54e-07# Linear regression on SL and clade: interaction effects
rod.sl.mod3 <- lm(pc1~sl*clade, data = rod.sl.df.clade)
summary(rod.sl.mod3)##
## Call:
## lm(formula = pc1 ~ sl * clade, data = rod.sl.df.clade)
##
## Residuals:
## Min 1Q Median 3Q Max
## -3.9812 -0.9758 0.1167 0.6730 3.9045
##
## Coefficients:
## Estimate Std. Error t value Pr(>|t|)
## (Intercept) 5.31682 3.83203 1.387 0.172
## sl -0.16169 0.15123 -1.069 0.291
## cladesq 1.69306 3.98252 0.425 0.673
## sl:cladesq 0.01677 0.15292 0.110 0.913
##
## Residual standard error: 1.67 on 45 degrees of freedom
## Multiple R-squared: 0.4945, Adjusted R-squared: 0.4608
## F-statistic: 14.68 on 3 and 45 DF, p-value: 8.411e-07Linear classification: canonical variate analysis (CVA)
In this section, we try to find association of variables that discriminate among locomotor groups. We use a reduced number of variables (the 3 first principal components), because the number of variables has to be lower than the number of cases in each group.
Here we do a canonical variate analysis (CVA), the extension of a
linear discriminant analysis (LDA) for more than 2 groups (note that in
R, the function used is lda, so the variables are named LD1
and LD2 in the R output).
Define the subset (specimen removed when only 1 case per group or unknown)
rod.sl.df.loco <- subset(rod.sl.df, loco %in% c("arb", "fos", "gli"))
rod.sl.df.loco$loco <- factor(rod.sl.df.loco$loco)Do the CVA
# CVA
rod.sl.loco.cva <- lda(loco~pc1+pc2+pc3, data = rod.sl.df.loco)
rod.sl.loco.cva## Call:
## lda(loco ~ pc1 + pc2 + pc3, data = rod.sl.df.loco)
##
## Prior probabilities of groups:
## arb fos gli
## 0.4772727 0.3409091 0.1818182
##
## Group means:
## pc1 pc2 pc3
## arb 0.5347572 -0.3848945 0.8995014
## fos 1.1610537 0.2292660 -1.5438185
## gli -1.7949578 -0.3520661 0.6912049
##
## Coefficients of linear discriminants:
## LD1 LD2
## pc1 0.1844527 -0.40250273
## pc2 0.4008163 0.02282837
## pc3 -1.0378323 -0.22471330
##
## Proportion of trace:
## LD1 LD2
## 0.9388 0.0612Classification of specimens
# Classification of the observations
rod.sl.loco.cva.pred <- predict(rod.sl.loco.cva, rod.sl.df.loco)
# Confusion matrix (counts)
table(rod.sl.df.loco$loco, rod.sl.loco.cva.pred$class)##
## arb fos gli
## arb 21 0 0
## fos 3 12 0
## gli 6 0 2# Confusion matrix (proportions)
prop.table(table(rod.sl.df.loco$loco, rod.sl.loco.cva.pred$class))##
## arb fos gli
## arb 0.47727273 0.00000000 0.00000000
## fos 0.06818182 0.27272727 0.00000000
## gli 0.13636364 0.00000000 0.04545455Compare real vs. predicted group assignment and posterior probabilities for the extant specimens
cbind(rod.sl.df.loco$loco, # group
rod.sl.loco.cva.pred$class, # Affinities
rod.sl.loco.cva.pred$posterior) # Posterior probabilities## arb fos
## Anomalurops beecrofti (64.501) 3 3 6.085066e-02 0.0001066409
## Aplodontia rufa (M6169) 2 2 2.485883e-02 0.9515279697
## Atlantoxerus getulus (88.195) 2 2 3.007901e-01 0.6473216896
## Callosciurus finlaysonii (92.335) 1 1 7.687383e-01 0.0066966020
## Callospermophilus lateralis (92.499) 2 2 4.869635e-04 0.9995009775
## Cynocephalus volans (MaÜ219) 3 3 3.987993e-01 0.0276132513
## Cynomys ludovicianus (M873) 2 2 3.327887e-04 0.9994360892
## Cynomys ludovicianus (MaÜ9) 2 2 1.296242e-03 0.9980446787
## Dremomys pernyi calidior (50.388) 1 1 7.170612e-01 0.0024175275
## Dryomys nitedula (94.88) 1 1 5.700550e-01 0.3956943514
## Eliomys quercinus (71.100) 1 1 8.170330e-01 0.0072206348
## Eutamias sibiricus (79.7) 2 1 8.688257e-01 0.0478950289
## Eutamias sp. (1624) 2 1 6.294112e-01 0.2966338991
## Funisciurus anerythrus (68.1272) 1 1 7.154076e-01 0.0074573685
## Geosciurus inauris (61.411) 2 2 3.523821e-01 0.5132709334
## Glaucomys volans (166,289) 3 1 8.971298e-01 0.0016839417
## Glirulus japonicus (NMW-31028) 1 1 8.159378e-01 0.0015290454
## Glis glis (M1055) 1 1 7.920722e-01 0.0008234135
## Graphiurus parvus (Koe3630) 1 1 9.338810e-01 0.0037566028
## Heliosciurus rufobrachium (69.315) 1 1 8.658249e-01 0.0285368010
## Hylopetes sagitta (6089) 3 1 7.398738e-01 0.0131900293
## Iomys thompsoni (9275) 3 1 5.241366e-01 0.0064357865
## Muscardinus avellanarius (A10640) 1 1 7.959207e-01 0.0452905397
## Muscardinus avellanarius (Maier) 1 1 8.773157e-01 0.0003522838
## Neotamias townsendii (1614) 1 1 7.994845e-01 0.1123516563
## Notocitellus annulatus (4293) 2 1 6.013325e-01 0.2093204841
## Paraxerus cepapi (7968) 1 1 6.889730e-01 0.0683559596
## Petaurista petaurista (72.106) 3 1 6.917873e-01 0.0021770534
## Petaurus breviceps (M6455) 3 1 6.158710e-01 0.0345478363
## Prasadsciurus pennantii (89.36) 1 1 8.410224e-01 0.0141711401
## Protoxerus stangeri (62.10) 1 1 6.668814e-01 0.0119818369
## Pteromys volans (5i00) 3 1 8.801590e-01 0.0013376561
## Ratufa bicolor (80.852) 1 1 6.535138e-01 0.0007409305
## Sciurus carolinensis (M6395) 1 1 6.259552e-01 0.0013025041
## Sciurus vulgaris (M882) 1 1 6.271223e-01 0.0166440914
## Spermophilopsis leptodactylus (92.496) 2 2 1.343548e-02 0.9856522846
## Spermophilus citellus (M1110) 2 2 2.460996e-04 0.9997266923
## Spermophilus erythrogenys (18870) 2 2 6.181478e-06 0.9999925310
## Spermophilus suslicus (294) 2 2 4.277810e-01 0.5155625643
## Tamiasciurus hudsonicus (vK646) 1 1 8.861417e-01 0.0054829995
## Tamiops macclellandii (50.378) 1 1 8.646373e-01 0.0338389775
## Tupaia glis 1 1 6.173901e-01 0.0014035146
## Urocitellus undulatus (484) 2 2 1.311007e-02 0.9838100097
## Urocitellus undulatus (98.353) 2 2 7.638980e-04 0.9992012097
## gli
## Anomalurops beecrofti (64.501) 9.390427e-01
## Aplodontia rufa (M6169) 2.361320e-02
## Atlantoxerus getulus (88.195) 5.188823e-02
## Callosciurus finlaysonii (92.335) 2.245651e-01
## Callospermophilus lateralis (92.499) 1.205897e-05
## Cynocephalus volans (MaÜ219) 5.735874e-01
## Cynomys ludovicianus (M873) 2.311221e-04
## Cynomys ludovicianus (MaÜ9) 6.590789e-04
## Dremomys pernyi calidior (50.388) 2.805213e-01
## Dryomys nitedula (94.88) 3.425065e-02
## Eliomys quercinus (71.100) 1.757464e-01
## Eutamias sibiricus (79.7) 8.327928e-02
## Eutamias sp. (1624) 7.395494e-02
## Funisciurus anerythrus (68.1272) 2.771351e-01
## Geosciurus inauris (61.411) 1.343470e-01
## Glaucomys volans (166,289) 1.011863e-01
## Glirulus japonicus (NMW-31028) 1.825332e-01
## Glis glis (M1055) 2.071044e-01
## Graphiurus parvus (Koe3630) 6.236244e-02
## Heliosciurus rufobrachium (69.315) 1.056383e-01
## Hylopetes sagitta (6089) 2.469362e-01
## Iomys thompsoni (9275) 4.694276e-01
## Muscardinus avellanarius (A10640) 1.587887e-01
## Muscardinus avellanarius (Maier) 1.223320e-01
## Neotamias townsendii (1614) 8.816386e-02
## Notocitellus annulatus (4293) 1.893470e-01
## Paraxerus cepapi (7968) 2.426710e-01
## Petaurista petaurista (72.106) 3.060357e-01
## Petaurus breviceps (M6455) 3.495811e-01
## Prasadsciurus pennantii (89.36) 1.448065e-01
## Protoxerus stangeri (62.10) 3.211368e-01
## Pteromys volans (5i00) 1.185034e-01
## Ratufa bicolor (80.852) 3.457453e-01
## Sciurus carolinensis (M6395) 3.727423e-01
## Sciurus vulgaris (M882) 3.562336e-01
## Spermophilopsis leptodactylus (92.496) 9.122387e-04
## Spermophilus citellus (M1110) 2.720815e-05
## Spermophilus erythrogenys (18870) 1.287515e-06
## Spermophilus suslicus (294) 5.665645e-02
## Tamiasciurus hudsonicus (vK646) 1.083753e-01
## Tamiops macclellandii (50.378) 1.015237e-01
## Tupaia glis 3.812063e-01
## Urocitellus undulatus (484) 3.079921e-03
## Urocitellus undulatus (98.353) 3.489238e-05Typicality probabilities for the extant specimens
# Classification of the observations
rod.sl.loco.probas <- typprobClass(x = rod.sl.df.loco[,4:6],
groups = rod.sl.df.loco$loco,
method = "wilson", small = TRUE)
# Confusion matrix (counts)
table(rod.sl.df.loco$loco, rod.sl.loco.probas$groupaffin)##
## arb fos gli
## arb 14 0 7
## fos 3 12 0
## gli 3 0 5Compare real vs. predicted group assignment and typicality probabilities for the extant specimens
cbind(rod.sl.df.loco$loco, # group
rod.sl.loco.probas$groupaffin, # Affinities
rod.sl.loco.probas$probs) # Typicality probabilities## arb fos
## Anomalurops beecrofti (64.501) 3 3 0.0071253807 0.0006242116
## Aplodontia rufa (M6169) 2 2 0.0206443221 0.2078528817
## Atlantoxerus getulus (88.195) 2 2 0.3807659796 0.7539826688
## Callosciurus finlaysonii (92.335) 1 1 0.6877643887 0.0457731237
## Callospermophilus lateralis (92.499) 2 2 0.0024271612 0.1407857642
## Cynocephalus volans (MaÜ219) 3 3 0.2664852433 0.0635651807
## Cynomys ludovicianus (M873) 2 2 0.0033872142 0.2952636893
## Cynomys ludovicianus (MaÜ9) 2 2 0.0100893076 0.5692960735
## Dremomys pernyi calidior (50.388) 1 3 0.6640876674 0.0262883344
## Dryomys nitedula (94.88) 1 1 0.1912795641 0.1878563064
## Eliomys quercinus (71.100) 1 1 0.5794740726 0.0393896755
## Eutamias sibiricus (79.7) 2 1 0.8162607817 0.1647227670
## Eutamias sp. (1624) 2 1 0.6069951875 0.4677484540
## Funisciurus anerythrus (68.1272) 1 3 0.7984154366 0.0588882932
## Geosciurus inauris (61.411) 2 2 0.3647626909 0.5735325827
## Glaucomys volans (166,289) 3 1 0.8349713283 0.0238632659
## Glirulus japonicus (NMW-31028) 1 1 0.1910422235 0.0073199410
## Glis glis (M1055) 1 1 0.8948818361 0.0188333639
## Graphiurus parvus (Koe3630) 1 1 0.1443496144 0.0084990269
## Heliosciurus rufobrachium (69.315) 1 1 0.7244391154 0.1051501101
## Hylopetes sagitta (6089) 3 1 0.9518601439 0.1004479311
## Iomys thompsoni (9275) 3 3 0.6305096103 0.0512360588
## Muscardinus avellanarius (A10640) 1 1 0.1859979060 0.0411546922
## Muscardinus avellanarius (Maier) 1 1 0.3916698133 0.0060324646
## Neotamias townsendii (1614) 1 1 0.7073020130 0.2535262382
## Notocitellus annulatus (4293) 2 1 0.6550819779 0.4176199219
## Paraxerus cepapi (7968) 1 1 0.7366305796 0.2123664802
## Petaurista petaurista (72.106) 3 3 0.8095429581 0.0305229965
## Petaurus breviceps (M6455) 3 3 0.6761388485 0.1355287527
## Prasadsciurus pennantii (89.36) 1 1 0.9713575487 0.1004530956
## Protoxerus stangeri (62.10) 1 3 0.7633182587 0.0772177697
## Pteromys volans (5i00) 3 1 0.8405126633 0.0214916950
## Ratufa bicolor (80.852) 1 3 0.6981513088 0.0155606449
## Sciurus carolinensis (M6395) 1 3 0.5865089569 0.0183230154
## Sciurus vulgaris (M882) 1 3 0.7748173554 0.0990720733
## Spermophilopsis leptodactylus (92.496) 2 2 0.0495567177 0.8436972724
## Spermophilus citellus (M1110) 2 2 0.0034382892 0.3665963706
## Spermophilus erythrogenys (18870) 2 2 0.0003828717 0.0961563148
## Spermophilus suslicus (294) 2 2 0.4708270406 0.6520297408
## Tamiasciurus hudsonicus (vK646) 1 1 0.7504740840 0.0410938670
## Tamiops macclellandii (50.378) 1 1 0.7160864515 0.1153328756
## Tupaia glis 1 3 0.7255097824 0.0230871136
## Urocitellus undulatus (484) 2 2 0.0606280395 0.9873791129
## Urocitellus undulatus (98.353) 2 2 0.0053870135 0.3402127895
## gli
## Anomalurops beecrofti (64.501) 0.0479981468
## Aplodontia rufa (M6169) 0.0336760934
## Atlantoxerus getulus (88.195) 0.2291520498
## Callosciurus finlaysonii (92.335) 0.5854778159
## Callospermophilus lateralis (92.499) 0.0008394380
## Cynocephalus volans (MaÜ219) 0.6201829857
## Cynomys ludovicianus (M873) 0.0044015315
## Cynomys ludovicianus (MaÜ9) 0.0116178370
## Dremomys pernyi calidior (50.388) 0.6747172793
## Dryomys nitedula (94.88) 0.0623037174
## Eliomys quercinus (71.100) 0.4035888137
## Eutamias sibiricus (79.7) 0.3495754176
## Eutamias sp. (1624) 0.2872678126
## Funisciurus anerythrus (68.1272) 0.8056991897
## Geosciurus inauris (61.411) 0.3649480253
## Glaucomys volans (166,289) 0.3989055683
## Glirulus japonicus (NMW-31028) 0.1369661610
## Glis glis (M1055) 0.7325960035
## Graphiurus parvus (Koe3630) 0.0511105831
## Heliosciurus rufobrachium (69.315) 0.3558400869
## Hylopetes sagitta (6089) 0.8994892055
## Iomys thompsoni (9275) 0.9793788474
## Muscardinus avellanarius (A10640) 0.1243367557
## Muscardinus avellanarius (Maier) 0.2058497168
## Neotamias townsendii (1614) 0.3247617673
## Notocitellus annulatus (4293) 0.5831180257
## Paraxerus cepapi (7968) 0.7038456399
## Petaurista petaurista (72.106) 0.8744750273
## Petaurus breviceps (M6455) 0.8457854224
## Prasadsciurus pennantii (89.36) 0.6439417952
## Protoxerus stangeri (62.10) 0.8650670204
## Pteromys volans (5i00) 0.4503893750
## Ratufa bicolor (80.852) 0.8387093905
## Sciurus carolinensis (M6395) 0.7649540753
## Sciurus vulgaris (M882) 0.9439712049
## Spermophilopsis leptodactylus (92.496) 0.0193960144
## Spermophilus citellus (M1110) 0.0020502990
## Spermophilus erythrogenys (18870) 0.0003142003
## Spermophilus suslicus (294) 0.2392651831
## Tamiasciurus hudsonicus (vK646) 0.3707522231
## Tamiops macclellandii (50.378) 0.3427501672
## Tupaia glis 0.9315244515
## Urocitellus undulatus (484) 0.0459746670
## Urocitellus undulatus (98.353) 0.0021643490Prediction for the unknown
# Prediction
rod.sl.loco.cva.pred.new <- predict(rod.sl.loco.cva, subset(rod.sl.df, loco == "unb"))
rod.sl.loco.cva.pred.new## $class
## [1] fos fos fos fos fos gli arb arb arb
## Levels: arb fos gli
##
## $posterior
## arb fos gli
## Adelomys sp. (QT-756) 0.118238540 0.6868050541 0.1949564064
## Ardynomys occidentalis (9991) 0.008681223 0.9871973485 0.0041214282
## Cylindrodon fontis (17204) 0.008008202 0.9917227884 0.0002690092
## Heteroxerus costatus (4404) 0.299199459 0.6768680806 0.0239324600
## Ischyromys typus (CM588) 0.066682189 0.8501517720 0.0831660395
## Palaeosciurus feignouxi (98196) 0.321129026 0.0140647875 0.6648061865
## Sciuroides fransi (M2534) 0.611446361 0.0028438524 0.3857097866
## Sciuroides sp. (Qi68a) 0.564280705 0.0079179436 0.4278013509
## Sciurus sp. (Ph1322) 0.815886426 0.0004898231 0.1836237509
##
## $x
## LD1 LD2
## Adelomys sp. (QT-756) 0.9805761 2.1078257
## Ardynomys occidentalis (9991) 2.1179218 1.0754976
## Cylindrodon fontis (17204) 2.4290711 -1.5493209
## Heteroxerus costatus (4404) 0.9846616 -0.9625189
## Ischyromys typus (CM588) 1.2758601 1.8845378
## Palaeosciurus feignouxi (98196) -0.6944871 1.9981297
## Sciuroides fransi (M2534) -1.3252205 0.6636922
## Sciuroides sp. (Qi68a) -0.9718506 0.9221585
## Sciurus sp. (Ph1322) -1.9068471 -0.5006498Typicality probabilities for the unknown
# Classification of the observations
rod.sl.loco.probas.new <- typprobClass(x = subset(rod.sl.df, loco == "unb")[,4:6],
data = rod.sl.df.loco[,4:6],
groups = rod.sl.df.loco$loco,
method = "wilson", small = TRUE)
# Prediction
rod.sl.loco.probas.new$groupaffin # affinities## [1] fos fos fos fos fos gli gli gli arb
## Levels: arb fos glirod.sl.loco.probas.new$probs # typicality probabilities## arb fos gli
## Adelomys sp. (QT-756) 0.032968480 0.110828018 0.075906820
## Ardynomys occidentalis (9991) 0.010257652 0.172119943 0.011422410
## Cylindrodon fontis (17204) 0.003248394 0.040457859 0.001218061
## Heteroxerus costatus (4404) 0.259483844 0.542115346 0.098056625
## Ischyromys typus (CM588) 0.054317845 0.318148266 0.109534139
## Palaeosciurus feignouxi (98196) 0.153198465 0.030042062 0.450216754
## Sciuroides fransi (M2534) 0.602409016 0.028670573 0.808734663
## Sciuroides sp. (Qi68a) 0.400761282 0.036846428 0.618415472
## Sciurus sp. (Ph1322) 0.386966882 0.007204233 0.275997137Visualization of the scores along the two discriminant vectors.
# Scatter plot
plot(rod.sl.loco.cva,
las = 1,
col = col.loco[which(data.rod.sl$Loco %in% c("arb", "fos", "gli"))],
main = "CVA", xlab = "CV1", ylab = "CV2")
# New specimens as a black points
points(rod.sl.loco.cva.pred.new$x, col = "black", pch = 16)
text(rod.sl.loco.cva.pred.new$x, pos = 4, cex = .5,
labels = data.rod.sl$Abbr[which(data.rod.sl$Loco == "unb")])
Association of volumes with skull length
Data preparation
New subset with three ecotypes only (arboreal, fossorial, gliding)
data.rod.loco <- subset(data.rod, Loco %in% c("arb", "fos", "gli"))
data.rod.loco$Loco <- factor(data.rod.loco$Loco)Bivariate associations: inner ear vs. skull length
Regression of volumes on skull length
data.rod.ie.mod1 <- lm(log(V_IE)~log(SL), data = data.rod)
summary(data.rod.ie.mod1)##
## Call:
## lm(formula = log(V_IE) ~ log(SL), data = data.rod)
##
## Residuals:
## Min 1Q Median 3Q Max
## -1.70364 -0.08419 0.07881 0.16623 0.58876
##
## Coefficients:
## Estimate Std. Error t value Pr(>|t|)
## (Intercept) -3.5227 0.6199 -5.683 6.41e-07 ***
## log(SL) 1.5731 0.1647 9.552 6.02e-13 ***
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## Residual standard error: 0.3618 on 51 degrees of freedom
## (1 observation effacée parce que manquante)
## Multiple R-squared: 0.6414, Adjusted R-squared: 0.6344
## F-statistic: 91.23 on 1 and 51 DF, p-value: 6.018e-13data.rod.scc.mod1 <- lm(log(V_SCC)~log(SL), data = data.rod)
summary(data.rod.scc.mod1)##
## Call:
## lm(formula = log(V_SCC) ~ log(SL), data = data.rod)
##
## Residuals:
## Min 1Q Median 3Q Max
## -2.12154 -0.13600 0.05808 0.29688 0.78055
##
## Coefficients:
## Estimate Std. Error t value Pr(>|t|)
## (Intercept) -4.5936 0.8776 -5.234 3.15e-06 ***
## log(SL) 1.6966 0.2332 7.276 1.99e-09 ***
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## Residual standard error: 0.5123 on 51 degrees of freedom
## (1 observation effacée parce que manquante)
## Multiple R-squared: 0.5094, Adjusted R-squared: 0.4997
## F-statistic: 52.95 on 1 and 51 DF, p-value: 1.993e-09data.rod.co.mod1 <- lm(log(V_CO)~log(SL), data = data.rod)
summary(data.rod.co.mod1)##
## Call:
## lm(formula = log(V_CO) ~ log(SL), data = data.rod)
##
## Residuals:
## Min 1Q Median 3Q Max
## -1.26682 -0.16524 0.02279 0.22402 0.68392
##
## Coefficients:
## Estimate Std. Error t value Pr(>|t|)
## (Intercept) -3.6856 0.5538 -6.655 1.91e-08 ***
## log(SL) 1.3908 0.1471 9.452 8.49e-13 ***
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## Residual standard error: 0.3233 on 51 degrees of freedom
## (1 observation effacée parce que manquante)
## Multiple R-squared: 0.6366, Adjusted R-squared: 0.6295
## F-statistic: 89.35 on 1 and 51 DF, p-value: 8.487e-13Regression of volumes on skull length with effect of ecotype
data.rod.ie.mod2 <- lm(log(V_IE)~log(SL)+Loco, data = data.rod.loco)
summary(data.rod.ie.mod2)##
## Call:
## lm(formula = log(V_IE) ~ log(SL) + Loco, data = data.rod.loco)
##
## Residuals:
## Min 1Q Median 3Q Max
## -1.62558 -0.07295 0.01441 0.16718 0.65524
##
## Coefficients:
## Estimate Std. Error t value Pr(>|t|)
## (Intercept) -3.94214 0.62769 -6.280 2.11e-07 ***
## log(SL) 1.68033 0.17059 9.850 3.92e-12 ***
## Locofos 0.17897 0.11858 1.509 0.139
## Locogli -0.09367 0.14392 -0.651 0.519
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## Residual standard error: 0.3387 on 39 degrees of freedom
## (1 observation effacée parce que manquante)
## Multiple R-squared: 0.7405, Adjusted R-squared: 0.7205
## F-statistic: 37.09 on 3 and 39 DF, p-value: 1.663e-11data.rod.scc.mod2 <- lm(log(V_SCC)~log(SL)+Loco, data = data.rod.loco)
summary(data.rod.scc.mod2)##
## Call:
## lm(formula = log(V_SCC) ~ log(SL) + Loco, data = data.rod.loco)
##
## Residuals:
## Min 1Q Median 3Q Max
## -1.94796 -0.10860 0.02905 0.17836 0.72948
##
## Coefficients:
## Estimate Std. Error t value Pr(>|t|)
## (Intercept) -5.1321 0.7639 -6.719 5.23e-08 ***
## log(SL) 1.8298 0.2076 8.814 8.04e-11 ***
## Locofos 0.4255 0.1443 2.949 0.00537 **
## Locogli -0.1755 0.1751 -1.002 0.32246
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## Residual standard error: 0.4122 on 39 degrees of freedom
## (1 observation effacée parce que manquante)
## Multiple R-squared: 0.7281, Adjusted R-squared: 0.7071
## F-statistic: 34.8 on 3 and 39 DF, p-value: 4.102e-11data.rod.co.mod2 <- lm(log(V_CO)~log(SL)+Loco, data = data.rod.loco)
summary(data.rod.co.mod2)##
## Call:
## lm(formula = log(V_CO) ~ log(SL) + Loco, data = data.rod.loco)
##
## Residuals:
## Min 1Q Median 3Q Max
## -1.3424 -0.1153 0.0286 0.1543 0.5971
##
## Coefficients:
## Estimate Std. Error t value Pr(>|t|)
## (Intercept) -4.027647 0.563373 -7.149 1.34e-08 ***
## log(SL) 1.495206 0.153107 9.766 4.99e-12 ***
## Locofos -0.215980 0.106433 -2.029 0.0493 *
## Locogli -0.006134 0.129177 -0.047 0.9624
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## Residual standard error: 0.304 on 39 degrees of freedom
## (1 observation effacée parce que manquante)
## Multiple R-squared: 0.7164, Adjusted R-squared: 0.6945
## F-statistic: 32.83 on 3 and 39 DF, p-value: 9.256e-11Visualization of inner ear volumetric measurements as a function of skull length
par(las = 1)
# Inner ear
plot(log(V_IE)~log(SL), data = data.rod,
main = "Inner ear",
col = col.loco, bg = col.loco, pch = pch.clade)
text(log(data.rod$SL), log(data.rod$V_IE),
labels = data.rod$Abbr, col = col.loco, pos = 4, cex = .7)
lines(data.rod.ie.mod1$fitted.values~data.rod.ie.mod1$model$`log(SL)`,
col = "red", lty = 1, lwd = 1)
# Vestibular part
plot(log(V_SCC)~log(SL), data = data.rod,
main = "Vestibular part",
col = col.loco, bg = col.loco, pch = pch.clade)
text(log(data.rod$SL), log(data.rod$V_SCC),
labels = data.rod$Abbr, col = col.loco, pos = 4, cex = .7)
lines(data.rod.scc.mod1$fitted.values~data.rod.scc.mod1$model$`log(SL)`,
col = "red", lty = 1, lwd = 1)
# Cochlea
plot(log(V_CO)~log(SL), data = data.rod,
main = "Cochlea",
col = col.loco, bg = col.loco, pch = pch.clade)
text(log(data.rod$SL), log(data.rod$V_CO),
labels = data.rod$Abbr, col = col.loco, pos = 4, cex = .7)
lines(data.rod.co.mod1$fitted.values~data.rod.co.mod1$model$`log(SL)`,
col = "red", lty = 1, lwd = 1)
Bivariate associations: middle ear vs. skull length
Regression of volumes on skull length
data.rod.st.mod1 <- lm(log(V_st)~log(SL), data = data.rod)
summary(data.rod.st.mod1)##
## Call:
## lm(formula = log(V_st) ~ log(SL), data = data.rod)
##
## Residuals:
## Min 1Q Median 3Q Max
## -2.16526 -0.24264 0.03589 0.30811 1.55992
##
## Coefficients:
## Estimate Std. Error t value Pr(>|t|)
## (Intercept) -8.0790 0.9716 -8.315 8.66e-11 ***
## log(SL) 1.6253 0.2596 6.260 1.08e-07 ***
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## Residual standard error: 0.5439 on 47 degrees of freedom
## (5 observations effacées parce que manquantes)
## Multiple R-squared: 0.4547, Adjusted R-squared: 0.4431
## F-statistic: 39.19 on 1 and 47 DF, p-value: 1.085e-07data.rod.in.mod1 <- lm(log(V_in)~log(SL), data = data.rod)
summary(data.rod.in.mod1)##
## Call:
## lm(formula = log(V_in) ~ log(SL), data = data.rod)
##
## Residuals:
## Min 1Q Median 3Q Max
## -0.66558 -0.22694 0.05624 0.24977 0.69463
##
## Coefficients:
## Estimate Std. Error t value Pr(>|t|)
## (Intercept) -6.5528 0.5966 -10.98 3.41e-14 ***
## log(SL) 1.6190 0.1602 10.11 4.81e-13 ***
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## Residual standard error: 0.3248 on 44 degrees of freedom
## (8 observations effacées parce que manquantes)
## Multiple R-squared: 0.6989, Adjusted R-squared: 0.6921
## F-statistic: 102.1 on 1 and 44 DF, p-value: 4.812e-13data.rod.ma.mod1 <- lm(log(V_ma)~log(SL), data = data.rod)
summary(data.rod.ma.mod1)##
## Call:
## lm(formula = log(V_ma) ~ log(SL), data = data.rod)
##
## Residuals:
## Min 1Q Median 3Q Max
## -0.73050 -0.23331 0.02731 0.21943 0.69211
##
## Coefficients:
## Estimate Std. Error t value Pr(>|t|)
## (Intercept) -6.8484 0.6060 -11.30 9.86e-15 ***
## log(SL) 1.8190 0.1626 11.19 1.38e-14 ***
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## Residual standard error: 0.3298 on 45 degrees of freedom
## (7 observations effacées parce que manquantes)
## Multiple R-squared: 0.7355, Adjusted R-squared: 0.7296
## F-statistic: 125.1 on 1 and 45 DF, p-value: 1.382e-14data.rod.main.mod1 <- lm(log(V_ma+V_in)~log(SL), data = data.rod)
summary(data.rod.main.mod1)##
## Call:
## lm(formula = log(V_ma + V_in) ~ log(SL), data = data.rod)
##
## Residuals:
## Min 1Q Median 3Q Max
## -0.52017 -0.27312 0.04057 0.23086 0.65979
##
## Coefficients:
## Estimate Std. Error t value Pr(>|t|)
## (Intercept) -6.1466 0.5925 -10.38 2.79e-13 ***
## log(SL) 1.7655 0.1595 11.07 3.62e-14 ***
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## Residual standard error: 0.3164 on 43 degrees of freedom
## (9 observations effacées parce que manquantes)
## Multiple R-squared: 0.7402, Adjusted R-squared: 0.7342
## F-statistic: 122.5 on 1 and 43 DF, p-value: 3.615e-14Regression of volumes on skull length with effect of ecotype
data.rod.st.mod2 <- lm(log(V_st)~log(SL)+Loco, data = data.rod.loco)
summary(data.rod.st.mod2)##
## Call:
## lm(formula = log(V_st) ~ log(SL) + Loco, data = data.rod.loco)
##
## Residuals:
## Min 1Q Median 3Q Max
## -2.05643 -0.13179 0.02748 0.17011 0.91358
##
## Coefficients:
## Estimate Std. Error t value Pr(>|t|)
## (Intercept) -8.47663 0.87824 -9.652 9.06e-12 ***
## log(SL) 1.67922 0.23878 7.032 2.22e-08 ***
## Locofos 0.45207 0.16119 2.805 0.00789 **
## Locogli 0.06996 0.20284 0.345 0.73206
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## Residual standard error: 0.4597 on 38 degrees of freedom
## (2 observations effacées parce que manquantes)
## Multiple R-squared: 0.6484, Adjusted R-squared: 0.6206
## F-statistic: 23.36 on 3 and 38 DF, p-value: 9.718e-09data.rod.in.mod2 <- lm(log(V_in)~log(SL)+Loco, data = data.rod.loco)
summary(data.rod.in.mod2)##
## Call:
## lm(formula = log(V_in) ~ log(SL) + Loco, data = data.rod.loco)
##
## Residuals:
## Min 1Q Median 3Q Max
## -0.44919 -0.18706 -0.02936 0.18506 0.48975
##
## Coefficients:
## Estimate Std. Error t value Pr(>|t|)
## (Intercept) -6.40065 0.48817 -13.111 4.57e-15 ***
## log(SL) 1.54609 0.13278 11.644 1.37e-13 ***
## Locofos 0.26191 0.08984 2.915 0.00616 **
## Locogli 0.13705 0.11547 1.187 0.24326
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## Residual standard error: 0.2479 on 35 degrees of freedom
## (5 observations effacées parce que manquantes)
## Multiple R-squared: 0.8223, Adjusted R-squared: 0.807
## F-statistic: 53.97 on 3 and 35 DF, p-value: 3.269e-13data.rod.ma.mod2 <- lm(log(V_ma)~log(SL)+Loco, data = data.rod.loco)
summary(data.rod.ma.mod2)##
## Call:
## lm(formula = log(V_ma) ~ log(SL) + Loco, data = data.rod.loco)
##
## Residuals:
## Min 1Q Median 3Q Max
## -0.68065 -0.19771 -0.05097 0.24716 0.48837
##
## Coefficients:
## Estimate Std. Error t value Pr(>|t|)
## (Intercept) -6.5491 0.5596 -11.702 5.34e-14 ***
## log(SL) 1.6931 0.1522 11.125 2.32e-13 ***
## Locofos 0.3140 0.1011 3.104 0.00365 **
## Locogli 0.1822 0.1342 1.358 0.18280
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## Residual standard error: 0.2882 on 37 degrees of freedom
## (3 observations effacées parce que manquantes)
## Multiple R-squared: 0.8099, Adjusted R-squared: 0.7945
## F-statistic: 52.54 on 3 and 37 DF, p-value: 2.057e-13data.rod.main.mod2 <- lm(log(V_ma+V_in)~log(SL)+Loco, data = data.rod.loco)
summary(data.rod.main.mod2)##
## Call:
## lm(formula = log(V_ma + V_in) ~ log(SL) + Loco, data = data.rod.loco)
##
## Residuals:
## Min 1Q Median 3Q Max
## -0.54724 -0.18997 -0.06436 0.21374 0.48382
##
## Coefficients:
## Estimate Std. Error t value Pr(>|t|)
## (Intercept) -5.83781 0.52062 -11.213 3.90e-13 ***
## log(SL) 1.64112 0.14161 11.589 1.56e-13 ***
## Locofos 0.30016 0.09581 3.133 0.00349 **
## Locogli 0.16323 0.12314 1.326 0.19359
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## Residual standard error: 0.2644 on 35 degrees of freedom
## (5 observations effacées parce que manquantes)
## Multiple R-squared: 0.8231, Adjusted R-squared: 0.808
## F-statistic: 54.29 on 3 and 35 DF, p-value: 3.006e-13Visualization of middle ear volumetric measurements as a function of skull length
par(las = 1)
# Stapes
plot(log(V_st)~log(SL), data = data.rod,
main = "Stapes",
col = col.loco, bg = col.loco, pch = pch.clade)
text(log(data.rod$SL), log(data.rod$V_st),
labels = data.rod$Abbr, col = col.loco, pos = 4, cex = .7)
lines(data.rod.st.mod1$fitted.values~data.rod.st.mod1$model$`log(SL)`,
col = "red", lty = 1, lwd = 1)
# Incus
plot(log(V_in)~log(SL), data = data.rod,
main = "Incus",
col = col.loco, bg = col.loco, pch = pch.clade)
text(log(data.rod$SL), log(data.rod$V_in),
labels = data.rod$Abbr, col = col.loco, pos = 4, cex = .7)
lines(data.rod.in.mod1$fitted.values~data.rod.in.mod1$model$`log(SL)`,
col = "red", lty = 1, lwd = 1)
# malleus
plot(log(V_ma)~log(SL), data = data.rod,
main = "Malleus",
col = col.loco, bg = col.loco, pch = pch.clade)
text(log(data.rod$SL), log(data.rod$V_ma),
labels = data.rod$Abbr, col = col.loco, pos = 4, cex = .7)
lines(data.rod.ma.mod1$fitted.values~data.rod.ma.mod1$model$`log(SL)`,
col = "red", lty = 1, lwd = 1)
# Malleus + incus
plot(log(V_ma+V_in)~log(SL), data = data.rod,
main = "Malleus + Incus",
col = col.loco, bg = col.loco, pch = pch.clade)
text(log(data.rod$SL), log(data.rod$V_ma+data.rod$V_in),
labels = data.rod$Abbr, col = col.loco, pos = 4, cex = .7)
lines(data.rod.main.mod1$fitted.values~data.rod.main.mod1$model$`log(SL)`,
col = "red", lty = 1, lwd = 1)
Phylogenetic analyses
Notes
- The tree is a consensus tree of the 1000 trees downloaded from https://vertlife.org/phylosubsets/ on 2025-01-20 (see
script
Rodentia_PhylTree.Rfor the computation of the consensus tree).
- Because the exact taxa used here could not always be found in the VertLife database, we choose the closest relatives of the absent taxa in that database. Also, the Linnean names in the data base were not always exactly the same as what we used. Therefore, we had to modify some taxa names in the tree branch tips to get an exact correspondence.
Tree and data preparation
Load and prepare consensus tree
Load consensus tree
rod.tree <- read.nexus("RodentiaTree.nex")
plot(rod.tree)
Identify modified taxa names in the data base
modif <- which(!is.na(Rodentia_IE$phylTree)) # modified taxa names
data.rod$LinneanName[modif] # real names of taxa## [1] "Anomalurops_beecrofti" "Dremomys_pernyi"
## [3] "Eutamias_sibiricus" "Eutamias_sp."
## [5] "Geosciurus_inauris" "Graphiurus_parvus"
## [7] "Hylopetes_sagitta" "Iomys_thompsoni"
## [9] "Neotamias_townsendii" "Prasadsciurus_pennantii"Rodentia_IE$phylTree[modif] # names used in the phylogenetic tree## [1] "Anomalurus_beecrofti" "Dremomys_pernyi" "Tamias_sibiricus"
## [4] "Tamias_sibiricus" "Xerus_inauris" "Graphiurus_kelleni"
## [7] "Hylopetes_lepidus" "Iomys_horsfieldii" "Tamias_townsendii"
## [10] "Funambulus_pennantii"Modify branch tip names in the tree
tips.ini <- rod.tree$tip.label # tree branch tips
tips <- tips.ini
for (i in 1:length(tips)) {
# Find taxa names to modify in the tree
if (tips.ini[i] %in% Rodentia_IE$phylTree[modif]) {
spi <- which(Rodentia_IE$phylTree[modif] == tips.ini[i])[1]
tips[i] <- data.rod$LinneanName[modif[spi]]
}
}
#print(cbind(tips.ini, tips))Check congruence between taxa names
# extant taxa
unb <- which(data.rod$Loco == "unb") # fossil taxa
taxa.noFos <- data.rod$LinneanName[-unb]
all.equal(sort(tips), unique(taxa.noFos))## [1] "Lengths (41, 42) differ (string compare on first 41)"
## [2] "30 string mismatches"# extant taxa without Eutamias sp.
spi <- which(data.rod$LinneanName == "Eutamias_sp.")
all.equal(sort(tips), unique(data.rod$LinneanName[-c(unb, spi)]))## [1] TRUE#print(cbind(sort(tips), unique(data.rod$LinneanName[-c(unb, spi)])))Replace tip names in the tree
rod.tree$tip.label <- tipsPrepare data for phylogenetic analysis
New data set: no fossil
# Find fossil
fos <- which(data.rod$Loco == "unb")
# New data set: no fossil
data.rodPhylo <- data.rod[-fos,]
data.rodPhylo.sl <- data.rod.sl[-fos,]Find duplicates
# Find Eutamias sp.
spi <- which(data.rodPhylo$LinneanName == "Eutamias_sp.")
data.rodPhylo$LinneanName[spi] <- "Eutamias_sibiricus"
# Duplicated species names
dupl <- which(duplicated(data.rodPhylo$LinneanName))Average duplicated specimens (only when 2 specimens of the same taxon), as well as Eutamias sp. and Eutamias sibiricus
# Variables to average
varAver <- 8:ncol(data.rod)
# Initialization
uni <- dupl
data.aver <- data.rodPhylo[dupl, varAver]
# Compute average values
for (i in 1:length(dupl)) {
spi <- which(data.rodPhylo$LinneanName == data.rodPhylo$LinneanName[dupl[i]])
uni[i] <- spi[1] #
data.aver[i, ] <- apply(data.rodPhylo[spi, varAver], 2, mean) # average
}
# Replace by the mean in the data set for phylogenetic analyses
data.rodPhylo[uni, varAver] <- data.aver
# Remove duplicated
data.rodPhylo <- data.rodPhylo[-dupl, ]
# Give Linnean names for row names
rownames(data.rodPhylo) <- data.rodPhylo$LinneanNameCheck congruence between taxa names
all.equal(rownames(data.rodPhylo), sort(rod.tree$tip.label))## [1] TRUE#print(cbind(rownames(data.rodPhylo), sort(rod.tree$tip.label)))Compute the phylogenetic signal
For one variable: Blomberg’s K
Example: skull length
sl <- setNames(data.rodPhylo$SL, rownames(data.rodPhylo))
phylosig(rod.tree, sl, method = "K", test = T)##
## Phylogenetic signal K : 0.295812
## P-value (based on 1000 randomizations) : 0.05For several variables (no volumes): Kmult (Adams 2014)
Prepare data set (not standardized):
vari <- which(names(data.rodPhylo) == "SL") # find variable SL
ROD <- as.matrix(data.rodPhylo[, vari:ncol(data.rodPhylo)]) # select only numerical variables
ROD.std <- apply(ROD, 2, scale) # center and scale
rownames(ROD.std) <- rownames(ROD)Phylogenetic signal for all variables except volumes and skull length:
# Select volumes
varv <- grep("V_", colnames(ROD.std))
# Not standardized
physignal(ROD.std[, -c(1, varv)], phy = rod.tree) # without SL##
## Call:
## physignal(A = ROD.std[, -c(1, varv)], phy = rod.tree)
##
##
##
## Observed Phylogenetic Signal (K): 0.4156
##
## P-value: 0.001
##
## Based on 1000 random permutations
##
## Use physignal.z to estimate effect size.For several variables (with volumes): Kmult (Adams 2014)
Specimens with missing volumes
sp_miss <- rep(F, nrow(ROD))
for (i in 1:length(sp_miss)){
if (anyNA(ROD[i, ]) == T) { sp_miss[i] <- T }
}
spi <- which(sp_miss == T)
rownames(ROD)[spi]## [1] "Anomalurops_beecrofti" "Cynocephalus_volans" "Cynomys_ludovicianus"
## [4] "Glirulus_japonicus" "Rattus_rattus" "Urocitellus_undulatus"Remove species from tree:
rod.tree.forVol <- drop.tip(rod.tree, rownames(ROD)[spi])Phylogenetic signal for volumes (IE excluded because redundant with SCC and CO)
varv.noIE <- which(colnames(ROD.std) %in% c("V_SCC", "V_CO", "V_ma", "V_in", "V_st"))
physignal(ROD.std[-spi, varv.noIE], phy = rod.tree.forVol)##
## Call:
## physignal(A = ROD.std[-spi, varv.noIE], phy = rod.tree.forVol)
##
##
##
## Observed Phylogenetic Signal (K): 0.2841
##
## P-value: 0.087
##
## Based on 1000 random permutations
##
## Use physignal.z to estimate effect size.Phylogenetic signal for all variables except volumes and skull length:
varIE <- which(colnames(ROD.std) == "V_IE")
# Not standardized
physignal(ROD.std[-spi, -c(1, varIE)], phy = rod.tree.forVol)##
## Call:
## physignal(A = ROD.std[-spi, -c(1, varIE)], phy = rod.tree.forVol)
##
##
##
## Observed Phylogenetic Signal (K): 0.3466
##
## P-value: 0.015
##
## Based on 1000 random permutations
##
## Use physignal.z to estimate effect size.