Include option to specify names of European reference populations

R/individualQC.R

@@ -916,6 +916,7 @@ check_relatedness <- function(indir, name, qcdir=indir, highIBDTh=0.1875,
 
 check_ancestry <- function(indir, name, qcdir=indir, prefixMergedDataset,
                            europeanTh=1.5,
+                           refPopulation=c("CEU", "TSI"),
                            refSamples=NULL, refColors=NULL,
                            refSamplesFile=NULL, refColorsFile=NULL,
                            refSamplesIID="IID", refSamplesPop="Pop",
@@ -935,6 +936,7 @@ check_ancestry <- function(indir, name, qcdir=indir, prefixMergedDataset,
         fail <- evaluate_check_ancestry(qcdir=qcdir, indir=indir, name=name,
                                         prefixMergedDataset=prefixMergedDataset,
                                         europeanTh=europeanTh,
+                                        refPopulation=refPopulation,
                                         refSamples=refSamples,
                                         refColors=refColors,
                                         refSamplesFile=refSamplesFile,
@@ -1791,6 +1793,9 @@ run_check_ancestry <- function(indir, prefixMergedDataset,
 #' considered to be of European descent and samples outside this radius of
 #' non-European descent. The radius is computed as the maximum Euclidean distance
 #' of European reference samples to the centre of European reference samples.
+#' @param refPopulation [vector] Vector with population identifiers of European
+#' reference population. Identifiers have to be corresponding to population IDs
+#' [refColorsPop] in refColorsfile/refColors.
 #' @param refSamples [data.frame] Dataframe with sample identifiers
 #' [refSamplesIID] corresponding to IIDs in prefixMergedDataset.eigenvec and
 #' population identifier [refSamplesPop] corresponding to population IDs
@@ -1852,6 +1857,7 @@ evaluate_check_ancestry <- function(indir, name, prefixMergedDataset,
                                     refSamplesIID="IID", refSamplesPop="Pop",
                                     refColorsColor="Color", refColorsPop="Pop",
                                     studyColor="#2c7bb6",
+                                    refPopulation=c("CEU", "TSI"),
                                     legend_labels_per_row=6,
                                     interactive=FALSE) {
 
@@ -1949,7 +1955,7 @@ evaluate_check_ancestry <- function(indir, name, prefixMergedDataset,
     data_all$Pop <- factor(data_all$Pop, levels=levels(colors$Pop))
 
     ## Find mean coordinates and distances of reference Europeans ####
-    all_european <- dplyr::filter_(data_all, ~Pop %in% c("CEU", "TSI"))
+    all_european <- dplyr::filter_(data_all, ~Pop %in% refPopulation)
     euro_pc1_mean <- mean(all_european$PC1)
     euro_pc2_mean <- mean(all_european$PC2)