Nothing
#' Ties function: bivariate
#'
#' This function computes the distinct observations (couples) and their
#' frequencies in a bivariate numeric vector.
#'
#' For internal use.
#'
#' @keywords internal
#' @examples
#'
#' ## The function is currently defined as
#' function(y, z) {
#' if (length(y) != length(z)) {
#' stop("Vectors y and z should have equal length!")
#' }
#' n <- length(y)
#' matY <- outer(y, y, "==")
#' matZ <- outer(z, z, "==")
#' mat <- matY & matZ
#' jstar <- led <- rep(FALSE, n)
#' for (j in seq(n)) {
#' if (!led[j]) {
#' jstar[j] <- TRUE
#' if (j == n) {
#' break
#' }
#' ji <- seq(j + 1, n)
#' tt <- mat[ji, j] %in% TRUE
#' led[ji] <- led[ji] | tt
#' }
#' if (all(led[-seq(j)])) {
#' break
#' }
#' }
#' ystar <- y[jstar]
#' zstar <- z[jstar]
#' nstar <- apply(mat[, jstar], 2, sum)
#' rstar <- length(nstar)
#' idx <- match(y, ystar)
#' return(list(
#' ystar = ystar, zstar = zstar, nstar = nstar,
#' rstar = rstar, idx = idx
#' ))
#' }
comp2 <-
function(y, z) {
if (length(y) != length(z)) {
stop("Vectors y and z should have equal length!")
}
n <- length(y)
matY <- outer(y, y, "==")
matZ <- outer(z, z, "==")
mat <- matY & matZ
jstar <- led <- rep(FALSE, n)
for (j in seq(n)) {
if (!led[j]) {
jstar[j] <- TRUE
if (j == n) {
break
}
ji <- seq(j + 1, n)
tt <- mat[ji, j] %in% TRUE
led[ji] <- led[ji] | tt
}
if (all(led[-seq(j)])) {
break
}
}
ystar <- y[jstar]
zstar <- z[jstar]
nstar <- apply(as.matrix(mat[, jstar]), 2, sum)
rstar <- length(nstar)
idx <- match(y, ystar)
return(list(
ystar = ystar, zstar = zstar, nstar = nstar,
rstar = rstar, idx = idx
))
}
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.