Nothing
# Generated by using Rcpp::compileAttributes() -> do not edit by hand
# Generator token: 10BE3573-1514-4C36-9D1C-5A225CD40393
#' Build pedigrees from (individuals in) a population.
#'
#' In a newly simulated population, each individual only knows its father and children.
#' Using this information, this function builds pedigrees.
#' This makes it easier to e.g. population haplotypes, find path between two individuals
#' (if they are not in the same pedigree, they are not connected).
#'
#' @param population Population generated by [sample_geneology()] or [sample_geneology_varying_size()].
#' @param progress Show progress.
#'
#' @examples
#' sim <- sample_geneology(100, 10)
#' str(sim, 1)
#' sim$population
#' peds <- build_pedigrees(sim$population)
#' peds
#'
#' @return An object with class `malan_pedigreelist` (an internal list of external pointers to pedigrees).
#'
#' @seealso [sample_geneology()] and [sample_geneology_varying_size()] for simulating populations.
#'
#' @export
build_pedigrees <- function(population, progress = TRUE) {
.Call('_malan_build_pedigrees', PACKAGE = 'malan', population, progress)
}
#' Generate paternal brothers population
#'
#' @param vertices vector of vertices
#' @param edges matrix with edges
#'
#' @return An external pointer to the population.
from_igraph_rcpp <- function(vertices, edges) {
.Call('_malan_from_igraph_rcpp', PACKAGE = 'malan', vertices, edges)
}
#' Infer generation numbers from pedigrees
#'
#' @param peds Pedigrees infered by [build_pedigrees()]
#'
#' @return Nothing
#'
#' @export
infer_generations <- function(peds) {
invisible(.Call('_malan_infer_generations', PACKAGE = 'malan', peds))
}
#' Construct a population from data
#'
#' Note that individuals loaded this way does not have information about generation.
#'
#' @param pid ID of male
#' @param pid_dad ID of male's father, 0 if not known
#' @param progress Show progress.
#' @param error_on_pid_not_found Error if pid not found
#'
#' @export
load_individuals <- function(pid, pid_dad, progress = TRUE, error_on_pid_not_found = TRUE) {
.Call('_malan_load_individuals', PACKAGE = 'malan', pid, pid_dad, progress, error_on_pid_not_found)
}
#' Load haplotypes to individuals
#'
#' Note that individuals loaded this way does not have information about generation.
#'
#' @param population of individuals
#' @param pid ID of male
#' @param haplotypes - row `i` has `pid[i]` ID
#' @param progress Show progress.
#'
#' @export
load_haplotypes <- function(population, pid, haplotypes, progress = TRUE) {
invisible(.Call('_malan_load_haplotypes', PACKAGE = 'malan', population, pid, haplotypes, progress))
}
#' Infer individual's generation number
#'
#' Takes as input final generation, then moves up in pedigree and increments
#' generation number.
#'
#' Note: Only works when all final generation individuals are provided.
#'
#' @param final_generation Individuals in final generation
#'
#' @export
infer_generation <- function(final_generation) {
invisible(.Call('_malan_infer_generation', PACKAGE = 'malan', final_generation))
}
#' Set individual's generation number
#'
#' Note that generation 0 is final, end generation.
#' 1 is second last generation etc.
#'
#' @param individual Individual
#' @param generation Generation to assign
#'
#' @examples
#' sim <- sample_geneology(100, 10)
#' indv <- get_individual(sim$population, 1)
#' get_generation(indv)
#' set_generation(indv, 100)
#' get_generation(indv)
#'
#' @export
set_generation <- function(individual, generation) {
invisible(.Call('_malan_set_generation', PACKAGE = 'malan', individual, generation))
}
#' Simulate a geneology with constant population size.
#'
#' This function simulates a geneology where the last generation has `population_size` individuals.
#'
#' By the backwards simulating process of the Wright-Fisher model,
#' individuals with no descendants in the end population are not simulated.
#' If for some reason additional full generations should be simulated,
#' the number can be specified via the `generations_full` parameter.
#' This can for example be useful if one wants to simulate the
#' final 3 generations although some of these may not get (male) children.
#'
#' Let \eqn{\alpha} be the parameter of a symmetric Dirichlet distribution
#' specifying each man's probability to be the father of an arbitrary
#' male in the next generation. When \eqn{\alpha = 5}, a man's relative probability
#' to be the father has 95\% probability to lie between 0.32 and 2.05, compared with a
#' constant 1 under the standard Wright-Fisher model and the standard deviation in
#' the number of male offspring per man is 1.10 (standard Wright-Fisher = 1).
#'
#' This symmetric Dirichlet distribution is implemented by drawing
#' father (unscaled) probabilities from a Gamma distribution with
#' parameters `gamma_parameter_shape` and `gamma_parameter_scale`
#' that are then normalised to sum to 1.
#' To obtain a symmetric Dirichlet distribution with parameter \eqn{\alpha},
#' the following must be used:
#' \eqn{`gamma_parameter_shape` = \alpha}
#' and
#' \eqn{`gamma_parameter_scale` = 1/\alpha}.
#'
#' @param population_size The size of the population.
#' @param generations The number of generations to simulate:
#' \itemize{
#' \item -1 for simulate to 1 founder
#' \item else simulate this number of generations.
#' }
#' @param generations_full Number of full generations to be simulated.
#' @param generations_return How many generations to return (pointers to) individuals for.
#' @param enable_gamma_variance_extension Enable symmetric Dirichlet (and disable standard Wright-Fisher).
#' @param gamma_parameter_shape Parameter related to symmetric Dirichlet distribution for each man's probability to be father. Refer to details.
#' @param gamma_parameter_scale Parameter realted to symmetric Dirichlet distribution for each man's probability to be father. Refer to details.
#' @param progress Show progress.
#' @param verbose_result Verbose result.
#'
#' @return A malan_simulation / list with the following entries:
#' \itemize{
#' \item `population`. An external pointer to the population.
#' \item `generations`. Generations actually simulated, mostly useful when parameter `generations = -1`.
#' \item `founders`. Number of founders after the simulated `generations`.
#' \item `growth_type`. Growth type model.
#' \item `sdo_type`. Standard deviation in a man's number of male offspring. StandardWF or GammaVariation depending on `enable_gamma_variance_extension`.
#' \item `end_generation_individuals`. Pointers to individuals in end generation.
#' \item `individuals_generations`. Pointers to individuals in last `generations_return` generation (if `generations_return = 3`, then individuals in the last three generations are returned).
#' }
#' If `verbose_result` is true, then these additional components are also returned:
#' \itemize{
#' \item `individual_pids`. A matrix with pid (person id) for each individual.
#' \item `father_pids`. A matrix with pid (person id) for each individual's father.
#' \item `father_indices`. A matrix with indices for fathers.
#' }
#'
#' @examples
#' sim <- sample_geneology(100, 10)
#' str(sim, 1)
#' sim$population
#' peds <- build_pedigrees(sim$population)
#' peds
#'
#' @seealso [sample_geneology_varying_size()].
#'
#' @import Rcpp
#' @import RcppProgress
#' @import RcppArmadillo
#' @export
sample_geneology <- function(population_size, generations, generations_full = 1L, generations_return = 3L, enable_gamma_variance_extension = FALSE, gamma_parameter_shape = 5.0, gamma_parameter_scale = 1.0/5.0, progress = TRUE, verbose_result = FALSE) {
.Call('_malan_sample_geneology', PACKAGE = 'malan', population_size, generations, generations_full, generations_return, enable_gamma_variance_extension, gamma_parameter_shape, gamma_parameter_scale, progress, verbose_result)
}
#' Simulate a geneology with varying population size.
#'
#' This function simulates a geneology with varying population size specified
#' by a vector of population sizes, one for each generation.
#'
#' By the backwards simulating process of the Wright-Fisher model,
#' individuals with no descendants in the end population are not simulated
#' If for some reason additional full generations should be simulated,
#' the number can be specified via the `generations_full` parameter.
#' This can for example be useful if one wants to simulate the
#' final 3 generations although some of these may not get (male) children.
#'
#' Let \eqn{\alpha} be the parameter of a symmetric Dirichlet distribution
#' specifying each man's probability to be the father of an arbitrary
#' male in the next generation. When \eqn{\alpha = 5}, a man's relative probability
#' to be the father has 95\% probability to lie between 0.32 and 2.05, compared with a
#' constant 1 under the standard Wright-Fisher model and the standard deviation in
#' the number of male offspring per man is 1.10 (standard Wright-Fisher = 1).
#'
#' This symmetric Dirichlet distribution is implemented by drawing
#' father (unscaled) probabilities from a Gamma distribution with
#' parameters `gamma_parameter_shape` and `gamma_parameter_scale`
#' that are then normalised to sum to 1.
#' To obtain a symmetric Dirichlet distribution with parameter \eqn{\alpha},
#' the following must be used:
#' \eqn{`gamma_parameter_shape` = \alpha}
#' and
#' \eqn{`gamma_parameter_scale` = 1/\alpha}.
#'
#' @param population_sizes The size of the population at each generation, `g`.
#' `population_sizes[g]` is the population size at generation `g`.
#' The length of population_sizes is the number of generations being simulated.
#' @param generations_full Number of full generations to be simulated.
#' @param generations_return How many generations to return (pointers to) individuals for.
#' @param enable_gamma_variance_extension Enable symmetric Dirichlet (and disable standard Wright-Fisher).
#' @param gamma_parameter_shape Parameter related to symmetric Dirichlet distribution for each man's probability to be father. Refer to details.
#' @param gamma_parameter_scale Parameter realted to symmetric Dirichlet distribution for each man's probability to be father. Refer to details.
#' @param progress Show progress.
#'
#' @return A malan_simulation / list with the following entries:
#' \itemize{
#' \item `population`. An external pointer to the population.
#' \item `generations`. Generations actually simulated, mostly useful when parameter `generations = -1`.
#' \item `founders`. Number of founders after the simulated `generations`.
#' \item `growth_type`. Growth type model.
#' \item `sdo_type`. Standard deviation in a man's number of male offspring. StandardWF or GammaVariation depending on `enable_gamma_variance_extension`.
#' \item `end_generation_individuals`. Pointers to individuals in end generation.
#' \item `individuals_generations`. Pointers to individuals in last `generations_return` generation (if `generations_return = 3`, then individuals in the last three generations are returned).
#' }
#'
#' @examples
#' sim <- sample_geneology_varying_size(10*(1:10))
#' str(sim, 1)
#' sim$population
#' peds <- build_pedigrees(sim$population)
#' peds
#'
#' @seealso [sample_geneology()].
#'
#' @import Rcpp
#' @import RcppProgress
#' @import RcppArmadillo
#' @export
sample_geneology_varying_size <- function(population_sizes, generations_full = 1L, generations_return = 3L, enable_gamma_variance_extension = FALSE, gamma_parameter_shape = 5.0, gamma_parameter_scale = 1.0/5.0, progress = TRUE) {
.Call('_malan_sample_geneology_varying_size', PACKAGE = 'malan', population_sizes, generations_full, generations_return, enable_gamma_variance_extension, gamma_parameter_shape, gamma_parameter_scale, progress)
}
#' Calculate genotype probabilities with theta
#'
#' @param allele_dist Allele distribution (probabilities) -- gets normalised
#' @param theta Theta correction between 0 and 1 (both included)
#'
#' @export
calc_autosomal_genotype_probs <- function(allele_dist, theta) {
.Call('_malan_calc_autosomal_genotype_probs', PACKAGE = 'malan', allele_dist, theta)
}
#' Calculate conditional genotype cumulative probabilities with theta
#'
#' @param allele_dist Allele distribution (probabilities) -- gets normalised
#' @param theta Theta correction between 0 and 1 (both included)
#'
#' @return Matrix: row i: conditional cumulative distribution of alleles given allele i
#'
#' @export
calc_autosomal_genotype_conditional_cumdist <- function(allele_dist, theta) {
.Call('_malan_calc_autosomal_genotype_conditional_cumdist', PACKAGE = 'malan', allele_dist, theta)
}
#' Sample genotype with theta
#'
#' @param allele_dist Allele distribution (probabilities) -- gets normalised
#' @param theta Theta correction between 0 and 1 (both included)
#'
#' @export
sample_autosomal_genotype <- function(allele_dist, theta) {
.Call('_malan_sample_autosomal_genotype', PACKAGE = 'malan', allele_dist, theta)
}
#' Populate 1-locus autosomal DNA profile in pedigrees with single-step mutation model.
#'
#' Populate 1-locus autosomal DNA profile from founder and down in all pedigrees.
#' Note, that only alleles from ladder is assigned and
#' that all founders draw type randomly.
#'
#' Note, that pedigrees must first have been inferred by [build_pedigrees()].
#'
#' @param pedigrees Pedigree list in which to populate genotypes
#' @param allele_dist Allele distribution (probabilities) -- gets normalised
#' @param theta Theta correction between 0 and 1 (both included)
#' @param mutation_rate Mutation rate between 0 and 1 (both included)
#' @param progress Show progress
#'
#' @seealso [pedigrees_all_populate_haplotypes_custom_founders()] and
#' [pedigrees_all_populate_haplotypes_ladder_bounded()].
#'
#' @export
pedigrees_all_populate_autosomal <- function(pedigrees, allele_dist, theta, mutation_rate, progress = TRUE) {
invisible(.Call('_malan_pedigrees_all_populate_autosomal', PACKAGE = 'malan', pedigrees, allele_dist, theta, mutation_rate, progress))
}
#' Populate 1-locus autosomal DNA profile in pedigrees with infinite alleles mutation model.
#'
#' Populate 1-locus autosomal DNA profile from founder and down in all pedigrees.
#' Note, that all founders have type 0 to begin with.
#'
#' The maternal allele is taken by random from
#' the `2*N[g]` alleles in the previous generation consisting of `N[g]` males
#' with descendants in the live population.
#'
#' This is also why this is not using pedigrees but instead the population.
#'
#' Note, that pedigrees need not be inferred.
#'
#' @param population Population in which to populate genotypes
#' @param mutation_rate Mutation rate between 0 and 1 (both included)
#' @param progress Show progress
#'
#' @seealso [pedigrees_all_populate_haplotypes_custom_founders()] and
#' [pedigrees_all_populate_haplotypes_ladder_bounded()].
#'
#' @export
population_populate_autosomal_infinite_alleles <- function(population, mutation_rate, progress = TRUE) {
invisible(.Call('_malan_population_populate_autosomal_infinite_alleles', PACKAGE = 'malan', population, mutation_rate, progress))
}
#' Unweighted estimate of autosomal theta from subpopulations of genotypes
#'
#' Estimates unweighted autosomal theta for a number of subpopulations given a list of subpopulations of genotypes.
#'
#' Assumes that [pedigrees_all_populate_autosomal()] was used first to populate autosomal genotypes.
#'
#' Based on Weir and Goudet, Genetics 2017:
#' http://www.genetics.org/content/early/2017/05/26/genetics.116.198424
#'
#' @param subpops List of individual genotypes
#' @param assume_HWE if the alleles themselves are used instead of genotypes
#'
#' @return Estimate of autosomal theta
#'
#' @export
estimate_autotheta_subpops_unweighted_genotypes <- function(subpops, assume_HWE) {
.Call('_malan_estimate_autotheta_subpops_unweighted_genotypes', PACKAGE = 'malan', subpops, assume_HWE)
}
#' Unweighted estimate of autosomal theta from subpopulations of individual ids
#'
#' Estimates unweighted autosomal theta for a number of subpopulations given a list of pids (individual ids).
#'
#' Assumes that [pedigrees_all_populate_autosomal()] was used first to populate autosomal genotypes.
#'
#' Based on Weir and Goudet, Genetics 2017:
#' http://www.genetics.org/content/early/2017/05/26/genetics.116.198424
#'
#' @param population Population obtain from simulation
#' @param subpops List of individual pids
#' @param assume_HWE if the alleles themselves are used instead of genotypes
#'
#' @return Estimate of autosomal theta
#'
#' @export
estimate_autotheta_subpops_unweighted_pids <- function(population, subpops, assume_HWE) {
.Call('_malan_estimate_autotheta_subpops_unweighted_pids', PACKAGE = 'malan', population, subpops, assume_HWE)
}
#' Get autosomal allele counts from subpopulations of genotypes
#'
#' Assumes that [pedigrees_all_populate_autosomal()] was used first to populate autosomal genotypes.
#'
#' @param subpops List of individual genotypes
#'
#' @return Matrix with allele counts
#'
#' @export
get_allele_counts_genotypes <- function(subpops) {
.Call('_malan_get_allele_counts_genotypes', PACKAGE = 'malan', subpops)
}
#' Get autosomal allele counts from subpopulations given by pids
#'
#' Assumes that [pedigrees_all_populate_autosomal()] was used first to populate autosomal genotypes.
#'
#' @param population Population obtain from simulation
#' @param subpops List of individual pids
#'
#' @return Matrix with allele counts
#'
#' @export
get_allele_counts_pids <- function(population, subpops) {
.Call('_malan_get_allele_counts_pids', PACKAGE = 'malan', population, subpops)
}
hash_colisions <- function(p) {
.Call('_malan_hash_colisions', PACKAGE = 'malan', p)
}
#' Estimate autosomal theta from genotypes
#'
#' Estimate autosomal theta for one subpopulation given a sample of genotypes.
#'
#' Assumes that [pedigrees_all_populate_autosomal()] was used first to populate autosomal genotypes.
#'
#' @param genotypes Matrix of genotypes: two columns (allele1 and allele2) and a row per individual
#' @param return_estimation_info Whether to return the quantities used to estimate `theta`
#'
#' @return List:
#' * `theta`
#' + `estimate`: Vector of length 1 containing estimate of theta or NA if it could not be estimated
#' + `error`: true if an error happened, false otherwise
#' + `details`: contains description if an error happened
#' + `estimation_info`: If `return_estimation_info = true`: a list with information used to estimate `theta`. Else `NULL`.
#'
#' @export
estimate_autotheta_1subpop_genotypes <- function(genotypes, return_estimation_info = FALSE) {
.Call('_malan_estimate_autotheta_1subpop_genotypes', PACKAGE = 'malan', genotypes, return_estimation_info)
}
#' Estimate autosomal theta from individuals
#'
#' Estimate autosomal theta for one subpopulation given a list of individuals.
#'
#' Assumes that [pedigrees_all_populate_autosomal()] was used first to populate autosomal genotypes.
#'
#'
#' @inheritParams estimate_autotheta_1subpop_genotypes
#' @param individuals Individuals to get haplotypes for.
#'
#' @inherit estimate_autotheta_1subpop_genotypes return
#'
#' @export
estimate_autotheta_1subpop_individuals <- function(individuals, return_estimation_info = FALSE) {
.Call('_malan_estimate_autotheta_1subpop_individuals', PACKAGE = 'malan', individuals, return_estimation_info)
}
#' Estimate autosomal F, theta, and f from subpopulations of individuals
#'
#' Estimates autosomal F, theta, and f for a number of subpopulations given a list of individuals.
#'
#' Assumes that [pedigrees_all_populate_autosomal()] was used first to populate autosomal genotypes.
#'
#'
#' Based on Bruce S Weir, Genetic Data Analysis 2, 1996. (GDA2).
#'
#' @param subpops List of subpopulations, each a list of individuals
#' @param subpops_sizes Size of each subpopulation
#'
#' @return Estimates of autosomal F, theta, and f as well as additional information
#'
#' @export
estimate_autotheta_subpops_individuals <- function(subpops, subpops_sizes) {
.Call('_malan_estimate_autotheta_subpops_individuals', PACKAGE = 'malan', subpops, subpops_sizes)
}
#' Estimate autosomal F, theta, and f from subpopulations of genotypes
#'
#' Estimates autosomal F, theta, and f for a number of subpopulations given a list of genotypes.
#'
#' Assumes that [pedigrees_all_populate_autosomal()] was used first to populate autosomal genotypes.
#'
#' Based on Bruce S Weir, Genetic Data Analysis 2, 1996. (GDA2).
#'
#' @param subpops List of subpopulations, each a list of individuals
#' @param subpops_sizes Size of each subpopulation
#'
#' @return Estimates of autosomal F, theta, and f as well as additional information
#'
#' @export
estimate_autotheta_subpops_genotypes <- function(subpops, subpops_sizes) {
.Call('_malan_estimate_autotheta_subpops_genotypes', PACKAGE = 'malan', subpops, subpops_sizes)
}
#' Estimate autosomal F, theta, and f from subpopulations of individual ids
#'
#' Estimates autosomal F, theta, and f for a number of subpopulations given a list of pids (individual ids).
#'
#' Assumes that [pedigrees_all_populate_autosomal()] was used first to populate autosomal genotypes.
#'
#' Based on Bruce S Weir, Genetic Data Analysis 2, 1996. (GDA2).
#'
#' @param population Population obtain from simulation
#' @param subpops List of individual pids
#' @param subpops_sizes Size of each subpopulation
#'
#' @return Estimates of autosomal F, theta, and f as well as additional information
#'
#' @export
estimate_autotheta_subpops_pids <- function(population, subpops, subpops_sizes) {
.Call('_malan_estimate_autotheta_subpops_pids', PACKAGE = 'malan', population, subpops, subpops_sizes)
}
#' Populate haplotypes in pedigrees (0-founder/unbounded).
#'
#' Populate haplotypes from founder and down in all pedigrees.
#' Note, that haplotypes are unbounded and
#' that all founders get haplotype `rep(0L, loci)`.
#'
#' Note, that pedigrees must first have been inferred by [build_pedigrees()].
#'
#' @param pedigrees Pedigree list in which to populate haplotypes
#' @param loci Number of loci
#' @param mutation_rates Vector with mutation rates, length `loci`
#' @param prob_two_step Given a mutation happens, this is the probability that the mutation is a two-step mutation
#' @param prob_genealogical_error Probability that a genealogical error happens: if so, give individual haplotype `rep(0L, loci)` instead of father's
#' @param progress Show progress
#'
#' @examples
#' sim <- sample_geneology(100, 10)
#' peds <- build_pedigrees(sim$population)
#' pedigrees_all_populate_haplotypes(peds, 2, c(1, 1))
#' get_haplotype(sim$end_generation_individuals[[1]])
#'
#' @seealso [pedigrees_all_populate_haplotypes_custom_founders()] and
#' [pedigrees_all_populate_haplotypes_ladder_bounded()].
#'
#' @export
pedigrees_all_populate_haplotypes <- function(pedigrees, loci, mutation_rates, prob_two_step = 0.0, prob_genealogical_error = 0.0, progress = TRUE) {
invisible(.Call('_malan_pedigrees_all_populate_haplotypes', PACKAGE = 'malan', pedigrees, loci, mutation_rates, prob_two_step, prob_genealogical_error, progress))
}
#' Populate haplotypes in pedigrees (custom founder/unbounded).
#'
#' Populate haplotypes from founder and down in all pedigrees.
#' Note, that haplotypes are unbounded.
#' All founders get a haplotype from calling the user
#' provided function `get_founder_haplotype()`.
#'
#' Note, that pedigrees must first have been inferred by [build_pedigrees()].
#'
#' @param pedigrees Pedigree list in which to populate haplotypes
#' @param mutation_rates Vector with mutation rates
#' @param get_founder_haplotype Function taking no arguments returning a haplotype of `length(mutation_rates)`
#' @param prob_two_step Given a mutation happens, this is the probability that the mutation is a two-step mutation
#' @param prob_genealogical_error Probability that a genealogical error happens: if so, give individual haplotype `get_founder_haplotype()` instead of father's
#' @param progress Show progress
#'
#'
#' @examples
#' sim <- sample_geneology(100, 10)
#' peds <- build_pedigrees(sim$population)
#' pedigrees_all_populate_haplotypes_custom_founders(
#' peds, c(1, 1), function(x) c(10, 10))
#' get_haplotype(sim$end_generation_individuals[[1]])
#'
#' @seealso [pedigrees_all_populate_haplotypes()] and
#' [pedigrees_all_populate_haplotypes_ladder_bounded()].
#'
#' @export
pedigrees_all_populate_haplotypes_custom_founders <- function(pedigrees, mutation_rates, get_founder_haplotype = NULL, prob_two_step = 0.0, prob_genealogical_error = 0.0, progress = TRUE) {
invisible(.Call('_malan_pedigrees_all_populate_haplotypes_custom_founders', PACKAGE = 'malan', pedigrees, mutation_rates, get_founder_haplotype, prob_two_step, prob_genealogical_error, progress))
}
#' Populate haplotypes in pedigrees (custom founder/bounded).
#'
#' Populate haplotypes from founder and down in all pedigrees.
#' Note, that haplotypes are bounded by `ladder_min` and `ladder_max`.
#' All founders get a haplotype from calling the user
#' provided function `get_founder_haplotype()`.
#'
#' Given that a two step mutation should happen (probability specified by `prob_two_step`):
#' With distances >= 2 to ladder bounds, mutations happen as usual.
#' At distance = 0 or 1 to a ladder bound, the mutation is forced to move away from the boundary.
#'
#' Note, that pedigrees must first have been inferred by [build_pedigrees()].
#'
#' @param pedigrees Pedigree list in which to populate haplotypes
#' @param mutation_rates Vector with mutation rates
#' @param ladder_min Lower bounds for haplotypes, same length as `mutation_rates`
#' @param ladder_max Upper bounds for haplotypes, same length as `mutation_rates`; all entries must be strictly greater than `ladder_min`
#' @param get_founder_haplotype Function taking no arguments returning a haplotype of `length(mutation_rates)`
#' @param prob_two_step Given a mutation happens, this is the probability that the mutation is a two-step mutation; refer to details for information about behaviour around ladder boundaries
#' @param prob_genealogical_error Probability that a genealogical error happens: if so, give individual haplotype `get_founder_haplotype()` instead of father's
#' @param progress Show progress
#'
#' @examples
#' sim <- sample_geneology(100, 10)
#' peds <- build_pedigrees(sim$population)
#' pedigrees_all_populate_haplotypes_ladder_bounded(
#' peds, c(1, 1), c(0L, 0L), c(10L, 10L),
#' function(x) c(10, 10))
#' get_haplotype(sim$end_generation_individuals[[1]])
#'
#' @seealso [pedigrees_all_populate_haplotypes()] and
#' [pedigrees_all_populate_haplotypes_custom_founders()].
#'
#' @export
pedigrees_all_populate_haplotypes_ladder_bounded <- function(pedigrees, mutation_rates, ladder_min, ladder_max, get_founder_haplotype = NULL, prob_two_step = 0.0, prob_genealogical_error = 0.0, progress = TRUE) {
invisible(.Call('_malan_pedigrees_all_populate_haplotypes_ladder_bounded', PACKAGE = 'malan', pedigrees, mutation_rates, ladder_min, ladder_max, get_founder_haplotype, prob_two_step, prob_genealogical_error, progress))
}
#' Get haplotype from an individual
#'
#' Requires that haplotypes are first populated, e.g.
#' with [pedigrees_all_populate_haplotypes()],
#' [pedigrees_all_populate_haplotypes_custom_founders()], or
#' [pedigrees_all_populate_haplotypes_ladder_bounded()].
#'
#' @param individual Individual to get haplotypes for.
#'
#' @examples
#' sim <- sample_geneology(100, 10)
#' peds <- build_pedigrees(sim$population)
#' pedigrees_all_populate_haplotypes(peds, 2, c(1, 1))
#' get_haplotype(sim$end_generation_individuals[[1]])
#'
#' @return Haplotype for `individual`.
#'
#' @seealso [get_haplotypes_individuals()] and [get_haplotypes_pids()].
#'
#' @export
get_haplotype <- function(individual) {
.Call('_malan_get_haplotype', PACKAGE = 'malan', individual)
}
#' Get haplotype matrix from list of individuals
#'
#' Requires that haplotypes are first populated, e.g.
#' with [pedigrees_all_populate_haplotypes()],
#' [pedigrees_all_populate_haplotypes_custom_founders()], or
#' [pedigrees_all_populate_haplotypes_ladder_bounded()].
#'
#' @param individuals Individuals to get haplotypes for.
#'
#' @examples
#' sim <- sample_geneology(100, 10)
#' peds <- build_pedigrees(sim$population)
#' pedigrees_all_populate_haplotypes(peds, 2, c(1, 1))
#' get_haplotypes_individuals(sim$end_generation_individuals)
#'
#' @return Matrix of haplotypes where row `i` is the haplotype of `individuals[[i]]`.
#'
#' @seealso [get_haplotypes_pids()].
#'
#' @export
get_haplotypes_individuals <- function(individuals) {
.Call('_malan_get_haplotypes_individuals', PACKAGE = 'malan', individuals)
}
#' Get haplotypes from a vector of pids.
#'
#' Requires that haplotypes are first populated, e.g.
#' with [pedigrees_all_populate_haplotypes()],
#' [pedigrees_all_populate_haplotypes_custom_founders()], or
#' [pedigrees_all_populate_haplotypes_ladder_bounded()].
#'
#' @param population Population
#' @param pids Vector of pids to get haplotypes for.
#'
#' @return Matrix of haplotypes where row `i` is the haplotype of `individuals[[i]]`.
#'
#' @seealso [get_haplotypes_individuals()].
#'
#' @export
get_haplotypes_pids <- function(population, pids) {
.Call('_malan_get_haplotypes_pids', PACKAGE = 'malan', population, pids)
}
#' Count haplotypes occurrences in list of individuals
#'
#' Counts the number of types `haplotype` appears in `individuals`.
#'
#' @param individuals List of individuals to count occurrences in.
#' @param haplotype Haplotype to count occurrences of.
#'
#' @examples
#' sim <- sample_geneology(100, 10)
#' peds <- build_pedigrees(sim$population)
#' pedigrees_all_populate_haplotypes(peds, 2, c(0, 0))
#' count_haplotype_occurrences_individuals(sim$end_generation_individuals, c(0, 0))
#'
#' @return Number of times that `haplotype` occurred amongst `individuals`.
#'
#' @seealso [pedigree_haplotype_matches_in_pedigree_meiosis_L1_dists()],
#' [count_haplotype_near_matches_individuals()].
#'
#' @export
count_haplotype_occurrences_individuals <- function(individuals, haplotype) {
.Call('_malan_count_haplotype_occurrences_individuals', PACKAGE = 'malan', individuals, haplotype)
}
#' Count near haplotype matches in list of individuals
#'
#' Counts the number of types close to `haplotype` in `individuals`.
#'
#' @param individuals List of individuals to count occurrences in.
#' @param haplotype Haplotype to count near-matches occurrences of.
#' @param max_dist Maximum distance (0 = match, 1 = 1 STR allele difference, ...)
#'
#' @return Number of times that a haplotype within a radius of `max_dist` of
#' `haplotype` occurred amongst `individuals`.
#'
#' @seealso [count_haplotype_occurrences_individuals()],
#' [pedigree_haplotype_matches_in_pedigree_meiosis_L1_dists()].
#'
#' @export
count_haplotype_near_matches_individuals <- function(individuals, haplotype, max_dist) {
.Call('_malan_count_haplotype_near_matches_individuals', PACKAGE = 'malan', individuals, haplotype, max_dist)
}
#' Get individuals matching from list of individuals
#'
#' Get the indvididuals that matches `haplotype` in `individuals`.
#'
#' @param individuals List of individuals to count occurrences in.
#' @param haplotype Haplotype to count occurrences of.
#'
#' @return List of individuals that matches `haplotype` amongst `individuals`.
#'
#' @seealso [pedigree_haplotype_matches_in_pedigree_meiosis_L1_dists()].
#'
#' @export
haplotype_matches_individuals <- function(individuals, haplotype) {
.Call('_malan_haplotype_matches_individuals', PACKAGE = 'malan', individuals, haplotype)
}
#' Count haplotypes occurrences in pedigree
#'
#' Counts the number of types `haplotype` appears in `pedigree`.
#'
#' @param pedigree Pedigree to count occurrences in.
#' @param haplotype Haplotype to count occurrences of.
#' @param generation_upper_bound_in_result Only consider matches in
#' generation 0, 1, ... generation_upper_bound_in_result.
#' -1 means disabled, consider all generations.
#' End generation is generation 0.
#' Second last generation is 1.
#' And so on.
#'
#' @return Number of times that `haplotype` occurred in `pedigree`.
#'
#' @seealso [pedigree_haplotype_matches_in_pedigree_meiosis_L1_dists()].
#'
#' @export
count_haplotype_occurrences_pedigree <- function(pedigree, haplotype, generation_upper_bound_in_result = -1L) {
.Call('_malan_count_haplotype_occurrences_pedigree', PACKAGE = 'malan', pedigree, haplotype, generation_upper_bound_in_result)
}
#' Information about matching individuals
#'
#' Gives information about all individuals in pedigree that matches an individual.
#' Just as [count_haplotype_occurrences_individuals()] counts the number of
#' occurrences amongst a list of individuals,
#' this gives detailed information about matching individuals in the pedigree,
#' e.g. meiotic distances and maximum L1 distance on the path as some of these
#' matches may have (back)mutations between in between them (but often this will be 0).
#'
#' @param suspect Individual that others must match the profile of.
#' @param generation_upper_bound_in_result Only consider matches in
#' generation 0, 1, ... generation_upper_bound_in_result.
#' -1 means disabled, consider all generations.
#' End generation is generation 0.
#' Second last generation is 1.
#' And so on.
#' @param error_on_no_haplotype raise error or silently ignore individuals
#' with no haplotype
#'
#' @return Matrix with information about matching individuals.
#' Columns in order: meioses (meiotic distance to `suspect`),
#' max_L1 (on the path between the matching individual and `suspect`,
#' what is the maximum L1 distance between the `suspect`'s profile and the
#' profiles of the individuals on the path),
#' pid (pid of matching individual)
#'
#' @seealso [count_haplotype_occurrences_individuals()].
#'
#' @export
pedigree_haplotype_matches_in_pedigree_meiosis_L1_dists <- function(suspect, generation_upper_bound_in_result = -1L, error_on_no_haplotype = TRUE) {
.Call('_malan_pedigree_haplotype_matches_in_pedigree_meiosis_L1_dists', PACKAGE = 'malan', suspect, generation_upper_bound_in_result, error_on_no_haplotype)
}
#' Information about almost matching individuals
#'
#' Gives information about all individuals in pedigree that almost matches
#' an individual.
#' Just as [count_haplotype_near_matches_individuals()] counts the number of
#' occurrences amongst a list of individuals,
#' this gives detailed information about almost matching individuals in
#' the pedigree: for now, the meiotic distances.
#'
#' @param suspect Individual that others must match the profile of.
#' @param max_dist Maximum distance (0 = match, 1 = 1 STR allele difference, ...)
#' @param generation_upper_bound_in_result Only consider matches in
#' generation 0, 1, ... generation_upper_bound_in_result.
#' -1 means disabled, consider all generations.
#' End generation is generation 0.
#' Second last generation is 1.
#' And so on.
#'
#' @return Matrix with information about matching individuals.
#' Columns in order: 1) meioses (meiotic distance to `suspect`),
#' 2) haplotype distance, 3) pid (pid of matching individual)
#'
#' @seealso [count_haplotype_near_matches_individuals()].
#'
#' @export
pedigree_haplotype_near_matches_meiosis <- function(suspect, max_dist, generation_upper_bound_in_result = -1L) {
.Call('_malan_pedigree_haplotype_near_matches_meiosis', PACKAGE = 'malan', suspect, max_dist, generation_upper_bound_in_result)
}
#' Meiotic distance between two individuals
#'
#' Get the number of meioses between two individuals.
#' Note, that pedigrees must first have been inferred by [build_pedigrees()].
#'
#' @param ind1 Individual 1
#' @param ind2 Individual 2
#'
#' @return Number of meioses between `ind1` and `ind2` if they are in the same pedigree, else -1.
#'
#' @export
meiotic_dist <- function(ind1, ind2) {
.Call('_malan_meiotic_dist', PACKAGE = 'malan', ind1, ind2)
}
#' Meiotic distance between two individuals (with threshold)
#'
#' Get the number of meioses between two individuals.
#' Note, that pedigrees must first have been inferred by [build_pedigrees()].
#'
#' @param ind1 Individual 1
#' @param ind2 Individual 2
#' @param threshold Max search radius, if exceeding, return -1
#'
#' @return Number of meioses between `ind1` and `ind2` if they are in the same pedigree, else -1.
#'
#' @export
meiotic_dist_threshold <- function(ind1, ind2, threshold) {
.Call('_malan_meiotic_dist_threshold', PACKAGE = 'malan', ind1, ind2, threshold)
}
#' Meiotic radius
#'
#' Get all individual IDs within a meiotic radius
#' Note, that pedigrees must first have been inferred by [build_pedigrees()].
#'
#' @param ind Individual
#' @param radius Max radius
#'
#' @return Matrix with ID and meiotic radius
#'
#' @export
meiotic_radius <- function(ind, radius) {
.Call('_malan_meiotic_radius', PACKAGE = 'malan', ind, radius)
}
#' Convert haplotypes to hashes (integers)
#'
#' Individuals with the same haplotype will have the same hash (integer)
#' and individuals with different haplotypes will have different hashes (integers).
#'
#' This can be useful if for example using haplotypes to define groups
#' and the haplotype itself is not of interest.
#'
#' @param population Population obtained from simulation
#' @param pids Vector of individual pids
#'
#' @return Integer vector with haplotype hashes
#'
#' @export
haplotypes_to_hashes <- function(population, pids) {
.Call('_malan_haplotypes_to_hashes', PACKAGE = 'malan', population, pids)
}
#' Split pids by haplotype
#'
#' Individuals with the same haplotype will be in the same group
#' and individuals with different haplotypes will be in different groups.
#'
#' @param population Population obtained from simulation
#' @param pids Vector of individual pids
#'
#' @return List of integer vector, element i is an IntegerVector
#' with all pids from `pids` with the same haplotype
#'
#' @export
split_by_haplotypes <- function(population, pids) {
.Call('_malan_split_by_haplotypes', PACKAGE = 'malan', population, pids)
}
#' Get individuals partially matching from list of individuals
#'
#' Get the indvididuals that partially matches `haplotype` in `individuals`.
#'
#' @param individuals List of individuals to count occurrences in.
#' @param haplotype Haplotype to count occurrences of.
#' @param ignore_loci Vector of loci to ignore (1 = ignore first locus etc.)
#'
#' @return List of individuals that partially matches `haplotype` amongst `individuals`.
#'
#' @export
haplotype_partially_matches_individuals <- function(individuals, haplotype, ignore_loci = as.integer( c())) {
.Call('_malan_haplotype_partially_matches_individuals', PACKAGE = 'malan', individuals, haplotype, ignore_loci)
}
#' Build hashmap of haplotype to individuals
#'
#' Makes it possible to find all individuals' pid with a certain haplotype.
#' Must be used with e.g. [get_matching_pids_from_hashmap()].
#'
#' @param individuals List of individuals to build hashmap of
#' @param progress Show progress?
#'
#' @return External pointer to hashmap with haplotype as keys and vector of individuals' pid as value
#'
#' @seealso [get_matching_pids_from_hashmap()].
#'
#' @export
build_haplotype_hashmap <- function(individuals, progress = TRUE) {
.Call('_malan_build_haplotype_hashmap', PACKAGE = 'malan', individuals, progress)
}
#' Delete haplotype hashmap
#'
#' Delete hashmap made by [build_haplotype_hashmap()].
#'
#' @param hashmap Hashmap made by [build_haplotype_hashmap()]
#'
#' @seealso [get_matching_pids_from_hashmap()]
#' and [build_haplotype_hashmap()].
#'
#' @export
delete_haplotypeids_hashmap <- function(hashmap) {
invisible(.Call('_malan_delete_haplotypeids_hashmap', PACKAGE = 'malan', hashmap))
}
#' Get individuals with a certain haplotype id by hashmap lookup
#'
#' By using hashmap made by [build_haplotype_hashmap()],
#' it is easy to get all individuals with a certain haplotype id.
#'
#' @param hashmap Hashmap to make lookup in, made by [build_haplotype_hashmap()]
#' @param haplotype to get individuals that has this haplotype id
#'
#' @return List of individuals with a given haplotype id
#'
#' @seealso [build_haplotype_hashmap()].
#'
#' @export
get_matching_pids_from_hashmap <- function(hashmap, haplotype) {
.Call('_malan_get_matching_pids_from_hashmap', PACKAGE = 'malan', hashmap, haplotype)
}
#' Get individual by pid
#'
#' @param population Population
#' @param pid pid
#'
#' @examples
#' sim <- sample_geneology(100, 10)
#' indv <- get_individual(sim$population, 1)
#' get_pid(indv)
#'
#' @return Individual
#'
#' @export
get_individual <- function(population, pid) {
.Call('_malan_get_individual', PACKAGE = 'malan', population, pid)
}
#' Get pid from individual
#'
#' @param individual Individual to get pid of
#'
#' @return pid
#'
#' @examples
#' sim <- sample_geneology(100, 10)
#' indv <- get_individual(sim$population, 1)
#' get_pid(indv)
#'
#' @export
get_pid <- function(individual) {
.Call('_malan_get_pid', PACKAGE = 'malan', individual)
}
#' Print individual
#'
#' @param individual Individual
#'
#' @examples
#' sim <- sample_geneology(100, 10)
#' indv <- get_individual(sim$population, 1)
#' print_individual(indv)
#'
#' @export
print_individual <- function(individual) {
invisible(.Call('_malan_print_individual', PACKAGE = 'malan', individual))
}
#' Get individual's generation number
#'
#' Note that generation 0 is final, end generation.
#' 1 is second last generation etc.
#'
#' @param individual Individual
#'
#' @return generation
#'
#' @examples
#' sim <- sample_geneology(100, 10)
#' indv <- get_individual(sim$population, 1)
#' get_generation(indv)
#'
#' @export
get_generation <- function(individual) {
.Call('_malan_get_generation', PACKAGE = 'malan', individual)
}
#' Get pedigree from individual
#'
#' @param individual Individual
#'
#' @return pedigree
#'
#' @export
get_pedigree_from_individual <- function(individual) {
.Call('_malan_get_pedigree_from_individual', PACKAGE = 'malan', individual)
}
#' Get pedigree ids from pids
#'
#' @param population Population
#' @param pids Pids
#'
#' @return Vector with pedigree ids
#'
#' @export
get_pedigree_id_from_pid <- function(population, pids) {
.Call('_malan_get_pedigree_id_from_pid', PACKAGE = 'malan', population, pids)
}
#' Get individual's family information
#'
#' @param individual individual
#'
#' @return List with family information
#'
#' @export
get_family_info <- function(individual) {
.Call('_malan_get_family_info', PACKAGE = 'malan', individual)
}
#' Get father
#'
#' Get individual's father
#'
#' @param individual individual
#'
#' @return Father
#'
#' @seealso [get_brothers()], [get_uncles()], [get_children()], [get_cousins()]
#'
#' @export
get_father <- function(individual) {
.Call('_malan_get_father', PACKAGE = 'malan', individual)
}
#' Get children
#'
#' Get individual's children
#'
#' @param individual individual
#'
#' @return List with children
#'
#' @seealso [get_father()], [get_brothers()], [get_uncles()], [get_cousins()]
#'
#' @export
get_children <- function(individual) {
.Call('_malan_get_children', PACKAGE = 'malan', individual)
}
#' Number of brothers
#'
#' Get individual's number of brothers
#'
#' @param individual individual
#'
#' @return Number of brothers
#'
#' @seealso [get_brothers()]
#'
#' @export
count_brothers <- function(individual) {
.Call('_malan_count_brothers', PACKAGE = 'malan', individual)
}
#' Get brothers
#'
#' Get individual's brothers
#'
#' @param individual individual
#'
#' @return List with brothers
#'
#' @seealso [get_father()], [get_uncles()], [get_children()], [get_cousins()]
#'
#' @export
get_brothers <- function(individual) {
.Call('_malan_get_brothers', PACKAGE = 'malan', individual)
}
#' Number of brothers with matching haplotype
#'
#' Get individual's number of brothers that matches `individual`'s haplotype
#'
#' @param individual individual
#'
#' @return Number of brothers that matches `individual`'s haplotype
#'
#' @export
brothers_matching <- function(individual) {
.Call('_malan_brothers_matching', PACKAGE = 'malan', individual)
}
#' Father matches
#'
#' Does the father have the same profile as `individual`?
#'
#' @param individual individual
#'
#' @return Whether father has the same profile as `individual` or not
#'
#' @export
father_matches <- function(individual) {
.Call('_malan_father_matches', PACKAGE = 'malan', individual)
}
#' Grandfather matches
#'
#' Does the frandfather have the same profile as `individual`?
#'
#' @param individual individual
#'
#' @return Whether grandfather has the same profile as `individual` or not
#'
#' @export
grandfather_matches <- function(individual) {
.Call('_malan_grandfather_matches', PACKAGE = 'malan', individual)
}
#' Number of uncles
#'
#' Get individual's number of uncles
#'
#' @param individual individual
#'
#' @return Number of uncles
#'
#' @seealso [get_uncles()]
#'
#' @export
count_uncles <- function(individual) {
.Call('_malan_count_uncles', PACKAGE = 'malan', individual)
}
#' Get uncles
#'
#' Get individual's uncles
#'
#' @param individual individual
#'
#' @return List with uncles
#'
#' @seealso [get_brothers()], [get_children()], [get_cousins()]
#'
#' @export
get_uncles <- function(individual) {
.Call('_malan_get_uncles', PACKAGE = 'malan', individual)
}
#' Get cousins
#'
#' Get individual's cousins
#'
#' @param individual individual
#'
#' @return List with cousins
#'
#' @seealso [get_brothers()], [get_uncles()], [get_children()]
#'
#' @export
get_cousins <- function(individual) {
.Call('_malan_get_cousins', PACKAGE = 'malan', individual)
}
pop_size <- function(population) {
.Call('_malan_pop_size', PACKAGE = 'malan', population)
}
#' Get all individuals in population
#'
#' @param population Population
#'
#' @export
get_individuals <- function(population) {
.Call('_malan_get_individuals', PACKAGE = 'malan', population)
}
#' Meiotic distribution
#'
#' Get the distribution of number of meioses from `individual`
#' to all individuals in `individual`'s pedigree.
#' Note the `generation_upper_bound_in_result` parameter.
#'
#' @param individual Individual to calculate all meiotic distances from
#' @param generation_upper_bound_in_result Limit on distribution; -1 means no limit.
#' 0 is the final generation. 1 second last generation etc.
#'
#' @export
meioses_generation_distribution <- function(individual, generation_upper_bound_in_result = -1L) {
.Call('_malan_meioses_generation_distribution', PACKAGE = 'malan', individual, generation_upper_bound_in_result)
}
#' Size of population
#'
#' Get the size of the population.
#' Note the `generation_upper_bound_in_result` parameter.
#'
#' @param population Population to get size of
#' @param generation_upper_bound_in_result Limit on generation to include in count; -1 means no limit.
#' 0 only include the final generation. 1 only second last generation etc.
#'
#' @export
population_size_generation <- function(population, generation_upper_bound_in_result = -1L) {
.Call('_malan_population_size_generation', PACKAGE = 'malan', population, generation_upper_bound_in_result)
}
#' Size of pedigree
#'
#' Get the size of the pedigree.
#' Note the `generation_upper_bound_in_result` parameter.
#'
#' @param pedigree Pedigree to get size of
#' @param generation_upper_bound_in_result Limit on generation to include in count; -1 means no limit.
#' 0 only include the final generation. 1 only second last generation etc.
#'
#' @export
pedigree_size_generation <- function(pedigree, generation_upper_bound_in_result = -1L) {
.Call('_malan_pedigree_size_generation', PACKAGE = 'malan', pedigree, generation_upper_bound_in_result)
}
#' Mixture information about 2 persons' mixture of donor1 and donor2.
#'
#' @param individuals Individuals to consider as possible contributors and thereby get information from.
#' @param donor1 Contributor1/donor 1
#' @param donor2 Contributor2/donor 2
#' @param include_genealogy_info Include information about meiotic distances and family info
#' @return A list with mixture information about the mixture \code{donor1}+\code{donor2}+\code{donor3} from \code{individuals}
#'
#' @seealso \code{\link{mixture_info_by_individuals_3pers}},
#' \code{\link{mixture_info_by_individuals_4pers}},
#' \code{\link{mixture_info_by_individuals_5pers}}
#'
#' @export
mixture_info_by_individuals_2pers <- function(individuals, donor1, donor2, include_genealogy_info = TRUE) {
.Call('_malan_mixture_info_by_individuals_2pers', PACKAGE = 'malan', individuals, donor1, donor2, include_genealogy_info)
}
#' Mixture information about 3 persons' mixture of donor1, donor2 and donor3.
#'
#' @inherit mixture_info_by_individuals_2pers
#' @param donor3 Contributor3/donor 3
#'
#' @seealso \code{\link{mixture_info_by_individuals_2pers}},
#' \code{\link{mixture_info_by_individuals_4pers}},
#' \code{\link{mixture_info_by_individuals_5pers}}
#'
#' @export
mixture_info_by_individuals_3pers <- function(individuals, donor1, donor2, donor3) {
.Call('_malan_mixture_info_by_individuals_3pers', PACKAGE = 'malan', individuals, donor1, donor2, donor3)
}
#' Mixture information about 4 persons' mixture of donor1, donor2, donor3 and donor4.
#'
#' @inherit mixture_info_by_individuals_3pers
#' @param donor4 Contributor4/donor 4
#'
#' @seealso \code{\link{mixture_info_by_individuals_2pers}},
#' \code{\link{mixture_info_by_individuals_3pers}},
#' \code{\link{mixture_info_by_individuals_5pers}}
#'
#' @export
mixture_info_by_individuals_4pers <- function(individuals, donor1, donor2, donor3, donor4) {
.Call('_malan_mixture_info_by_individuals_4pers', PACKAGE = 'malan', individuals, donor1, donor2, donor3, donor4)
}
#' Mixture information about 5 persons' mixture of donor1, donor2, donor3, donor4 and donor5.
#'
#' @inherit mixture_info_by_individuals_4pers
#' @param donor5 Contributor5/donor 5
#'
#' @seealso \code{\link{mixture_info_by_individuals_2pers}},
#' \code{\link{mixture_info_by_individuals_3pers}},
#' \code{\link{mixture_info_by_individuals_4pers}}
#'
#' @export
mixture_info_by_individuals_5pers <- function(individuals, donor1, donor2, donor3, donor4, donor5) {
.Call('_malan_mixture_info_by_individuals_5pers', PACKAGE = 'malan', individuals, donor1, donor2, donor3, donor4, donor5)
}
#' Analyse mixture results
#'
#' Calculate LR-like quantities by haplotype counts.
#'
#' NOTE: Only takes up to 9 contributors!
#'
#' @param mix_res Mixture result from [mixture_info_by_individuals_2pers()],
#' [mixture_info_by_individuals_3pers()], [mixture_info_by_individuals_4pers()],
#' [mixture_info_by_individuals_5pers()]
#' @param unique_haps_in_mixture Included unique haplotypes to use as elements in contributor sets.
#' @param unique_haps_in_mixture_counts Population counts of the included haplotypes
#'
#' @return A list with numeric quantities
analyse_mixture_result <- function(mix_res, unique_haps_in_mixture, unique_haps_in_mixture_counts) {
.Call('_malan_analyse_mixture_result', PACKAGE = 'malan', mix_res, unique_haps_in_mixture, unique_haps_in_mixture_counts)
}
#' Analyse mixture results in a vectorised fashion
#'
#' Refer to [analyse_mixture_result()] for details.
#' Essentially, [analyse_mixture_result()] is run on each element of `mixture_results`.
#'
#' NOTE: Only takes up to 9 contributors!
#'
#' @param mixture_results List of `n` mixture results from [mixture_info_by_individuals_2pers()],
#' [mixture_info_by_individuals_3pers()], [mixture_info_by_individuals_4pers()],
#' [mixture_info_by_individuals_5pers()]
#' @param unique_haps_in_mixture_list List of `n` included unique haplotypes, one for each element in `mix_res`
#' @param unique_haps_in_mixture_counts_list List of `n` population counts of the included unique haplotypes
#'
#' @return A list with lists of numeric quantities
analyse_mixture_results <- function(mixture_results, unique_haps_in_mixture_list, unique_haps_in_mixture_counts_list) {
.Call('_malan_analyse_mixture_results', PACKAGE = 'malan', mixture_results, unique_haps_in_mixture_list, unique_haps_in_mixture_counts_list)
}
#' Get pedigree id
#'
#' @param ped Pedigree
#'
#' @examples
#' sim <- sample_geneology(100, 10)
#' peds <- build_pedigrees(sim$population)
#' get_pedigree_id(peds[[1]])
#'
#' @export
get_pedigree_id <- function(ped) {
.Call('_malan_get_pedigree_id', PACKAGE = 'malan', ped)
}
#' Get number of pedigrees
#'
#' @param pedigrees Pedigrees
#'
#' @examples
#' sim <- sample_geneology(100, 10)
#' peds <- build_pedigrees(sim$population)
#' pedigrees_count(peds)
#'
#' @export
pedigrees_count <- function(pedigrees) {
.Call('_malan_pedigrees_count', PACKAGE = 'malan', pedigrees)
}
#' Get pedigree size
#'
#' @param ped Pedigree
#'
#' @examples
#' sim <- sample_geneology(100, 10)
#' peds <- build_pedigrees(sim$population)
#' pedigree_size(peds[[1]])
#'
#' @export
pedigree_size <- function(ped) {
.Call('_malan_pedigree_size', PACKAGE = 'malan', ped)
}
#' Get distribution of pedigree sizes
#'
#' @param pedigrees Pedigrees
#'
#' @examples
#' sim <- sample_geneology(100, 10)
#' peds <- build_pedigrees(sim$population)
#' pedigrees_table(peds)
#'
#' @export
pedigrees_table <- function(pedigrees) {
.Call('_malan_pedigrees_table', PACKAGE = 'malan', pedigrees)
}
get_pedigree <- function(pedigrees, index) {
.Call('_malan_get_pedigree', PACKAGE = 'malan', pedigrees, index)
}
print_pedigree <- function(ped) {
invisible(.Call('_malan_print_pedigree', PACKAGE = 'malan', ped))
}
#' Get pids in pedigree
#'
#' @param ped Pedigree
#'
#' @examples
#' sim <- sample_geneology(100, 10)
#' peds <- build_pedigrees(sim$population)
#' get_pids_in_pedigree(peds[[1]])
#'
#' @export
get_pids_in_pedigree <- function(ped) {
.Call('_malan_get_pids_in_pedigree', PACKAGE = 'malan', ped)
}
#' Get haplotypes in pedigree
#'
#' @param ped Pedigree
#'
#' @examples
#' sim <- sample_geneology(100, 10)
#' peds <- build_pedigrees(sim$population)
#' pedigrees_all_populate_haplotypes(peds, 2, c(1, 1))
#' get_haplotypes_in_pedigree(peds[[1]])
#'
#' @return List with haplotypes
#'
#' @export
get_haplotypes_in_pedigree <- function(ped) {
.Call('_malan_get_haplotypes_in_pedigree', PACKAGE = 'malan', ped)
}
get_pedigree_edgelist <- function(ped) {
.Call('_malan_get_pedigree_edgelist', PACKAGE = 'malan', ped)
}
#' Get pedigree information as graph (mainly intended for plotting)
#'
#' @param ped Pedigree
#'
#' @export
get_pedigree_as_graph <- function(ped) {
.Call('_malan_get_pedigree_as_graph', PACKAGE = 'malan', ped)
}
#' Get pedigrees information in tidy format
#'
#' @param pedigrees Pedigrees
#'
get_pedigrees_tidy <- function(pedigrees) {
.Call('_malan_get_pedigrees_tidy', PACKAGE = 'malan', pedigrees)
}
#' Generate test population
#'
#' @return An external pointer to the population.
test_create_population <- function() {
.Call('_malan_test_create_population', PACKAGE = 'malan')
}
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.