Added checks for unused arguments in functions with ...

Author: uqrmaie1

R/fstats.R

@@ -446,6 +446,11 @@ fix_ploidy = function(xmat) {
 get_f2 = function(f2_data, pops = NULL, pops2 = NULL, afprod = FALSE, verbose = TRUE, ...) {
 
   stopifnot(!is.character(f2_data) || dir.exists(f2_data) || is_geno_prefix(f2_data))
+  argnam = c(names(formals(f2_from_geno)), names(formals(f2_from_precomp)), names(formals(qpfstats)))
+  if(!all(...names() %in% argnam)) {
+    notused = setdiff(...names(), argnam)
+    stop(paste0("The following arguments are not recognized: '", paste0(notused, collapse = "', '"), "'"))
+  }
   if(!is.null(pops) && is.null(pops2)) pops2 = pops
   if(!is.character(f2_data)) {
     f2_blocks = f2_data

R/io.R

@@ -1063,6 +1063,10 @@ extract_f2 = function(pref, outdir, inds = NULL, pops = NULL, blgsize = 0.05, ma
                       adjust_pseudohaploid = TRUE, cols_per_chunk = NULL, fst = TRUE, afprod = TRUE,
                       poly_only = c('f2'), apply_corr = TRUE, qpfstats = FALSE, n_cores = 1, verbose = TRUE, ...) {
 
+  if(!all(...names() %in% names(formals(admixtools::qpfstats)))) {
+    notused = setdiff(...names(), names(formals(admixtools::qpfstats)))
+    stop(paste0("The following arguments are not recognized: '", paste0(notused, collapse = "', '"), "'"))
+  }
   if(!is.null(cols_per_chunk)) {
     stopifnot(is.null(pops2))
     snpfile = extract_f2_large(pref, outdir, inds = inds, pops = pops, blgsize = blgsize,
@@ -2182,12 +2186,15 @@ extract_samples = function(inpref, outpref, inds = NULL, pops = NULL, overwrite
 #' @param block_lengths An optional vector with block lengths. If `NULL`, block lengths will be computed.
 #' @param f4mode If `TRUE`: f4 is computed from allele frequencies `a`, `b`, `c`, and `d` as `(a-b)*(c-d)`. if `FALSE`, D-statistics are computed instead, defined as `(a-b)*(c-d) / ((a + b - 2*a*b) * (c + d - 2*c*d))`, which is the same as `(P(ABBA) - P(BABA)) / (P(ABBA) + P(BABA))`.
 #' @param allsnps Use all SNPs with allele frequency estimates in every population of any given population quadruple. If `FALSE` (the default) only SNPs which are present in all populations in `popcombs` (or any given model in it) will be used. Setting `allsnps = TRUE` in the presence of large amounts of missing data might lead to false positive results.
+#' @param poly_only Only keep SNPs with mean allele frequency not equal to 0 or 1.
+#' @param snpwt A vector of SNP weights
+#' @param keepsnps A vector of SNP IDs to keep
 #' @param verbose Print progress updates
 #' @return A data frame with per-block f4-statistics for each population quadruple.
 f4blockdat_from_geno = function(pref, popcombs = NULL, left = NULL, right = NULL, auto_only = TRUE,
                                 blgsize = 0.05,
                                 block_lengths = NULL, f4mode = TRUE, allsnps = FALSE,
-                                poly_only = FALSE, verbose = TRUE, snpwt = NULL, ...) {
+                                poly_only = FALSE, snpwt = NULL, keepsnps = NULL, verbose = TRUE) {
 
   stopifnot(!is.null(popcombs) || (!is.null(left) && !is.null(right)))
   stopifnot(is.null(popcombs) || is.null(left) && is.null(right))
@@ -2233,7 +2240,7 @@ f4blockdat_from_geno = function(pref, popcombs = NULL, left = NULL, right = NULL
 
   snpfile$keep = TRUE
   if(auto_only) snpfile %<>% mutate(keep = as.numeric(gsub('[a-zA-Z]+', '', CHR)) <= 22)
-  if('keepsnps' %in% names(list(...))) snpfile %<>% mutate(keep = keep & SNP %in% list(...)$keepsnps)
+  if(!is.null(keepsnps)) snpfile %<>% mutate(keep = keep & SNP %in% keepsnps)
   nsnpaut = sum(snpfile$keep)
   pops = unique(c(popcombs$pop1, popcombs$pop2, popcombs$pop3, popcombs$pop4))
 

R/qpadm.R

@@ -163,6 +163,13 @@ qpadm = function(data, left, right, target, f4blocks = NULL,
   #----------------- prepare f4 stats -----------------
   f2_blocks = NULL
   args = list(...)
+  if(length(args) > 0 && (!is.null(f4blocks) || !is_geno_prefix(data))) {
+    stop(paste0("The following arguments are not used: '", paste0(names(args), collapse = "', '"), "'"))
+  }
+  if(!all(names(args) %in% names(formals(f4blockdat_from_geno)))) {
+    notused = setdiff(names(args), names(formals(f4blockdat_from_geno)))
+    stop(paste0("The following arguments are not recognized: '", paste0(notused, collapse = "', '"), "'"))
+  }
   if(is.null(f4blocks)) {
     if(all(file.exists(left, right))) {
       left %<>% readLines
@@ -919,7 +926,6 @@ qpadmmodels_to_popcombs = function(models) {
 #' @return A list where each element is the output of one qpadm model.
 #' @examples
 #' \dontrun{
-#' pops = paste0('pop', 1:10)
 #' # the following specifies two models: one with 2/3/1 and one with 1/2/1 left/right/target populations
 #' models = tibble(
 #'            left = list(c('pop1', 'pop2'), c('pop3')),

R/qpdstat.R

@@ -428,6 +428,10 @@ qpdstat_geno = function(pref, popcombs, blgsize = 0.05, block_lengths = NULL,
 qp3pop_geno = function(pref, popcombs, blgsize = 0.05, block_lengths = NULL,
                        boot = FALSE, allsnps = TRUE, poly_only = FALSE, verbose = TRUE, ...) {
 
+  if(!all(...names() %in% names(formals(f3blockdat_from_geno)))) {
+    notused = setdiff(...names(), names(formals(f3blockdat_from_geno)))
+    stop(paste0("The following arguments are not recognized: '", paste0(notused, collapse = "', '"), "'"))
+  }
   pref = normalizePath(pref, mustWork = FALSE)
   f3blockdat = f3blockdat_from_geno(pref, popcombs, blgsize = blgsize, block_lengths = block_lengths,
                                     allsnps = allsnps, poly_only = poly_only, verbose = verbose, ...)

R/qpgraph.R

@@ -765,6 +765,11 @@ qpgraph_resample_snps2 = function(f2_blocks, graph, f2_blocks_test, verbose = TR
 #' @seealso \code{\link{compare_fits}}
 qpgraph_resample_multi = function(f2_blocks, graphlist, nboot, verbose = TRUE, ...) {
 
+  argnam = names(formals(qpgraph))
+  if(!all(...names() %in% argnam)) {
+    notused = setdiff(...names(), argnam)
+    stop(paste0("The following arguments are not recognized: '", paste0(notused, collapse = "', '"), "'"))
+  }
   boo = boo_list(f2_blocks, nboot = nboot)
   #f3pre = map(graphlist, ~qpgraph_precompute_f3(f2_blocks, get_leafnames(.))$ppinv)
   #map2(graphlist, f3pre, function(.x, .y, ...) qpgraph_resample_snps2(

R/toposearch.R

@@ -2629,6 +2629,10 @@ find_graphs = function(data, numadmix = 0, outpop = NULL, stop_gen = 100, stop_g
     numadmix = numadmix(graph)
   }
   ell = list(...)
+  if(!all(names(ell) %in% names(formals(qpgraph)))) {
+    notused = setdiff(names(ell), names(formals(qpgraph)))
+    stop(paste0("The following arguments are not recognized: '", paste0(notused, collapse = "', '"), "'"))
+  }
   if('f3basepop' %in% names(ell)) {
     f3basepop = ell$f3basepop
   } else {