Skip to content

Commit

Permalink
loci_transitions
Browse files Browse the repository at this point in the history
This provides some of the functionality mentioned in #32
  • Loading branch information
dramanica committed May 9, 2024
1 parent a9f44da commit 3b4f9e6
Show file tree
Hide file tree
Showing 6 changed files with 77 additions and 6 deletions.
4 changes: 4 additions & 0 deletions NAMESPACE
Original file line number Diff line number Diff line change
Expand Up @@ -45,6 +45,9 @@ S3method(loci_names,vctrs_bigSNP)
S3method(loci_sums,grouped_df)
S3method(loci_sums,tbl_df)
S3method(loci_sums,vctrs_bigSNP)
S3method(loci_transitions,grouped_df)
S3method(loci_transitions,tbl_df)
S3method(loci_transitions,vctrs_bigSNP)
S3method(loci_transversions,grouped_df)
S3method(loci_transversions,tbl_df)
S3method(loci_transversions,vctrs_bigSNP)
Expand Down Expand Up @@ -99,6 +102,7 @@ export(loci_maf)
export(loci_missingness)
export(loci_names)
export(loci_sums)
export(loci_transitions)
export(loci_transversions)
export(pairwise_allele_sharing)
export(pairwise_ibs)
Expand Down
38 changes: 38 additions & 0 deletions R/loci_transitions.R
Original file line number Diff line number Diff line change
@@ -0,0 +1,38 @@
#' Find transitions
#'
#' Use the loci table to define which loci are transitions
#'
#' @param .x a vector of class `vctrs_bigSNP` (usually the `genotype` column of
#' a [`gen_tibble`] object),
#' or a [`gen_tibble`].
#' @param ... other arguments passed to specific methods.
#' @returns a vector of frequencies, one per locus
#' @rdname loci_transitions
#' @export
loci_transitions <- function(.x, ...) {
UseMethod("loci_transitions", .x)
}

#' @export
#' @rdname loci_transitions
loci_transitions.tbl_df <- function(.x, ...) {
#TODO this is a hack to deal with the class being dropped when going through group_map
stopifnot_gen_tibble(.x)
loci_transitions(.x$genotypes, ...)
}


#' @export
#' @rdname loci_transitions
loci_transitions.vctrs_bigSNP <- function(.x, ...) {
rlang::check_dots_empty()

!loci_transversions(.x)
}

#' @export
#' @rdname loci_transitions
loci_transitions.grouped_df <- function(.x, ...) {
group_map(.x, .f=~loci_transitions(.x))
}

5 changes: 2 additions & 3 deletions R/loci_transversions.R
Original file line number Diff line number Diff line change
@@ -1,7 +1,6 @@
#' Estimates the sum of genotypes at each each locus
#' Find transversions
#'
#' Estimate the sum of the alternate allele at each locus. This is unlikely to be useful
#' directly, but it is used by other functions that compute various statistics.
#' Use the loci table to define which loci are transversions
#'
#' @param .x a vector of class `vctrs_bigSNP` (usually the `genotype` column of
#' a [`gen_tibble`] object),
Expand Down
30 changes: 30 additions & 0 deletions man/loci_transitions.Rd

Some generated files are not rendered by default. Learn more about how customized files appear on GitHub.

5 changes: 2 additions & 3 deletions man/loci_transversions.Rd

Some generated files are not rendered by default. Learn more about how customized files appear on GitHub.

1 change: 1 addition & 0 deletions tests/testthat/test_loci_transversions_transitions.R
Original file line number Diff line number Diff line change
Expand Up @@ -14,4 +14,5 @@ test_that("find transitions and transversions",{
test_gt <- gen_tibble(x = test_genotypes, loci = test_loci, indiv_meta = test_indiv_meta, quiet = TRUE)
transv_bool <- c(TRUE, FALSE, NA, TRUE, TRUE, TRUE)
expect_true(all.equal(loci_transversions(test_gt), transv_bool))
expect_true(all.equal(loci_transitions(test_gt), !transv_bool))
})

0 comments on commit 3b4f9e6

Please sign in to comment.