2020-10-16

生态表形

1 研究概述

在白垩纪末期和翼龙灭绝之前，鸟类与翼龙有过同时存在，这两个种群共存了大约90百万年。

一种观点认为，鸟类和翼龙在当时存在生态上竞争，由于鸟类与小型翼龙竞争，导致整个白垩纪的小型翼龙的逐渐体型增大，翼龙的多样性下降，支持这一观点的证据包括晚侏罗纪和白垩纪沉积物中鸟类和翼龙的共存，从侏罗纪末期开始翼龙的体型最小值和最大值逐渐增大，饮食相似。有趣的是，它们的共存也被用来暗示生态分离。

另一种观点认为，通过对鸟类和翼龙的骨骼形态比较研究发现，鸟类与翼龙在形态空间几乎没有重叠。这些研究比较了构成翅膀和腿的同源骨骼元素的比例，并得出结论，由于形态空间的分离，缺乏生态竞争的证据。

对于鸟类和翼龙是互相抢夺生活领地，还是在生活领地中共存，在科研中存在分歧。通过对鸟类和翼龙的个体相关数据进行主成分分析，发现鸟类和翼龙似乎在整个共存时期都采用了独特的生态策略，而不是一个群体取代另一个群体。

2 翅膀对比

翼龙和鸟类的翅膀是以非常不同的方式构建的，反映了它们长期独立的进化历史。翼龙有一个非常细长的第四个骨，它与手臂的其余部分一起支撑着一个向下延伸到后肢的膜。在鸟类中，手部的骨头被缩小并融合形成心皮，羽毛形成机翼表面以及机翼前缘的大部分。因此，初级羽毛大幅增加了功能性鸟类翅膀长度高达100%；相比之下，翼龙翅膀的整个长度只能从机翼骨骼测量。因此，这些研究基本上比较了翼龙的全翅和半翅。

3 数据读取及删除缺失值

3.1 加载包

library(readxl)
library(car)

3.2 读取鸟类数据及删除缺失值

birds <- read_excel('C:\\Users\\dell\\Desktop\\北大R语言\\Ecology_birds_and_pteryosaur(1).xlsx')
str(birds)#查看数据

## Classes 'tbl_df', 'tbl' and 'data.frame':    175 obs. of  13 variables:
##  $ X__1                       : chr  "Archaeopteryx_lithographica" "Archaeorhynchus_spathula" "Cathayornis_sp." "Concornis_lacustris" ...
##  $ Specimen number            : chr  "WDC CSG 100" "IVPP V14287" "STM A11-58" "LH2814" ...
##  $ X__2                       : chr  "Archaeopterygidae" "Ornithuromorpha" "Enantiornithes" "Enantiornithes" ...
##  $ Skull length               : chr  "52.9" "NA" "-" "NA" ...
##  $ Mandible length            : chr  "NA" "NA" "-" "NA" ...
##  $ Mandible depth             : chr  "NA" "NA" "-" "NA" ...
##  $ Humerus                    : chr  "56.9" "53" "21.12" "33.46" ...
##  $ Radius/Ulna                : chr  "50.9" "56" "23.25" "34.22" ...
##  $ Manus (CMC + Ph1D2 + Ph2D2): chr  "53.4" "50" "18.87" "25.58" ...
##  $ Average primary feather    : chr  "113" "125" "37.58" "47.7" ...
##  $ Femur                      : chr  "50.3" "37" NA "24.1" ...
##  $ Tibiotarsus                : chr  "74.599999999999994" "42" NA "37.090000000000003" ...
##  $ Tarsometatarsus            : chr  "39.6" "20" NA "22.13" ...

for(i in 4 : dim(birds)[2]){
birds[, i] <- as.numeric(unlist(birds[, i]))
}#将4-13列变量类型改为数值型
birds01 <- is.na(birds)#将缺失值记为TURE, 否则是FALSE
head(birds01)

