Nothing
unphased_class <- R6Class("unphased", inherit = feature_class,
private = list(ploidy = NA, samples_per_ind = NA),
public = list(
initialize = function(samples_per_ind, locus_group) {
assert_that(is.number(samples_per_ind))
private$samples_per_ind <- samples_per_ind
private$set_locus_group(locus_group)
},
check = function(model) {
if (self$get_samples_per_ind() > get_ploidy(model)) {
stop("samples_per_ind needs to be lower or equal to the ploidy",
call. = FALSE)
}
invisible(NULL)
},
get_samples_per_ind = function() private$samples_per_ind,
print = function() {
cat("Unphasing of the simulated chromosomes into",
private$samples_per_ind, "pseudo-chromosomes per individual\n")
}
)
)
#' Feature: Unphased Sequences
#'
#' This simulates unphased data by randomly mixing the sites within one
#' individual. Each position is randomly taken from a phased chromosome..
#'
#' For each individual, \code{ploidy} chromosomes are simulated, and
#' \code{samples_per_ind} pseudo-chromosomes are created of these.
#'
#' @param samples_per_ind The number of pseudo-chromosomes that are created
#' from the phased chromosomes for each individual.
#' @return The feature, which can be added to a model using `+`.
#' @export
#' @template feature
#' @examples
#' # Simulate unphased data in a diploid population
#' model <- coal_model(10, 1, ploidy = 2) +
#' feat_mutation(10) +
#' feat_unphased(2) +
#' sumstat_seg_sites()
#' simulate(model)
#'
#' # The same as before, but return only one chromosome for
#' # each individual:
#' model <- coal_model(10, 1, ploidy = 2) +
#' feat_mutation(10) +
#' feat_unphased(1) +
#' sumstat_seg_sites()
#' simulate(model)
feat_unphased <- function(samples_per_ind, locus_group = "all") {
unphased_class$new(samples_per_ind, locus_group)
}
is_feat_unphased <- function(feat) any("unphased" == class(feat))
get_feature_unphased <- function(model) {
mask <- vapply(model$features, is_feat_unphased, logical(1))
if (!any(mask)) return(NULL)
if (sum(mask) > 1) stop("multiple unphasings are not supported")
model$features[mask][[1]]
}
get_samples_per_ind <- function(model) {
feat <- get_feature_unphased(model)
if (is.null(feat)) return(get_ploidy(model))
as.integer(feat$get_samples_per_ind())
}
is_unphased <- function(model) !is.null(get_feature_unphased(model))
#' @describeIn conv_to_ms_arg Feature conversion
#' @export
conv_to_ms_arg.unphased <- ignore_par
#' @describeIn conv_to_ms_arg Feature conversion
#' @export
conv_to_msms_arg.unphased <- ignore_par
#' @describeIn conv_to_ms_arg Feature conversion
#' @export
conv_to_scrm_arg.unphased <- ignore_par
#' @describeIn conv_to_ms_arg Feature conversion
#' @export
conv_to_seqgen_arg.unphased <- ignore_par
Any scripts or data that you put into this service are public.
Add the following code to your website.
For more information on customizing the embed code, read Embedding Snippets.