163 lines
4.7 KiB
R
163 lines
4.7 KiB
R
# Generated by using Rcpp::compileAttributes() -> do not edit by hand
|
|
# Generator token: 10BE3573-1514-4C36-9D1C-5A225CD40393
|
|
|
|
ising_log_odds_sum <- function(y, theta) {
|
|
.Call(`_mvbernoulli_ising_log_odds_sum`, y, theta)
|
|
}
|
|
|
|
#' Ising model scaling factor `p_0(theta)` for the Ising model
|
|
#'
|
|
ising_prob0 <- function(theta) {
|
|
.Call(`_mvbernoulli_ising_prob0`, theta)
|
|
}
|
|
|
|
#' Ising model probabilities for every event, this returns a vector of size `2^p`
|
|
#' with indices corresponding to the events binary representation.
|
|
#'
|
|
#' Note: the R indexing leads to adding +1 to every index.
|
|
#'
|
|
ising_probs <- function(theta) {
|
|
.Call(`_mvbernoulli_ising_probs`, theta)
|
|
}
|
|
|
|
#' Computes the zero conditioned probabilities
|
|
#' P(Y_i = 1 | Y_-i = 0)
|
|
#' and
|
|
#' P(Y_i = 1, Y_j = 1 | Y_-i = 0)
|
|
#' from the natural parameters `theta` with matching indexing.
|
|
#'
|
|
#' This is the inverse function of `ising_theta_from_cond_prob`
|
|
#'
|
|
ising_cond_probs <- function(theta) {
|
|
.Call(`_mvbernoulli_ising_cond_probs`, theta)
|
|
}
|
|
|
|
#' Computes the expectation of `Y` under the Ising model with natural parameter
|
|
#' `theta` given component wise by
|
|
#'
|
|
#' E Y_i = P(Y_i = 1)
|
|
#'
|
|
ising_expectation <- function(theta) {
|
|
.Call(`_mvbernoulli_ising_expectation`, theta)
|
|
}
|
|
|
|
#' Computes the covariance (second centered moment) of `Y` under the Ising model
|
|
#' with natural parameter `theta`.
|
|
#'
|
|
#' cov(Y, Y) = E[Y Y'] - E[Y] E[Y]'
|
|
#'
|
|
ising_cov <- function(theta) {
|
|
.Call(`_mvbernoulli_ising_cov`, theta)
|
|
}
|
|
|
|
#' Computes the single and two way effect marginal probabilities
|
|
#'
|
|
#' P(Y_i = 1)
|
|
#' and
|
|
#' P(Y_i Y_j = 1)
|
|
#'
|
|
#' In its vectorized form this function computes E[vech(Y Y')]
|
|
#'
|
|
ising_marginal_probs <- function(theta) {
|
|
.Call(`_mvbernoulli_ising_marginal_probs`, theta)
|
|
}
|
|
|
|
#' Natural parameters from the sufficient conditional probability statistis `pi`
|
|
#'
|
|
#' Computes the natural parameters `theta` of the Ising model from zero
|
|
#' conditioned probabilites for single and two way effects.
|
|
#'
|
|
#' This is the inverse function of `ising_cond_prob_from_theta`
|
|
#'
|
|
ising_theta_from_cond_prob <- function(pi) {
|
|
.Call(`_mvbernoulli_ising_theta_from_cond_prob`, pi)
|
|
}
|
|
|
|
#' Computes the log-lokelihood at natural parameters `theta` of the Ising model
|
|
#' given a set of observations `Y`
|
|
#'
|
|
#' l(theta) = log(p_0(theta)) + n^-1 sum_i vech(y_i y_i')' theta
|
|
#'
|
|
ising_log_likelihood <- function(theta, Y) {
|
|
.Call(`_mvbernoulli_ising_log_likelihood`, theta, Y)
|
|
}
|
|
|
|
#' Computes the Score of the Ising model, this is the gradiend of the (mean)
|
|
#' log-likelihood with respect to the natural parameters
|
|
#'
|
|
#' grad l(theta) = -E[vech(Y Y')] + n^-1 sum_i vech(y_i y_i')
|
|
#'
|
|
ising_score <- function(theta, Y) {
|
|
.Call(`_mvbernoulli_ising_score`, theta, Y)
|
|
}
|
|
|
|
ising_conditional_log_likelihood <- function(alpha, X, Y) {
|
|
.Call(`_mvbernoulli_ising_conditional_log_likelihood`, alpha, X, Y)
|
|
}
|
|
|
|
ising_conditional_score <- function(alpha, X, Y) {
|
|
.Call(`_mvbernoulli_ising_conditional_score`, alpha, X, Y)
|
|
}
|
|
|
|
#' Fisher information for the natural parameters `theta` under the Ising model.
|
|
#'
|
|
#' I(theta) = -E(H l(theta) | theta) = Cov(vech(Y Y'), vech(Y Y') | theta)
|
|
#'
|
|
#' where `H l(theta)` is the Hessian of the log-likelihood `l(theta)` defined as
|
|
#'
|
|
#' l(theta) = n^-1 prod_i P(Y = y_i | theta)
|
|
#' = log(p_0(theta)) - mean_i exp(vech(y_i y_i')' theta)
|
|
#'
|
|
#' Note that the Fisher information does _not_ depend on data.
|
|
#'
|
|
ising_fisher_info <- function(theta) {
|
|
.Call(`_mvbernoulli_ising_fisher_info`, theta)
|
|
}
|
|
|
|
#' Samples from the Ising model given the natural parameters `theta`
|
|
#'
|
|
ising_sample <- function(n, theta, warmup = 1000L) {
|
|
.Call(`_mvbernoulli_ising_sample`, n, theta, warmup)
|
|
}
|
|
|
|
print.mvbinary <- function(binary, nrLines = 10L) {
|
|
invisible(.Call(`_mvbernoulli_print_mvbinary`, binary, nrLines))
|
|
}
|
|
|
|
printBits <- function(ints) {
|
|
invisible(.Call(`_mvbernoulli_printBits`, ints))
|
|
}
|
|
|
|
#' Converts a logical matrix to a multi variate bernoulli dataset
|
|
#'
|
|
as.mvbinary <- function(Y) {
|
|
.Call(`_mvbernoulli_as_mvbinary`, Y)
|
|
}
|
|
|
|
#' Converts a Multivariate binary data set into a logical matrix
|
|
#'
|
|
as.mvbmatrix <- function(Y) {
|
|
.Call(`_mvbernoulli_as_mvbmatrix`, Y)
|
|
}
|
|
|
|
#' Mean for a multi variate bernoulli dataset `MVBinary`
|
|
#'
|
|
#' mean_i y_i # twoway = false (only single effects)
|
|
#'
|
|
#' or
|
|
#'
|
|
#' mean_i vech(y_i y_i') # twoway = true (with two-way interactions)
|
|
#'
|
|
mean.mvbinary <- function(Y, twoway = FALSE) {
|
|
.Call(`_mvbernoulli_mean_mvbinary`, Y, twoway)
|
|
}
|
|
|
|
#' Covariance for multi variate binary data `MVBinary`
|
|
#'
|
|
#' cov(Y) = (n - 1)^-1 sum_i (y_i - mean(Y)) (y_i - mean(Y))'
|
|
#'
|
|
cov.mvbinary <- function(Y) {
|
|
.Call(`_mvbernoulli_cov_mvbinary`, Y)
|
|
}
|
|
|