##       X__1 Specimen number  X__2 Skull length Mandible length
## [1,] FALSE           FALSE FALSE        FALSE            TRUE
## [2,] FALSE           FALSE FALSE         TRUE            TRUE
## [3,] FALSE           FALSE FALSE         TRUE            TRUE
## [4,] FALSE           FALSE FALSE         TRUE            TRUE
## [5,] FALSE           FALSE FALSE         TRUE            TRUE
## [6,] FALSE           FALSE FALSE        FALSE           FALSE
##      Mandible depth Humerus Radius/Ulna Manus (CMC + Ph1D2 + Ph2D2)
## [1,]           TRUE   FALSE       FALSE                       FALSE
## [2,]           TRUE   FALSE       FALSE                       FALSE
## [3,]           TRUE   FALSE       FALSE                       FALSE
## [4,]           TRUE   FALSE       FALSE                       FALSE
## [5,]           TRUE   FALSE       FALSE                       FALSE
## [6,]          FALSE   FALSE       FALSE                       FALSE
##      Average primary feather Femur Tibiotarsus Tarsometatarsus
## [1,]                   FALSE FALSE       FALSE           FALSE
## [2,]                   FALSE FALSE       FALSE           FALSE
## [3,]                   FALSE  TRUE        TRUE            TRUE
## [4,]                   FALSE FALSE       FALSE           FALSE
## [5,]                   FALSE  TRUE        TRUE            TRUE
## [6,]                   FALSE FALSE       FALSE           FALSE

apply(birds01, 2, sum) / dim(birds)[1]#查看各列缺失值比例

##                        X__1             Specimen number 
##                  0.00000000                  0.01142857 
##                        X__2                Skull length 
##                  0.00000000                  0.60571429 
##             Mandible length              Mandible depth 
##                  0.77714286                  0.80000000 
##                     Humerus                 Radius/Ulna 
##                  0.31428571                  0.34857143 
## Manus (CMC + Ph1D2 + Ph2D2)     Average primary feather 
##                  0.53142857                  0.86285714 
##                       Femur                 Tibiotarsus 
##                  0.37142857                  0.36571429 
##             Tarsometatarsus 
##                  0.31428571

birds <- birds[, -10]#删除列Average primary feather
birds <- birds[complete.cases(birds), ]#删除有缺失值的行
dim(birds)

## [1] 26 12

通过str函数可以发现鸟类数据集共有175条数据，13个变量，所有变量的类型都为字符串型，部分数据还存在缺失值。通过apply函数查看每个变量缺失数据所占比例，发现变量Average primary feather的缺失值比例达到86.28%，所以删除变量Average primary feather。将存在缺失值的数据删除后，总共保留了26条数据，12个变量。

3.3 读取翼龙数据及删除缺失

pterosaurs <- read_excel('C:\\Users\\dell\\Desktop\\北大R语言\\Ecology_birds_and_pteryosaur(2).xlsx')
str(pterosaurs)#查看数据

## Classes 'tbl_df', 'tbl' and 'data.frame':    361 obs. of  16 variables:
##  $ X__1                : chr  "Aetodactylus_halli" "Anhanguera_piscator" "Anhanguera_spielbergi" "Anurognathus_ammoni" ...
##  $ Morphotype          : chr  "Pterodactyloid" "Pterodactyloid" "Pterodactyloid" "Basal" ...
##  $ Grouping            : chr  "Ornithocheridae?" "Anhangueridae" "Anhangueridae" "Anurognathidae" ...
##  $ skull length        : chr  "NA" "617" "712" "NA" ...
##  $ Mandible length     : chr  "384" "533" "606" "NA" ...
##  $ Mandible depth      : chr  NA "47" NA "NA" ...
##  $ Humerus             : chr  "NA" "255" "290" "18.2" ...
##  $ Radius/ulna         : chr  "NA" "390" "410" "25.5" ...
##  $ Wing metacarpal     : chr  "NA" "256" "NA" "5" ...
##  $ Wing phalanx 1      : chr  "NA" "NA" "NA" "29.1" ...
##  $ Wing phalanx 2      : chr  "NA" ">350" "NA" "22.5" ...
##  $ Wing phalanx 3      : chr  "NA" ">218" "NA" "12.7" ...
##  $ Wing phalanx 4      : chr  "NA" ">157" "NA" "-" ...
##  $ Femur               : chr  "NA" "234" "285" "14.5" ...
##  $ Tibia               : chr  "NA" "280" "355" "20.2" ...
##  $ Metatarsal (longest): chr  "NA" NA NA "8.5" ...

