In this worked example you will replicate a PCA on a published dataset.
The example is split into 2 Parts:
In this Data Preparation phase, you will do the following things:
vcfR::read.vcfR())vcfR::extract.gt())t())for()
loop).csv file
for the next step (write.csv())This worked example is based on a paper in the journal Molecular Ecology from 2017 by Jennifer Walsh titled Subspecies delineation amid phenotypic, geographic and genetic discordance in a songbird.
The study investigated variation between two bird species in the genus Ammodramus: A. nenlsoni and A. caudacutus.
The species A. nenlsoni has been divided into 3 sub-species: A. n. nenlsoni, A.n. alterus, and A n. subvirgatus. The other species, A. caudacutus, has been divided into two subspecies, A.c. caudacutus and A.c. diversus.
The purpose of this study was to investigate to what extent these five subspecies recognized by taxonomists are supported by genetic data. The author’s collected DNA from 75 birds (15 per subspecies) and genotyped 1929 SNPs. They then analyzed the data with Principal Components Analysis (PCA), among other genetic analyzes.
This tutorial will work through all of the steps necessary to re-analyze Walsh et al.s data
In the code below all code is provided. Your tasks will be to do 2 things:
Load the vcfR and other packages with library().
library(vcfR)
##
## ***** *** vcfR *** *****
## This is vcfR 1.13.0
## browseVignettes('vcfR') # Documentation
## citation('vcfR') # Citation
## ***** ***** ***** *****
library(vegan)
## Loading required package: permute
## Loading required package: lattice
## This is vegan 2.6-4
library(ggplot2)
library(ggpubr)
Make sure that your working directory is set to the location of the
file all_loci.vcf.
getwd()
## [1] "/Users/omchauhan/Documents"
list.files()
## [1] "~$L10-mutations-intro-to-gene-exp_PRE.pptx"
## [2] "~$L16-gene-reg-eukaryotes-II.pptx"
## [3] "~$L17-gene-reg-eukaryotes-III_PRE.pptx"
## [4] "~$ort Analysis #1.docx"
## [5] "07-mean_imputation.html"
## [6] "07-mean_imputation.rmd"
## [7] "08-PCA_worked_files"
## [8] "08-PCA_worked.html"
## [9] "08-PCA_worked.rmd"
## [10] "09-PCA_worked_example-SNPs-part1 (1).rmd"
## [11] "09-PCA_worked_example-SNPs-part1--1-.rmd"
## [12] "09-PCA_worked_example-SNPs-part1.rmd"
## [13] "1000genomes_people_info2-1.csv"
## [14] "1540_cluster_analysis.pptx"
## [15] "1540_week14_PCA_SNP_workflow.pdf"
## [16] "4.3e.pptx"
## [17] "9.36073098-36313098.ALL.chr9_GRCh38.genotypes.20170504.vcf"
## [18] "9.36073098-36313098.ALL.chr9_GRCh38.genotypes.20170504.vcf.gz"
## [19] "all_loci-1.vcf"
## [20] "all_loci.vcf"
## [21] "ALL.chr9_GRCh38.genotypes.20170504.vcf.gz"
## [22] "allomtery_3_scatterplot3d (1).rmd"
## [23] "ape_files_export"
## [24] "ape_files_export.zip"
## [25] "ApE_OSX_modern_current (1).dmg"
## [26] "ApE_OSX_modern_current.dmg"
## [27] "attendance.docx"
## [28] "attendance.pdf"
## [29] "Attendance.png"
## [30] "Attendence(2022-2023).xlsx"
## [31] "before-after.jpeg"
## [32] "bibliography.doc"
## [33] "bird_snps_remove_NAs.html"
## [34] "bird_snps_remove_NAs.rmd"
## [35] "Boggle (2).java"
## [36] "Canine-mdr1-CDS-annotated.ape"
## [37] "CDLL_JosephusList (1).java"
## [38] "CDLL_JosephusList.java"
## [39] "center_function.r"
## [40] "Climbing Assay.xlsx"
## [41] "cluster_analysis_portfolio.rmd"
## [42] "code_checkpoint_vcfR.html"
## [43] "code_checkpoint_vcfR.rmd"
## [44] "CODE_CHECKPOINT-first_rstudio_script.r"
## [45] "Confidentiality Form Observership 2023.pdf"
## [46] "Copy of Letter-Size PSA Public Forum 2022 (1200 × 1500 px)-4 (1).png"
## [47] "CS_0441_Recitation_6_Walk_Through.pdf"
## [48] "CS441_Recitation_11.pdf"
## [49] "Day 5 - Niki;nsybgal4 and MitoGFP-142022"
## [50] "Day 5 - Niki;nsybgal4 and MitoGFP-142022 2"
## [51] "Discrete Mathematics and Its Applications, Eighth Edition SOLUTIONS.pdf"
## [52] "EXAM3.R"
## [53] "feature_engineering_intro_2_functions-part2.rmd"
## [54] "feature_engineering.rmd"
## [55] "file.pdf"
## [56] "Final Analysis Proposal .docx"
## [57] "GraphLL (1).java"
## [58] "GraphLL.java"
## [59] "Healthy Hearts GBM 10.27.pptx"
## [60] "Homework #7.pdf"
## [61] "hw8_cover.pdf"
## [62] "ICS Meeting 10-12-2022.pptx"
## [63] "ICS Meeting 11-16-2022.pptx"
## [64] "IMG_1750 (1).jpeg"
## [65] "IMG_1750 (2).jpeg"
## [66] "IMG_1750.jpeg"
## [67] "Immunizations _ MyUPMC (1).pdf"
## [68] "Immunizations _ MyUPMC.pdf"
## [69] "InCLass.Rmd"
## [70] "InstallPrism9.dmg"
## [71] "Intl J Gynecology Obste - 2000 - Dickens - The scope and limits of conscientious objection.pdf"
## [72] "L10-mutations-intro-to-gene-exp_PRE.pptx"
## [73] "L16-gene-reg-eukaryotes-II.pptx"
## [74] "L17-gene-reg-eukaryotes-III_PRE [Autosaved].pptx"
## [75] "L17-gene-reg-eukaryotes-III_PRE.pptx"
## [76] "L4 and L5-linkage and sex chromosomes.pptx"
## [77] "L5-linkage and chi2_PRE.pptx"
## [78] "L5-linkage and chi2.pptx"
## [79] "L7-DNA-replication-repair (1).pptx"
## [80] "L7-DNA-replication-repair.pptx"
## [81] "L8-Mutations_PRE.pptx"
## [82] "League of Legends"
## [83] "lec01.pdf"
## [84] "lec06.pdf"
## [85] "lec07 (1).pdf"
## [86] "lec07.pdf"
## [87] "Lecture Notes - Reiman Chapter 4 & Conclusion"
## [88] "Lecture Notes - Reiman Chapter 4 & Conclusion.doc"
## [89] "Lecture Notes on Welfare"
## [90] "lecture-introd2RStudio-with_scripts.pdf"
## [91] "LinkedListLab.java"
## [92] "LL_Recursive.java"
## [93] "loadingVCFfile.html"
## [94] "loadingVCFfile.Rmd"
## [95] "mdr1-canine-genomic-annotated.ape"
## [96] "Mealey et al- FULL.pdf"
## [97] "Minecraft.dmg"
## [98] "MuEditor-osx-1.1.1.dmg"
## [99] "my snps"
## [100] "MyHashCode.java"
## [101] "MyUPMC - Test Details (1).pdf"
## [102] "MyUPMC - Test Details.pdf"
## [103] "nejmsb1612472.pdf"
## [104] "nihms1428.pdf"
## [105] "Notes from lecture on 9_14 (1).docx"
## [106] "Notes from lecture on 9_14.docx"
## [107] "Om Chauhan Resume.pdf"
## [108] "Om_Chauhan_Resume.pdf"
## [109] "Om+Chauhan+Resume.pdf"
## [110] "OneDrive_2022-09-26.zip"
## [111] "OneDrive_2022-09-27.zip"
## [112] "participants_92663417118.csv"
## [113] "PITT_TSRPT.pdf"
## [114] "PokemonInstaller_Mac.dmg"
## [115] "portfolio_ggpubr_intro-2.rmd"
## [116] "portfolio_ggpubr_log_transformation.rmd"
## [117] "Potus.java"
## [118] "rec01.pdf"
## [119] "rec11_1.pdf"
## [120] "Recitation 8-Fall22_Updated_KEY_more-explanation-from-TR.docx"
## [121] "Recitation 8-Fall22_Updated_KEY_more-explanation-from-TR.pdf"
## [122] "Recitation4-Fall2022.pdf"
## [123] "Reflection Paper (1).docx"
## [124] "Reflection Paper.docx"
## [125] "removing_fixed_alleles.html"
## [126] "removing_fixed_alleles.rmd"
## [127] "Rough Draft_ Short Analysis #1.docx"
## [128] "rsconnect"
## [129] "s11017-019-09512-w.pdf"
## [130] "Short Analysis #1 (1).docx"
## [131] "Short Analysis #1.docx"
## [132] "Short Analysis #2.docx"
## [133] "Shorter KAPB2 10mM conc survival assay V2.pzfx"
## [134] "SNPs_cleaned.csv"
## [135] "Standard Flyer.png"
## [136] "Tower.java"
## [137] "transpose_VCF_data.html"
## [138] "transpose_VCF_data.rmd"
## [139] "Tyler Survival Assay.pzfx"
## [140] "uta_solution_2 (1).pdf"
## [141] "uta_solution_2.pdf"
## [142] "vcfR_test.vcf"
## [143] "vcfR_test.vcf.gz"
## [144] "vegan_PCA_amino_acids-STUDENT.html"
## [145] "vegan_PCA_amino_acids-STUDENT.rmd"
## [146] "vegan_pca_with_msleep-STUDENT.rmd"
## [147] "walsh2017morphology (1).csv"
## [148] "walsh2017morphology.csv"
## [149] "working_directory_practice.html"
## [150] "working_directory_practice.rmd"
## [151] "Works Cited_2527d55b-c3d7-4467-88fc-ecebdbec45e4.docx"
## [152] "Works Cited_4a69c513-67f6-41f9-a4d3-d9dc3059ba7a.docx"
## [153] "Zoom"
list.files(pattern = "vcf")
## [1] "9.36073098-36313098.ALL.chr9_GRCh38.genotypes.20170504.vcf"
## [2] "9.36073098-36313098.ALL.chr9_GRCh38.genotypes.20170504.vcf.gz"
## [3] "all_loci-1.vcf"
## [4] "all_loci.vcf"
## [5] "ALL.chr9_GRCh38.genotypes.20170504.vcf.gz"
## [6] "code_checkpoint_vcfR.html"
## [7] "code_checkpoint_vcfR.rmd"
## [8] "vcfR_test.vcf"
## [9] "vcfR_test.vcf.gz"
TODO: We are making the vcf file data being loaded into a dataframe
snps <- vcfR::read.vcfR("all_loci.vcf", convertNA = TRUE)
## Scanning file to determine attributes.
## File attributes:
## meta lines: 8
## header_line: 9
## variant count: 1929
## column count: 81
##
Meta line 8 read in.
## All meta lines processed.
## gt matrix initialized.
## Character matrix gt created.
## Character matrix gt rows: 1929
## Character matrix gt cols: 81
## skip: 0
## nrows: 1929
## row_num: 0
##
Processed variant 1000
Processed variant: 1929
## All variants processed
TODO: Getting genotype scores from the vcf file
snps_num <- vcfR::extract.gt(snps,
element = "GT",
IDtoRowNames = F,
as.numeric = T,
convertNA = T,
return.alleles = F)
TODO: Transposing the data in order to order the data
snps_num_t <- t(snps_num)
TODO: We are assigning the dataframe with the transposed data in order to convert the matrix to a dataframe
snps_num_df <- data.frame(snps_num_t)
TODO: We are finding the amount of NAs in order to later rid the dataframe of them
find_NAs <- function(x){
NAs_TF <- is.na(x)
i_NA <- which(NAs_TF == TRUE)
N_NA <- length(i_NA)
cat("Results:",N_NA, "NAs present\n.")
return(i_NA)
}
TODO: We are getting the amount of rows and SNPs
# N_rows
# number of rows (individuals)
N_rows <- nrow(snps_num_t)
# N_NA
# vector to hold output (number of NAs)
N_NA <- rep(x = 0, times = N_rows)
# N_SNPs
# total number of columns (SNPs)
N_SNPs <- ncol(snps_num_t)
# the for() loop
for(i in 1:N_rows){
# for each row, find the location of
## NAs with snps_num_t()
i_NA <- find_NAs(snps_num_t[i,])
# then determine how many NAs
## with length()
N_NA_i <- length(i_NA)
# then save the output to
## our storage vector
N_NA[i] <- N_NA_i
}
## Results: 28 NAs present
## .Results: 20 NAs present
## .Results: 28 NAs present
## .Results: 24 NAs present
## .Results: 23 NAs present
## .Results: 63 NAs present
## .Results: 51 NAs present
## .Results: 38 NAs present
## .Results: 34 NAs present
## .Results: 24 NAs present
## .Results: 48 NAs present
## .Results: 21 NAs present
## .Results: 42 NAs present
## .Results: 78 NAs present
## .Results: 45 NAs present
## .Results: 21 NAs present
## .Results: 42 NAs present
## .Results: 34 NAs present
## .Results: 66 NAs present
## .Results: 54 NAs present
## .Results: 59 NAs present
## .Results: 52 NAs present
## .Results: 47 NAs present
## .Results: 31 NAs present
## .Results: 63 NAs present
## .Results: 40 NAs present
## .Results: 40 NAs present
## .Results: 22 NAs present
## .Results: 60 NAs present
## .Results: 48 NAs present
## .Results: 961 NAs present
## .Results: 478 NAs present
## .Results: 59 NAs present
## .Results: 26 NAs present
## .Results: 285 NAs present
## .Results: 409 NAs present
## .Results: 1140 NAs present
## .Results: 600 NAs present
## .Results: 1905 NAs present
## .Results: 25 NAs present
## .Results: 1247 NAs present
## .Results: 23 NAs present
## .Results: 750 NAs present
## .Results: 179 NAs present
## .Results: 433 NAs present
## .Results: 123 NAs present
## .Results: 65 NAs present
## .Results: 49 NAs present
## .Results: 192 NAs present
## .Results: 433 NAs present
## .Results: 66 NAs present
## .Results: 597 NAs present
## .Results: 1891 NAs present
## .Results: 207 NAs present
## .Results: 41 NAs present
## .Results: 268 NAs present
## .Results: 43 NAs present
## .Results: 110 NAs present
## .Results: 130 NAs present
## .Results: 90 NAs present
## .Results: 271 NAs present
## .Results: 92 NAs present
## .Results: 103 NAs present
## .Results: 175 NAs present
## .Results: 31 NAs present
## .Results: 66 NAs present
## .Results: 64 NAs present
## .Results: 400 NAs present
## .Results: 192 NAs present
## .Results: 251 NAs present
## .Results: 69 NAs present
## .Results: 58 NAs present
## .
TODO: To remove any rows that have more than 50% NAs in the row and visualizing it
# 50% of N_SNPs
cutoff50 <- N_SNPs*0.5
hist(N_NA)
abline(v = cutoff50,
col = 2,
lwd = 2,
lty = 2)
TODO: Creating the formula for the cutoff
percent_NA <- N_NA/N_SNPs*100
# Call which() on percent_NA
i_NA_50percent <- which(percent_NA > 50)
snps_num_t02 <- snps_num_t[-i_NA_50percent, ]
TODO: Allows us to get rid of certain parts of the titles of the samples
row_names <- row.names(snps_num_t02) # Key
row_names02 <- gsub("sample_","",row_names)
sample_id <- gsub("^([ATCG]*)(_)(.*)",
"\\3",
row_names02)
pop_id <- gsub("[01-9]*",
"",
sample_id)
table(pop_id)
## pop_id
## Alt Cau Div Nel Sub
## 15 12 15 15 11
TODO: Allows to correct the data and reduce errors in the programe
invar_omit <- function(x){
cat("Dataframe of dim",dim(x), "processed...\n")
sds <- apply(x, 2, sd, na.rm = TRUE)
i_var0 <- which(sds == 0)
cat(length(i_var0),"columns removed\n")
if(length(i_var0) > 0){
x <- x[, -i_var0]
}
## add return() with x in it
return(x)
}
snps_no_invar <- invar_omit(snps_num_t02)
## Dataframe of dim 68 1929 processed...
## 591 columns removed
TODO: Getting a count of SNPs
snps_noNAs <- snps_no_invar
N_col <- ncol(snps_no_invar)
for(i in 1:N_col){
# get the current column
column_i <- snps_noNAs[, i]
# get the mean of the current column
mean_i <- mean(column_i, na.rm = TRUE)
# get the NAs in the current column
NAs_i <- which(is.na(column_i))
# record the number of NAs
N_NAs <- length(NAs_i)
# replace the NAs in the current column
column_i[NAs_i] <- mean_i
# replace the original column with the
## updated columns
snps_noNAs[, i] <- column_i
}
Save the data as a .csv file which can be loaded again later.
write.csv(snps_noNAs, file = "SNPs_cleaned.csv",
row.names = F)
Check for the presence of the file with list.files()
list.files(pattern = ".csv")
## [1] "1000genomes_people_info2-1.csv" "participants_92663417118.csv"
## [3] "SNPs_cleaned.csv" "walsh2017morphology (1).csv"
## [5] "walsh2017morphology.csv"
In Part 2, we will re-load the SNPs_cleaned.csv file and
carry an an analysis with PCA.