Leitura de montagem do arquivo de dados:
DADOS = read.table("dados_2.csv", dec = ",", sep = ";", header = TRUE)
ncol(DADOS)
## [1] 11
rownames(DADOS) = DADOS[,1]
DADOS[,1] = NULL
DADOS
## NDF NDM NVP CMV LARGV ESPSS NLV NSV P100G PRODP
## UFPI-650 73.50 115.50 78.50 85.63 19.91 8.55 2.60 2.53 65.58 172.20
## UFPI-651 66.00 104.00 103.00 88.70 19.98 9.37 3.10 2.80 51.29 104.99
## UFPI-652 77.67 135.00 4.67 75.29 16.63 6.61 2.70 2.67 51.76 8.47
## UFPI-653 70.63 110.88 77.63 82.21 18.68 8.43 2.82 2.61 54.68 102.40
## UFPI-654 80.00 112.75 105.00 80.86 17.81 8.57 2.74 2.69 60.01 147.22
## UFPI-655 69.40 115.20 12.20 73.40 15.96 7.33 2.56 2.52 49.49 28.14
## UFPI-656 78.14 128.29 21.29 70.63 16.89 8.51 2.66 2.57 102.18 26.37
## UFPI-657 81.75 127.00 33.50 78.84 18.67 7.73 2.49 2.44 96.01 66.56
## UFPI-658 67.00 103.00 52.50 82.57 17.67 9.87 2.50 2.50 61.05 77.76
## UFPI-659 71.88 120.00 43.00 82.42 17.28 8.02 2.59 2.59 62.47 68.63
## UFPI-702 78.00 117.25 25.50 80.55 18.38 7.39 2.78 2.65 49.03 37.69
## UFPI-661 80.29 122.71 21.00 74.32 15.59 7.51 2.29 2.22 53.51 27.43
## UFPI-662 73.56 118.00 46.44 76.26 17.40 7.80 2.54 2.33 46.76 71.72
## UFPI-663 73.33 112.33 35.33 83.20 18.81 9.91 2.73 2.40 55.01 46.21
## UFPI-664 74.50 120.75 64.50 85.59 18.17 8.18 2.88 2.75 66.56 88.89
## UFPI-665 81.20 129.40 59.00 81.26 18.36 7.73 2.56 2.46 56.82 84.73
## UFPI-666 70.78 115.89 70.67 79.13 18.46 7.73 2.38 2.29 55.29 132.89
## UFPI-667 70.50 110.50 231.50 94.31 23.79 8.42 3.25 3.15 68.55 545.57
## UFPI-668 66.00 109.00 12.00 79.00 18.99 7.02 2.70 2.65 38.55 13.70
## UFPI-669 71.00 119.00 20.00 76.41 19.63 8.78 2.80 2.60 45.66 15.92
## UFPI-670 76.80 124.20 20.00 75.27 18.09 7.80 2.65 2.52 42.05 16.54
## UFPI-672 77.75 123.00 116.50 88.67 19.04 8.58 2.65 2.55 70.15 212.83
## UFPI-673 78.60 125.60 92.70 88.18 20.27 8.84 2.67 2.60 53.88 105.26
## UFPI-674 76.50 127.00 236.50 82.64 19.28 7.38 2.65 2.65 71.98 418.05
## UFPI-675 80.50 111.50 43.75 67.18 17.65 7.62 2.44 2.23 41.65 40.30
## UFPI-676 71.60 139.20 152.80 90.82 19.54 7.57 2.69 2.50 69.67 211.22
## UFPI-677 73.50 127.00 22.50 71.72 16.82 3.98 2.45 2.35 62.18 27.65
## UFPI-678 73.50 128.83 11.33 75.18 17.86 6.82 2.40 2.30 47.32 15.94
## UFPI-679 74.50 109.00 14.50 76.71 17.78 6.92 2.65 2.65 38.89 21.25
## UFPI-680 72.25 124.50 39.00 76.71 16.94 7.81 2.24 2.06 55.96 51.53
## UFPI-681 74.43 129.71 51.14 81.32 17.68 6.87 2.80 2.76 51.83 64.38
## UFPI-682 80.67 143.67 60.00 84.31 20.47 9.19 2.40 2.41 55.12 70.53
## UFPI-701 51.00 85.00 3.00 50.23 16.21 5.52 1.25 1.25 57.50 4.38
## UFPI-684 65.75 116.63 63.75 75.12 17.98 7.84 2.18 3.10 52.78 43.50
## UFPI-685 92.67 127.33 27.00 80.69 18.79 7.15 2.70 2.47 48.30 29.18
## UFPI-686 71.00 106.25 37.00 79.33 18.74 7.35 2.60 2.55 58.49 61.25
## UFPI-687 81.00 131.17 39.33 81.20 17.55 8.00 2.85 2.78 46.21 42.90
## UFPI-705 58.80 111.60 20.40 77.25 17.35 7.91 2.42 2.34 60.03 33.72
## UFPI-689 73.00 111.60 65.00 80.10 17.55 7.89 2.40 2.40 60.39 91.97
## UFPI-690 75.00 122.50 62.00 78.57 18.35 7.55 2.40 2.40 44.88 52.49
## UFPI-691 64.50 113.75 44.25 82.72 17.32 8.89 2.61 2.51 49.26 39.17
## UFPI-692 77.60 129.80 16.40 78.17 17.34 8.08 2.72 2.48 45.49 19.47
## UFPI-693 75.20 121.60 47.00 75.30 17.32 8.51 2.26 2.24 52.72 41.24
## UFPI-694 71.60 132.80 13.20 76.26 17.49 8.20 2.89 2.81 44.38 25.05
## UFPI-695 69.86 119.57 40.14 77.49 18.08 7.36 2.31 2.18 50.17 39.95
## UFPI-696 76.00 126.33 138.33 81.18 18.66 7.68 2.73 2.57 62.86 108.41
## UFPI-697 67.50 115.00 20.50 77.91 17.89 8.17 2.65 2.60 45.64 16.42
## UFPI-698 74.00 137.00 19.00 79.80 18.12 8.07 2.37 2.27 51.10 27.73
Análise de componentes principais:
library(factoextra)
## Loading required package: ggplot2
## Welcome! Want to learn more? See two factoextra-related books at https://goo.gl/ve3WBa
res.pca <- prcomp(DADOS[,1:10], scale = TRUE)
Explicação dos componentes:
summary(res.pca)
## Importance of components:
## PC1 PC2 PC3 PC4 PC5 PC6 PC7
## Standard deviation 2.0851 1.3368 1.1498 0.91081 0.79383 0.62471 0.5567
## Proportion of Variance 0.4348 0.1787 0.1322 0.08296 0.06302 0.03903 0.0310
## Cumulative Proportion 0.4348 0.6135 0.7457 0.82863 0.89165 0.93068 0.9617
## PC8 PC9 PC10
## Standard deviation 0.43920 0.36546 0.23837
## Proportion of Variance 0.01929 0.01336 0.00568
## Cumulative Proportion 0.98096 0.99432 1.00000
res.pca
## Standard deviations (1, .., p=10):
## [1] 2.0851312 1.3367914 1.1497725 0.9108093 0.7938331 0.6247149 0.5567349
## [8] 0.4391966 0.3654567 0.2383706
##
## Rotation (n x k) = (10 x 10):
## PC1 PC2 PC3 PC4 PC5 PC6
## NDF 0.1611189 0.53665829 -0.32687772 0.02515156 -0.24266564 0.694734982
## NDM 0.1289793 0.54426399 -0.39004769 -0.01115511 -0.18173457 -0.646053575
## NVP 0.3747010 -0.32609141 -0.23839289 -0.17520086 -0.14039218 -0.002810862
## CMV 0.4316746 0.07249944 0.12329112 0.08408376 -0.11353799 -0.250008955
## LARGV 0.3847601 -0.18504882 0.06805652 -0.12017119 -0.35429336 0.010149917
## ESPSS 0.2425423 -0.01209199 0.36388592 0.76843878 -0.26788746 0.016677714
## NLV 0.3755024 0.25254198 0.26923427 -0.11643552 0.34517701 0.164914723
## NSV 0.3563675 0.20374296 0.26719089 -0.17606389 0.52829056 -0.058672148
## P100G 0.1421831 -0.18763768 -0.57269384 0.51446502 0.52402836 0.019505979
## PRODP 0.3682095 -0.35957889 -0.24511411 -0.21750468 -0.07316977 0.077748097
## PC7 PC8 PC9 PC10
## NDF -0.03900213 0.02302307 0.186192518 0.01716799
## NDM -0.04181130 0.17794047 -0.223600937 0.03253224
## NVP -0.44073917 0.06879986 0.009118223 -0.66854440
## CMV 0.01972321 -0.68161965 0.487671391 0.08897740
## LARGV 0.76944960 0.26771076 -0.026884123 -0.09258779
## ESPSS -0.24601936 0.25184510 -0.138936227 0.05309718
## NLV 0.05721647 -0.31179846 -0.667354149 -0.13030191
## NSV -0.09227349 0.51074116 0.416707146 0.05960220
## P100G 0.26750804 -0.04915237 0.019847749 -0.05066480
## PRODP -0.25722313 0.05368975 -0.194941195 0.71364458
fviz_eig(res.pca)
Distribuição dos genótipos e variáveis:
fviz_pca_biplot(res.pca, repel = TRUE,
col.var = "#2E9FDF", # Variables color
col.ind = "#696969" # Individuals color
)
Contribuição das variáveis:
fviz_pca_contrib(
res.pca,
choice = c("var"),
axes = 1,
fill = "steelblue",
color = "steelblue",
)
## Warning in fviz_pca_contrib(res.pca, choice = c("var"), axes = 1, fill =
## "steelblue", : The function fviz_pca_contrib() is deprecated. Please use the
## function fviz_contrib() which can handle outputs of PCA, CA and MCA functions.
Contribuição dos genótipos:
fviz_pca_contrib(
res.pca,
choice = c("ind"),
axes = 1,
fill = "steelblue",
color = "steelblue",
)
## Warning in fviz_pca_contrib(res.pca, choice = c("ind"), axes = 1, fill =
## "steelblue", : The function fviz_pca_contrib() is deprecated. Please use the
## function fviz_contrib() which can handle outputs of PCA, CA and MCA functions.
Seleção dos genótipos mais importantes:
higth_gens = c("UFPI-701","UFPI-667","UFPI-674",
"UFPI-676","UFPI-651","UFPI-677",
"UFPI-672","UFPI-673","UFPI-661")
Nova PCA apenas com os genótipos selecionados:
res.pca_2 <- prcomp(DADOS[higth_gens,1:10], scale = TRUE)
res.pca_2
## Standard deviations (1, .., p=9):
## [1] 2.461762e+00 1.297954e+00 1.205166e+00 6.264450e-01 4.628049e-01
## [6] 3.156426e-01 2.927361e-01 1.032825e-01 8.215651e-16
##
## Rotation (n x k) = (10 x 9):
## PC1 PC2 PC3 PC4 PC5 PC6
## NDF -0.2325917 0.58127105 -0.06858055 -0.190850490 0.56924360 0.009876573
## NDM -0.2121588 0.55886007 -0.31454408 -0.038750999 -0.39336962 -0.447701298
## NVP -0.3563353 -0.26523182 -0.19614848 -0.182244219 0.12878613 -0.309706374
## CMV -0.3861234 0.12775355 0.15809138 -0.004141786 -0.37524813 0.128134763
## LARGV -0.3432111 -0.32392779 0.14236888 0.211853345 -0.20633546 -0.459202611
## ESPSS -0.2628131 -0.05254993 0.49913964 -0.731432993 -0.11604005 0.139866371
## NLV -0.3726960 0.08463487 0.20244148 0.418099036 -0.02653442 0.344674388
## NSV -0.3845702 0.07841646 0.13986703 0.368931669 0.17535641 0.200918637
## P100G -0.2051633 -0.15498898 -0.66509341 -0.184145165 -0.26935672 0.531588415
## PRODP -0.3302581 -0.34366554 -0.24614579 -0.064354144 0.45141825 -0.122249048
## PC7 PC8 PC9
## NDF 0.37012860 -0.24704296 -0.02368668
## NDM -0.18656605 0.24965964 -0.19085368
## NVP -0.56387204 -0.50431439 0.10506633
## CMV 0.07861890 0.17790314 0.66026816
## LARGV 0.60802603 -0.21720259 -0.20401732
## ESPSS -0.02910378 0.06627641 -0.22454817
## NLV -0.26407411 0.07460371 -0.57051324
## NSV -0.09204281 -0.13656712 0.29262021
## P100G 0.23363908 -0.16296448 -0.11207901
## PRODP 0.02698908 0.69879472 0.01738490
summary(res.pca_2)
## Importance of components:
## PC1 PC2 PC3 PC4 PC5 PC6 PC7
## Standard deviation 2.462 1.2980 1.2052 0.62644 0.46280 0.31564 0.29274
## Proportion of Variance 0.606 0.1685 0.1452 0.03924 0.02142 0.00996 0.00857
## Cumulative Proportion 0.606 0.7745 0.9197 0.95898 0.98040 0.99036 0.99893
## PC8 PC9
## Standard deviation 0.10328 8.216e-16
## Proportion of Variance 0.00107 0.000e+00
## Cumulative Proportion 1.00000 1.000e+00
fviz_pca_biplot(res.pca_2, repel = TRUE,
col.var = "#2E9FDF", # Variables color
col.ind = "#696969" # Individuals color
)
Análise discriminante: Pacotes:
library(ggplot2)
library(dplyr)
##
## Attaching package: 'dplyr'
## The following objects are masked from 'package:stats':
##
## filter, lag
## The following objects are masked from 'package:base':
##
## intersect, setdiff, setequal, union
library(adegenet)
## Loading required package: ade4
## Registered S3 method overwritten by 'spdep':
## method from
## plot.mst ape
##
## /// adegenet 2.1.3 is loaded ////////////
##
## > overview: '?adegenet'
## > tutorials/doc/questions: 'adegenetWeb()'
## > bug reports/feature requests: adegenetIssues()
Como não existem grupos previamente informados, foi realizada busca por grupos ppor meio do algoritmo “K-means”, utilizando como critério de decisão o valor do parâmetro BIC (Bayesian Information Criterion):
clusters = find.clusters(DADOS,
choose.n.clust = FALSE,
perc.pca = 80)
## Choose the number PCs to retain (>= 1):
clusters$grp
## UFPI-650 UFPI-651 UFPI-652 UFPI-653 UFPI-654 UFPI-655 UFPI-656 UFPI-657
## 1 1 2 2 1 2 2 2
## UFPI-658 UFPI-659 UFPI-702 UFPI-661 UFPI-662 UFPI-663 UFPI-664 UFPI-665
## 2 2 2 2 2 2 1 2
## UFPI-666 UFPI-667 UFPI-668 UFPI-669 UFPI-670 UFPI-672 UFPI-673 UFPI-674
## 2 1 2 2 2 1 1 1
## UFPI-675 UFPI-676 UFPI-677 UFPI-678 UFPI-679 UFPI-680 UFPI-681 UFPI-682
## 2 1 2 2 2 2 2 2
## UFPI-701 UFPI-684 UFPI-685 UFPI-686 UFPI-687 UFPI-705 UFPI-689 UFPI-690
## 3 2 2 2 2 2 2 2
## UFPI-691 UFPI-692 UFPI-693 UFPI-694 UFPI-695 UFPI-696 UFPI-697 UFPI-698
## 2 2 2 2 2 1 2 2
## Levels: 1 2 3
De acordo com a analise foram encontrados 3 grupos, que foram então usados para auxiliar na análise Dicriminante sob componentes principais (DACP):
myCol = c("yellow","red","blue")
dapc = dapc(DADOS[,1:10],n.pca = 3, n.da =2, grp = clusters$grp)
Gráfico de espalhamento dos genótipos (3 componentes principais e duas funções discriminantes):
scatter(dapc, label.inds = list(air = 2, pch = NA, cex = 0.7), col = myCol, scree.da=FALSE,leg=TRUE, posi.leg="topleft", txt.leg=paste("Grupo",1:3))
Gráfico 2 (análise de consistência populacional):
compoplot(dapc,
legend = FALSE,
label.inds = list(air = 0.5, cex = 0.1),
bg = transp("white"),
border = NA,
show.lab = TRUE,
ncol=2 , col = myCol
)