for(i in 4 : dim(pterosaurs)[2]){
pterosaurs[, i] <- as.numeric(unlist(pterosaurs[, i]))
}#将4-16列变量类型改为数值型
pterosaurs <- pterosaurs[complete.cases(pterosaurs), ]#删除有缺失值的行
dim(pterosaurs)

## [1] 19 16

通过str函数可以发现翼龙数据集共有361条数据，16个变量，所有变量的类型都为字符串型，部分数据还存在缺失值。将存在缺失值的数据删除后，总共保留了19条数据，16个变量。

4 数据预处理及数据合并

本次分析选取鸟类和翼龙共有的8个类似变量。1.femur length(股骨长度;2.mandible length(下颌长度);3.mandible depth(下颌骨深度);4.brachial length(臂长);5.antebrachial length(前臂长度);6.distal wing length(远端翼长度);7.tibia length(胫长);8.metatarsal length(跖骨长度)。通过对原始数据进行预处理，我们将可以得到这8个变量。

通过查阅相关资料可知，前肢分为3个功能单元：brachial(肱)、antebrachial(前臂)和distal wing(远端翼)。3个功能单元与原始数据关系是，翼龙的单位组成为brachial(肱)=humerus(肱骨)、antebrachial(前臂)=ulna(尺骨)+metacarpal IV (掌骨IV)和distal wing(远端翼)=digit IV(四个指骨)。鸟类的单位为brachial(肱)=humerus(肱骨)、antebrachial(前臂)=ulna(尺骨)和distal wing(远端翼)=carpometacarpus(腕足类)+digit II(第II位)+mean primary feather length(原始羽毛平均长度)

4.1 鸟类数据预处理

新建一个new_bids数据框，鸟类的8个变量与birds数据集中变量关系如下：

1.新数据集中变量femur length = birds数据集中变量Femur

2.新数据集中变量mandible length = birds数据集中变量Mandible length

3.新数据集中变量mandible depth = birds数据集中变量Mandible depth

4.新数据集中变量brachial length = birds数据集中变量Humerus

5.新数据集中变量antebrachial length = birds数据集中变量Radius/Ulnar

6.新数据集中变量distal wing length = birds数据集中变量Manus (CMC + Ph1D2 + Ph2D2) + 10^(0.987 * log10(Manus (CMC + Ph1D2 + Ph2D2) + 0.344)

7.新数据集中变量tibia length = birds数据集中变量Tibiotarsus

8.新数据集中变量metatarsal length = birds数据集中变量Tarsometatarsus

new_birds <- data.frame() ; new_birds[1:nrow(birds), 'type'] <- 'birds'
new_birds[, 'femur length'] <- birds$Femur ; new_birds[, 'mandible length'] <- birds[, 'Mandible length']
new_birds[, 'mandible depth'] <- birds[, 'Mandible depth']
new_birds[, 'brachial length'] <- birds$Humerus#brachial = humerus
new_birds[, 'antebrachial length'] <- birds[, 'Radius/Ulna']#antebrachial = ulna
new_birds[, 'distal wing length'] <- birds[, 'Manus (CMC + Ph1D2 + Ph2D2)'] + 
10^(0.987 * log(birds[, 'Manus (CMC + Ph1D2 + Ph2D2)'], 10) + 0.344)
#distal wing = carpometacarpus + digit II + mean primary feather length.其中carpometacarpus + digit II = manus;log10(mean primary feather length) = 0.987(log10(manus)) + 0.344
new_birds[, 'tibia length'] <- birds$Tibiotarsus#tibia length = Tibiotarsus
new_birds[, 'metatarsal length'] <- birds$Tarsometatarsus#metatarsal length = Tarsometatarsus
head(new_birds)

##    type femur length mandible length mandible depth brachial length
## 1 birds         23.0          21.930           1.64           22.00
## 2 birds         22.0          25.640           1.83           25.96
## 3 birds         60.0          58.030           3.96           76.20
## 4 birds         20.0          31.400           2.49           23.28
## 5 birds         22.2          18.015           3.56           18.39
## 6 birds         52.6          42.300           4.30           63.50
##   antebrachial length distal wing length tibia length metatarsal length
## 1               27.00           69.28151         29.0              16.0
## 2               25.08           64.94978         38.0              22.0
## 3               82.10          216.25535         76.0              37.0
## 4               24.81           50.13944         25.5              14.0
## 5               21.45           62.47336         26.3              15.7
## 6               55.00          194.50373         68.5              37.0

4.2 翼龙数据预处理

新建一个new_pterosaurs数据框，翼龙的8个变量与pterosaurs数据集中变量关系如下：

1.新数据集中变量femur length = birds数据集中变量Femur

2.新数据集中变量mandible length = birds数据集中变量Mandible length

3.新数据集中变量mandible depth = birds数据集中变量Mandible depth

4.新数据集中变量brachial length = birds数据集中变量Humerus

5.新数据集中变量antebrachial length = birds数据集中变量Radius/Ulnar + Wing metacarpal

6.新数据集中变量distal wing lengt = birds数据集中变量Wing phalanx 1 + Wing phalanx 2 + Wing phalanx 3 + Wing phalanx 4

7.新数据集中变量tibia length = birds数据集中变量Tibia

8.新数据集中变量metatarsal length = birds数据集中变量Metatarsal (longest)

new_pterosaurs <- data.frame() ; new_pterosaurs[1:nrow(pterosaurs), 'type'] <- 'new_pterosaurs'
new_pterosaurs[, 'femur length'] <- pterosaurs$Femur ; new_pterosaurs[, 'mandible length'] <- pterosaurs[, 'Mandible length']
new_pterosaurs[, 'mandible depth'] <- pterosaurs[, 'Mandible depth']
new_pterosaurs[, 'brachial length'] <- pterosaurs$Humerus#brachial = humerus
new_pterosaurs[, 'antebrachial length'] <- pterosaurs[, 'Radius/ulna'] + pterosaurs[, 'Wing metacarpal']
#antebrachial = ulna + metacarpal IV.其中metacarpal IV = Wing metacarpal
new_pterosaurs[, 'distal wing length'] <- pterosaurs[, 'Wing phalanx 1'] + pterosaurs[, 'Wing phalanx 2'] +
pterosaurs[, 'Wing phalanx 3'] + pterosaurs[, 'Wing phalanx 4']
#distal wing = digit IV.其中sum of the phalanges of digit IV
new_pterosaurs[, 'tibia length'] <- pterosaurs$Tibia#tibia length = Tibia
new_pterosaurs[, 'metatarsal length'] <- pterosaurs[, 'Metatarsal (longest)']#metatarsal length = Metatarsal (longest)
head(new_pterosaurs)

##             type femur length mandible length mandible depth
## 1 new_pterosaurs         12.2           18.50          2.320
## 2 new_pterosaurs         33.4           63.00          2.515
## 3 new_pterosaurs         82.0          200.00         14.260
## 4 new_pterosaurs         38.0           70.00          5.370
## 5 new_pterosaurs         39.4           99.16          5.240
## 6 new_pterosaurs         40.0          115.00          5.690
##   brachial length antebrachial length distal wing length tibia length
## 1            14.5                31.5               64.1         16.5
## 2            28.1                86.4              136.6         51.1
## 3            79.0               206.0              445.0         82.0
## 4            50.0                87.0              345.0         47.0
## 5            40.4                80.5              203.7         49.8
## 6            44.0                90.0              215.0         54.0
##   metatarsal length
## 1               5.8
## 2              11.9
## 3              14.0
## 4              20.0
## 5              17.0
## 6              17.0

4.3 数据合并

data <- rbind(new_birds, new_pterosaurs)
dim(data)

## [1] 45  9

合并后的数据共有45条，9个变量。

5 主成分分析

data.pr <- princomp(data[, -1], cor = T)
summary(data.pr, loadings = T)

## Importance of components:
##                           Comp.1    Comp.2     Comp.3     Comp.4
## Standard deviation     2.5347354 1.0248493 0.47760076 0.37197867
## Proportion of Variance 0.8031104 0.1312895 0.02851281 0.01729602
## Cumulative Proportion  0.8031104 0.9344000 0.96291276 0.98020878
##                            Comp.5      Comp.6      Comp.7       Comp.8
## Standard deviation     0.28746255 0.234621615 0.113284198 0.0883993279
## Proportion of Variance 0.01032934 0.006880913 0.001604164 0.0009768051
## Cumulative Proportion  0.99053812 0.997419031 0.999023195 1.0000000000
## 
## Loadings:
##                     Comp.1 Comp.2 Comp.3 Comp.4 Comp.5 Comp.6 Comp.7
## femur length        -0.388                0.351 -0.262 -0.148  0.578
## mandible length     -0.363  0.329                0.149  0.837  0.163
## mandible depth      -0.375  0.142  0.237  0.168  0.793 -0.351       
## brachial length     -0.351 -0.220 -0.787  0.318               -0.211
## antebrachial length -0.381  0.204  0.172        -0.285        -0.740
## distal wing length  -0.371        -0.227 -0.833        -0.272  0.188
## tibia length        -0.378 -0.120  0.446  0.150 -0.408 -0.127       
## metatarsal length   -0.166 -0.874  0.210 -0.165  0.170  0.255       
##                     Comp.8
## femur length         0.549
## mandible length           
## mandible depth            
## brachial length     -0.253
## antebrachial length  0.392
## distal wing length        
## tibia length        -0.658
## metatarsal length    0.198

Proportion of Variance为方差贡献率;Cumulative Proportion为累计方差贡献率。可以看出第1主成分的方差贡献率是80.31%，第2主成分的方差贡献率是13.13%。第1主成分和第2主成分的累计方差贡献率为93.44%。Loadings中的矩阵分别对应主成分与各样本之间的系数关系。

pca_data <- predict(data.pr)
head(pca_data)

##          Comp.1       Comp.2      Comp.3     Comp.4      Comp.5
## [1,]  2.3267301  0.605487747  0.04387112 0.20222089 -0.02303431
## [2,]  2.0775191 -0.008524962  0.21419204 0.19024847  0.03159191
## [3,] -0.5744671 -1.526828781 -0.21481319 0.14824787 -0.33330280
## [4,]  2.3836331  0.847566576 -0.01319199 0.33073118  0.15860878
## [5,]  2.3471462  0.682841126  0.16765483 0.25173602  0.28985771
## [6,] -0.0279667 -1.546044421 -0.01265106 0.06418853 -0.06864320
##            Comp.6       Comp.7       Comp.8
## [1,] -0.050969522  0.043469381  0.070102195
## [2,]  0.122429758 -0.007571242 -0.037177601
## [3,]  0.134953314  0.050136109 -0.004393054
## [4,]  0.007017916 -0.002080233  0.011126752
## [5,] -0.191162569  0.070574130  0.095939486
## [6,]  0.055027219  0.167418358  0.002456426

各样本的主成分的值

dataEllipse(x = pca_data[1:26,1], y = pca_data[1:26,2], levels=0.95, xlab = 'PC1', ylab = 'PC2', col = 'blue',
pch = 2, xlim = c(-3, 3), ylim = c(-3,2), center.pch = FALSE)
par(new=TRUE)
dataEllipse(x = pca_data[27:45,1], y = pca_data[27:45,2], levels=0.65, xlab = 'PC1', ylab = 'PC2', col = 'red',
pch = 1, xlim = c(-3, 3), ylim = c(-3,2), center.pch = FALSE)
legend('bottomright', legend = c('Mesozoic brids','pterosaurs'), col = c('blue', 'red'), pch = c(2, 1), bty = "n")

从图中可以看出，鸟类与翼龙在第1主成分上没有明显差异性，而在第2主成分上有明显差异，在第2主成分中鸟类的主成分值都是小于翼龙的主成分值，这表明比起翼龙，鸟类的metatarsal length(跖骨长度)更长、brachial length(臂长)更长、mandible length(下颌长度)更短。

6 本章汇总

参数	类别	功能
readxl	函数包	加载readxl包
is.na	函数	判断是否为缺失值
apply	函数	实现对数据的循环、分组、过滤、类型控制等操作
complete.cases	函数	删除缺失值
princomp	函数	主成分分析
predict	函数	输出每组得分
dataEllipse	函数	置信椭圆
legend	函数	添加图例

7 参考文献

[1] Nicholas R. Chan.Morphospaces of functionally analogous traits show ecological separation between birds and pterosaurs[J].PROCEEDINGS OF THE ROYAL SOCIETY B

[2] https://www.docin.com/p-1935139116.html

源文件下载在线调试

返回：数据分析教程案例, R 语言