Nothing
.prep_edge_list <- function(from, to, weight_data, edge_weights,
init = integer()){
if(is.null(edge_weights))
edge_weights <- rep(1, length(from))
stopifnot(length(from) == length(to), length(from) == length(edge_weights),
all(is.finite(from)), all(is.finite(to)),
all(is.finite(edge_weights)))
id <- unique(c(from, to))
n <- length(id)
from <- match(from, id, nomatch = n + 1L) - 1L
to <- match(to , id, nomatch = n + 1L) - 1L
if(is.null(weight_data)){
weights_ids = integer()
weights = numeric()
} else {
# checks
stopifnot(is.list(weight_data),
c("id", "weight") %in% names(weight_data),
length(weight_data$id) == length(weight_data$weight),
is.vector(weight_data$id), is.finite(weight_data$id),
is.vector(weight_data$weight), is.finite(weight_data$weight))
# get the elements
weights_ids <- match(weight_data$id, id, nomatch = n + 1L) - 1L
weights <- weight_data$weight
}
init <- match(init, id, nomatch = NA_integer_)
init <- init[!is.na(init)] - 1L
list(from = from, to = to, id = id, weights_ids = weights_ids,
weights = weights, edge_weights = edge_weights, init = init)
}
#' Finds the Biconnected Components
#'
#' @description
#' Finds the biconnected components and the cut vertices (articulation points)
#' using the methods suggested by Hopcroft et al. (1973).
#'
#' @param from integer vector with one of the vertex ids.
#' @param to integer vector with one of the vertex ids.
#'
#' @seealso
#' \code{\link{block_cut_tree}} and
#' \code{\link{max_balanced_partition}}.
#'
#' @return
#' A list with vectors of vertices in each biconnected component. An
#' attribute called \code{"cut_verices"} contains the cut vertices in each
#' biconnected component.
#'
#' @references
#' Hopcroft, J., & Tarjan, R. (1973).
#' \emph{Algorithm 447: efficient algorithms for graph manipulation}.
#' Communications of the ACM, 16(6), 372-378.
#'
#' @examples
#' # example of a data set in pedigree and graph form
#' library(pedmod)
#' dat_pedigree <- data.frame(
#' id = 1:48,
#' mom = c(
#' NA, NA, 2L, 2L, 2L, NA, NA, 7L, 7L, 7L, 3L, 3L, 3L, 3L, NA, 15L, 15L, 43L,
#' 18L, NA, NA, 21L, 21L, 9L, 9L, 9L, 9L, NA, NA, 29L, 29L, 29L, 30L, 30L, NA,
#' NA, 36L, 36L, 36L, 38L, 38L, NA, NA, 43L, 43L, 43L, 32L, 32L),
#' dad = c(NA, NA, 1L, 1L, 1L, NA, NA, 6L, 6L, 6L, 8L, 8L, 8L, 8L, NA, 4L, 4L,
#' 42L, 5L, NA, NA, 20L, 20L, 22L, 22L, 22L, 22L, NA, NA, 28L, 28L, 28L,
#' 23L, 23L, NA, NA, 35L, 35L, 35L, 31L, 31L, NA, NA, 42L, 42L, 42L,
#' 45L, 45L),
#' sex = c(1L, 2L, 2L, 1L, 1L, 1L, 2L, 1L, 2L, 2L, 2L, 1L, 1L, 1L, 2L, 2L, 2L,
#' 2L, 1L, 1L, 2L, 1L, 1L, 2L, 1L, 1L, 2L, 1L, 2L, 2L, 1L, 2L, 2L, 2L,
#' 1L, 2L, 1L, 2L, 1L, 2L, 1L, 1L, 2L, 2L, 1L, 1L, 2L, 2L))
#'
#' dat <- list(
#' to = c(
#' 3L, 4L, 5L, 8L, 9L, 10L, 11L, 12L, 13L, 14L, 16L, 17L, 18L, 19L, 22L, 23L,
#' 24L, 25L, 26L, 27L, 30L, 31L, 32L, 33L, 34L, 37L, 38L, 39L, 40L, 41L, 44L,
#' 45L, 46L, 47L, 48L, 3L, 4L, 5L, 8L, 9L, 10L, 11L, 12L, 13L, 14L, 16L, 17L,
#' 18L, 19L, 22L, 23L, 24L, 25L, 26L, 27L, 30L, 31L, 32L, 33L, 34L, 37L, 38L,
#' 39L, 40L, 41L, 44L, 45L, 46L, 47L, 48L),
#' from = c(
#' 1L, 1L, 1L, 6L, 6L, 6L, 8L, 8L, 8L, 8L, 4L, 4L, 42L, 5L, 20L, 20L, 22L, 22L,
#' 22L, 22L, 28L, 28L, 28L, 23L, 23L, 35L, 35L, 35L, 31L, 31L, 42L, 42L, 42L,
#' 45L, 45L, 2L, 2L, 2L, 7L, 7L, 7L, 3L, 3L, 3L, 3L, 15L, 15L, 43L, 18L, 21L,
#' 21L, 9L, 9L, 9L, 9L, 29L, 29L, 29L, 30L, 30L, 36L, 36L, 36L, 38L, 38L, 43L,
#' 43L, 43L, 32L, 32L))
#'
#' # they give the same
#' out_pedigree <- biconnected_components_pedigree(
#' id = dat_pedigree$id, father.id = dat_pedigree$dad,
#' mother.id = dat_pedigree$mom)
#' out <- biconnected_components(dat$to, dat$from)
#' all.equal(out_pedigree, out)
#'
#' @export
biconnected_components <- function(from, to){
dat <- .prep_edge_list(from = from, to = to, weight_data = NULL,
edge_weights = NULL)
id <- dat$id
out <- with(dat, .biconnected_components(from, to, weights_ids,
weights, edge_weights))
lapply(out, function(x)
structure(sort(id[x]),
cut_verices = sort(id[attr(x, "cut_verices")])))
}
.pedigree_to_from_to <- function(id, father.id, mother.id, id_weight = NULL,
father_weight = NULL, mother_weight = NULL,
init = integer()){
n <- length(id)
stopifnot(length(father.id) == n, length(mother.id) == n)
to <- c(id, id)
from <- c(father.id, mother.id)
keep <- !is.na(from) & from %in% id
if(is.null(id_weight)){
weights_ids = integer()
weights = numeric()
} else {
stopifnot(length(id_weight) == n, all(is.finite(id_weight)))
weights_ids <- id
weights <- id_weight
}
if(is.null(father_weight))
father_weight <- rep(1, n)
else
stopifnot(length(father_weight) == n, all(is.finite(father_weight)))
if(is.null(mother_weight))
mother_weight <- rep(1, n)
else
stopifnot(length(mother_weight) == n, all(is.finite(mother_weight)))
edge_weights <- c(father_weight, mother_weight)
list(to = to[keep], from = from[keep], edge_weights = edge_weights[keep],
weight_data = list(id = weights_ids, weight = weights),
init = init)
}
#' @rdname biconnected_components
#'
#' @param id integer vector with the child id.
#' @param father.id integer vector with the father id. May be \code{NA} if
#' it is missing.
#' @param mother.id integer vector with the mother id. May be \code{NA} if
#' it is missing.
#'
#' @export
biconnected_components_pedigree <- function(id, father.id, mother.id){
dat <- .pedigree_to_from_to(id = id, father.id = father.id,
mother.id = mother.id)
with(dat, biconnected_components(from = from, to = to))
}
#' Creates a Block-cut Tree Like Object
#'
#' @description
#' Creates a block-cut tree like structure computed using the method suggested
#' by Hopcroft et al. (1973).
#'
#' @inheritParams biconnected_components
#'
#' @seealso
#' \code{\link{biconnected_components}} and
#' \code{\link{max_balanced_partition}}.
#'
#' @references
#' Hopcroft, J., & Tarjan, R. (1973).
#' \emph{Algorithm 447: efficient algorithms for graph manipulation}.
#' Communications of the ACM, 16(6), 372-378.
#'
#' @return
#' A tree structure where each node is represented as list that
#' contains the vertices in the biconnected component, the cut_vertices,
#' and the node's leafs.
#'
#' @examples
#' # example of a data set in pedigree and graph form
#' library(pedmod)
#' dat_pedigree <- data.frame(
#' id = 1:48,
#' mom = c(
#' NA, NA, 2L, 2L, 2L, NA, NA, 7L, 7L, 7L, 3L, 3L, 3L, 3L, NA, 15L, 15L, 43L,
#' 18L, NA, NA, 21L, 21L, 9L, 9L, 9L, 9L, NA, NA, 29L, 29L, 29L, 30L, 30L, NA,
#' NA, 36L, 36L, 36L, 38L, 38L, NA, NA, 43L, 43L, 43L, 32L, 32L),
#' dad = c(NA, NA, 1L, 1L, 1L, NA, NA, 6L, 6L, 6L, 8L, 8L, 8L, 8L, NA, 4L, 4L,
#' 42L, 5L, NA, NA, 20L, 20L, 22L, 22L, 22L, 22L, NA, NA, 28L, 28L, 28L,
#' 23L, 23L, NA, NA, 35L, 35L, 35L, 31L, 31L, NA, NA, 42L, 42L, 42L,
#' 45L, 45L),
#' sex = c(1L, 2L, 2L, 1L, 1L, 1L, 2L, 1L, 2L, 2L, 2L, 1L, 1L, 1L, 2L, 2L, 2L,
#' 2L, 1L, 1L, 2L, 1L, 1L, 2L, 1L, 1L, 2L, 1L, 2L, 2L, 1L, 2L, 2L, 2L,
#' 1L, 2L, 1L, 2L, 1L, 2L, 1L, 1L, 2L, 2L, 1L, 1L, 2L, 2L))
#'
#' dat <- list(
#' to = c(
#' 3L, 4L, 5L, 8L, 9L, 10L, 11L, 12L, 13L, 14L, 16L, 17L, 18L, 19L, 22L, 23L,
#' 24L, 25L, 26L, 27L, 30L, 31L, 32L, 33L, 34L, 37L, 38L, 39L, 40L, 41L, 44L,
#' 45L, 46L, 47L, 48L, 3L, 4L, 5L, 8L, 9L, 10L, 11L, 12L, 13L, 14L, 16L, 17L,
#' 18L, 19L, 22L, 23L, 24L, 25L, 26L, 27L, 30L, 31L, 32L, 33L, 34L, 37L, 38L,
#' 39L, 40L, 41L, 44L, 45L, 46L, 47L, 48L),
#' from = c(
#' 1L, 1L, 1L, 6L, 6L, 6L, 8L, 8L, 8L, 8L, 4L, 4L, 42L, 5L, 20L, 20L, 22L, 22L,
#' 22L, 22L, 28L, 28L, 28L, 23L, 23L, 35L, 35L, 35L, 31L, 31L, 42L, 42L, 42L,
#' 45L, 45L, 2L, 2L, 2L, 7L, 7L, 7L, 3L, 3L, 3L, 3L, 15L, 15L, 43L, 18L, 21L,
#' 21L, 9L, 9L, 9L, 9L, 29L, 29L, 29L, 30L, 30L, 36L, 36L, 36L, 38L, 38L, 43L,
#' 43L, 43L, 32L, 32L))
#'
#' # they give the same
#' out_pedigree <- block_cut_tree_pedigree(
#' id = dat_pedigree$id, father.id = dat_pedigree$dad,
#' mother.id = dat_pedigree$mom)
#' out <- block_cut_tree(dat$to, dat$from)
#' all.equal(out_pedigree, out)
#'
#' @export
block_cut_tree <- function(from, to){
dat <- .prep_edge_list(from = from, to = to, weight_data = NULL,
edge_weights = NULL)
id <- dat$id
out <- with(dat, .block_cut_tree(from, to, weights_ids,
weights, edge_weights))
. <- function(x)
list(vertices = sort(id[x$vertices]),
cut_vertices = sort(id[x$cut_vertices]),
leafs = lapply(x$leafs, .))
.(out)
}
#' @rdname block_cut_tree
#' @export
block_cut_tree_pedigree <- function(id, father.id, mother.id){
dat <- .pedigree_to_from_to(id = id, father.id = father.id,
mother.id = mother.id)
with(dat, block_cut_tree(from = from, to = to))
}
.sort_partition_result <- function(out, id){
removed_edges <- out$removed_edges
removed_edges[] <- id[removed_edges]
removed_edges[] <- t(apply(removed_edges, 1L, sort))
removed_edges <- removed_edges[
order(removed_edges[, 1], removed_edges[, 2]), , drop = FALSE]
colnames(removed_edges) <- c("from", "to")
out$removed_edges <- removed_edges
out$set_1 <- sort(id[out$set_1])
out$set_2 <- sort(id[out$set_2])
out
}
#' Finds an Approximately Balanced Connected Partition
#' @description
#' Uses the method suggested by Chlebíková (1996) to construct an approximate
#' maximally balanced connected partition. A further refinement step can be made
#' to reduce the cost of the cut edges. See
#' \code{vignette("pedigree_partitioning", package = "pedmod")} for further
#' details.
#'
#' @inheritParams biconnected_components
#' @param weight_data list with two elements called \code{"id"} for the id and
#' \code{"weight"} for the vertex weight. All vertices that are not in this list
#' have a weight of one. Use \code{NULL} if all vertices have a weight of one.
#' @param slack fraction between zero and 0.5 for the allowed amount of
#' deviation from the balance criterion that is allowed to reduce the cost of
#' the cut edges.
#' @param max_kl_it_inner maximum number of moves to consider in each
#' iteration when \code{slack > 0}.
#' @param max_kl_it maximum number of iterations to use when reducing the
#' cost of the cut edges. Typically the method converges quickly and this
#' argument is not needed.
#' @param trace integer where larger values yields more information printed to
#' the console during the procedure.
#' @param edge_weights numeric vector with weights for each edge. Needs to have
#' the same length as \code{from} and \code{to}. Use \code{NULL} if all edges
#' should have a weight of one.
#' @param check_weights logical for whether to check the weights in each
#' biconnected component. This may fail if the graph is not connected in which
#' case the results will likely be wrong. It may also fail for large graphs
#' because of floating-point arithmetic. The latter is not an error and the
#' reason for this argument.
#' @param do_reorder logical for whether the implementation should reorder the
#' vertices. This may reduce the computation time for some data sets.
#'
#' @seealso
#' \code{\link{biconnected_components}},
#' \code{\link{block_cut_tree}}, and
#' \code{\link{unconnected_partition}}.
#'
#' @references
#' Chlebíková, J. (1996).
#' \emph{Approximating the maximally balanced connected partition problem in
#' graphs}. Information Processing Letters, 60(5), 225-230.
#'
#' Hopcroft, J., & Tarjan, R. (1973).
#' \emph{Algorithm 447: efficient algorithms for graph manipulation}.
#' Communications of the ACM, 16(6), 372-378.
#'
#' @return
#' A list with the following elements:
#' \item{balance_criterion}{value of the balance criterion.}
#' \item{removed_edges}{2D integer matrix with the removed edges.}
#' \item{set_1,set_2}{The two sets in the partition.}
#'
#' @examples
#' # example of a data set in pedigree and graph form
#' library(pedmod)
#' dat_pedigree <- data.frame(
#' id = 1:48,
#' mom = c(
#' NA, NA, 2L, 2L, 2L, NA, NA, 7L, 7L, 7L, 3L, 3L, 3L, 3L, NA, 15L, 15L, 43L,
#' 18L, NA, NA, 21L, 21L, 9L, 9L, 9L, 9L, NA, NA, 29L, 29L, 29L, 30L, 30L, NA,
#' NA, 36L, 36L, 36L, 38L, 38L, NA, NA, 43L, 43L, 43L, 32L, 32L),
#' dad = c(NA, NA, 1L, 1L, 1L, NA, NA, 6L, 6L, 6L, 8L, 8L, 8L, 8L, NA, 4L, 4L,
#' 42L, 5L, NA, NA, 20L, 20L, 22L, 22L, 22L, 22L, NA, NA, 28L, 28L, 28L,
#' 23L, 23L, NA, NA, 35L, 35L, 35L, 31L, 31L, NA, NA, 42L, 42L, 42L,
#' 45L, 45L),
#' sex = c(1L, 2L, 2L, 1L, 1L, 1L, 2L, 1L, 2L, 2L, 2L, 1L, 1L, 1L, 2L, 2L, 2L,
#' 2L, 1L, 1L, 2L, 1L, 1L, 2L, 1L, 1L, 2L, 1L, 2L, 2L, 1L, 2L, 2L, 2L,
#' 1L, 2L, 1L, 2L, 1L, 2L, 1L, 1L, 2L, 2L, 1L, 1L, 2L, 2L))
#'
#' dat <- list(
#' to = c(
#' 3L, 4L, 5L, 8L, 9L, 10L, 11L, 12L, 13L, 14L, 16L, 17L, 18L, 19L, 22L, 23L,
#' 24L, 25L, 26L, 27L, 30L, 31L, 32L, 33L, 34L, 37L, 38L, 39L, 40L, 41L, 44L,
#' 45L, 46L, 47L, 48L, 3L, 4L, 5L, 8L, 9L, 10L, 11L, 12L, 13L, 14L, 16L, 17L,
#' 18L, 19L, 22L, 23L, 24L, 25L, 26L, 27L, 30L, 31L, 32L, 33L, 34L, 37L, 38L,
#' 39L, 40L, 41L, 44L, 45L, 46L, 47L, 48L),
#' from = c(
#' 1L, 1L, 1L, 6L, 6L, 6L, 8L, 8L, 8L, 8L, 4L, 4L, 42L, 5L, 20L, 20L, 22L, 22L,
#' 22L, 22L, 28L, 28L, 28L, 23L, 23L, 35L, 35L, 35L, 31L, 31L, 42L, 42L, 42L,
#' 45L, 45L, 2L, 2L, 2L, 7L, 7L, 7L, 3L, 3L, 3L, 3L, 15L, 15L, 43L, 18L, 21L,
#' 21L, 9L, 9L, 9L, 9L, 29L, 29L, 29L, 30L, 30L, 36L, 36L, 36L, 38L, 38L, 43L,
#' 43L, 43L, 32L, 32L))
#'
#' # the results may be different because of different orders!
#' out_pedigree <- max_balanced_partition_pedigree(
#' id = dat_pedigree$id, father.id = dat_pedigree$dad,
#' mother.id = dat_pedigree$mom)
#' out <- max_balanced_partition(dat$to, dat$from)
#'
#' all.equal(out_pedigree$balance_criterion, out$balance_criterion)
#' all.equal(out_pedigree$removed_edges, out$removed_edges)
#'
#' @export
max_balanced_partition <- function(from, to, weight_data = NULL,
edge_weights = NULL,
slack = 0., max_kl_it_inner = 50L,
max_kl_it = 10000L, trace = 0L,
check_weights = TRUE,
do_reorder = FALSE){
dat <- .prep_edge_list(from = from, to = to, weight_data = weight_data,
edge_weights = edge_weights)
id <- dat$id
out <- with(dat, .max_balanced_partition(
from, to, weights_ids, weights, slack = slack, edge_weights = edge_weights,
max_kl_it_inner = max_kl_it_inner, max_kl_it = max_kl_it, trace = trace,
check_weights = check_weights, do_reorder = do_reorder))
# set and sort the removed edges
.sort_partition_result(out, id)
}
#' @rdname max_balanced_partition
#'
#' @param id_weight numeric vector with the weight to use for each vertex
#' (individual). \code{NULL} yields a weight of one for all.
#' @param father_weight weights of the edges created between the fathers
#' and the children. Use \code{NULL} if all should have a weight of one.
#' @param mother_weight weights of the edges created between the mothers
#' and the children. Use \code{NULL} if all should have a weight of one.
#'
#' @export
max_balanced_partition_pedigree <- function(
id, father.id, mother.id, id_weight = NULL, father_weight = NULL,
mother_weight = NULL, slack = 0., max_kl_it_inner = 50L, max_kl_it = 10000L,
trace = 0L, check_weights = TRUE, do_reorder = FALSE){
dat <- .pedigree_to_from_to(id = id, father.id = father.id,
mother.id = mother.id, id_weight = id_weight,
father_weight = father_weight,
mother_weight = mother_weight)
with(dat, max_balanced_partition(
from = from, to = to, weight_data = weight_data, slack = slack,
max_kl_it_inner = max_kl_it_inner, max_kl_it = max_kl_it, trace = trace,
edge_weights = edge_weights, do_reorder = do_reorder,
check_weights = check_weights))
}
#' Finds an Approximately Balanced Partition
#' @inheritParams max_balanced_partition
#' @param init integer vector with ids that one of the two sets in the partition
#' should start out with.
#'
#' @return
#' A list with the following elements:
#' \item{balance_criterion}{value of the balance criterion.}
#' \item{removed_edges}{2D integer matrix with the removed edges.}
#' \item{set_1,set_2}{The two sets in the partition.}
#'
#' @seealso
#' \code{\link{max_balanced_partition}}.
#'
#' @examples
#' # example of a data set in pedigree and graph form
#' library(pedmod)
#' dat_pedigree <- data.frame(
#' id = 1:48,
#' mom = c(
#' NA, NA, 2L, 2L, 2L, NA, NA, 7L, 7L, 7L, 3L, 3L, 3L, 3L, NA, 15L, 15L, 43L,
#' 18L, NA, NA, 21L, 21L, 9L, 9L, 9L, 9L, NA, NA, 29L, 29L, 29L, 30L, 30L, NA,
#' NA, 36L, 36L, 36L, 38L, 38L, NA, NA, 43L, 43L, 43L, 32L, 32L),
#' dad = c(NA, NA, 1L, 1L, 1L, NA, NA, 6L, 6L, 6L, 8L, 8L, 8L, 8L, NA, 4L, 4L,
#' 42L, 5L, NA, NA, 20L, 20L, 22L, 22L, 22L, 22L, NA, NA, 28L, 28L, 28L,
#' 23L, 23L, NA, NA, 35L, 35L, 35L, 31L, 31L, NA, NA, 42L, 42L, 42L,
#' 45L, 45L),
#' sex = c(1L, 2L, 2L, 1L, 1L, 1L, 2L, 1L, 2L, 2L, 2L, 1L, 1L, 1L, 2L, 2L, 2L,
#' 2L, 1L, 1L, 2L, 1L, 1L, 2L, 1L, 1L, 2L, 1L, 2L, 2L, 1L, 2L, 2L, 2L,
#' 1L, 2L, 1L, 2L, 1L, 2L, 1L, 1L, 2L, 2L, 1L, 1L, 2L, 2L))
#'
#' dat <- list(
#' to = c(
#' 3L, 4L, 5L, 8L, 9L, 10L, 11L, 12L, 13L, 14L, 16L, 17L, 18L, 19L, 22L, 23L,
#' 24L, 25L, 26L, 27L, 30L, 31L, 32L, 33L, 34L, 37L, 38L, 39L, 40L, 41L, 44L,
#' 45L, 46L, 47L, 48L, 3L, 4L, 5L, 8L, 9L, 10L, 11L, 12L, 13L, 14L, 16L, 17L,
#' 18L, 19L, 22L, 23L, 24L, 25L, 26L, 27L, 30L, 31L, 32L, 33L, 34L, 37L, 38L,
#' 39L, 40L, 41L, 44L, 45L, 46L, 47L, 48L),
#' from = c(
#' 1L, 1L, 1L, 6L, 6L, 6L, 8L, 8L, 8L, 8L, 4L, 4L, 42L, 5L, 20L, 20L, 22L, 22L,
#' 22L, 22L, 28L, 28L, 28L, 23L, 23L, 35L, 35L, 35L, 31L, 31L, 42L, 42L, 42L,
#' 45L, 45L, 2L, 2L, 2L, 7L, 7L, 7L, 3L, 3L, 3L, 3L, 15L, 15L, 43L, 18L, 21L,
#' 21L, 9L, 9L, 9L, 9L, 29L, 29L, 29L, 30L, 30L, 36L, 36L, 36L, 38L, 38L, 43L,
#' 43L, 43L, 32L, 32L))
#'
#' # the results may be different because of different orders!
#' out_pedigree <- unconnected_partition_pedigree(
#' id = dat_pedigree$id, father.id = dat_pedigree$dad,
#' mother.id = dat_pedigree$mom)
#' out <- unconnected_partition(dat$to, dat$from)
#'
#' all.equal(out_pedigree$balance_criterion, out$balance_criterion)
#' all.equal(out_pedigree$removed_edges, out$removed_edges)
#'
#' @export
unconnected_partition <- function(from, to, weight_data = NULL,
edge_weights = NULL,
slack = 0., max_kl_it_inner = 50L,
max_kl_it = 10000L, trace = 0L,
init = integer()){
dat <- .prep_edge_list(from = from, to = to, weight_data = weight_data,
edge_weights = edge_weights, init = init)
id <- dat$id
out <- with(dat, .unconnected_partition(
from, to, weights_ids, weights, slack = slack, edge_weights = edge_weights,
max_kl_it_inner = max_kl_it_inner, max_kl_it = max_kl_it, trace = trace,
init = init))
# set and sort the removed edges
.sort_partition_result(out, id)
}
#' @rdname unconnected_partition
#' @export
unconnected_partition_pedigree <- function(
id, father.id, mother.id, id_weight = NULL, father_weight = NULL,
mother_weight = NULL, slack = 0., max_kl_it_inner = 50L, max_kl_it = 10000L,
trace = 0L, init = integer()){
dat <- .pedigree_to_from_to(id = id, father.id = father.id,
mother.id = mother.id, id_weight = id_weight,
father_weight = father_weight,
mother_weight = mother_weight, init = init)
with(dat, unconnected_partition(
from = from, to = to, weight_data = weight_data, slack = slack,
max_kl_it_inner = max_kl_it_inner, max_kl_it = max_kl_it, trace = trace,
edge_weights = edge_weights, init = init))
}
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.