# ilustration of the Ising model sampling routine sym <- function(A) A + t(A) vech <- function(A) A[lower.tri(A, diag = TRUE)] vech.inv <- function(a) { # determin original matrix dimensions `p by p` p <- as.integer((sqrt(8 * length(a) + 1) - 1) / 2) # create matrix of dim `p by p` of the same data type as `a` A <- matrix(do.call(typeof(a), list(1)), p, p) # write elements of `a` into the correct positions of `A` A[lower.tri(A, diag = TRUE)] <- a A[upper.tri(A)] <- t(A)[upper.tri(A)] A } flip <- function(A) A[rev(seq_len(nrow(A))), rev(seq_len(ncol(A)))] # # R calculation of Theta # Theta.R <- local({ # P <- diag(cond_probs) # PtP <- tcrossprod(P, P) # Theta <- log(((1 - PtP) * cond_probs) / (PtP * (1 - cond_probs))) # diag(Theta) <- log(P / (1 - P)) # Theta # }) # # ### MatLab computation of Theta # # q = 7; # # cond_probs = 0.75 .^ (1 + abs((1:q)' - (1:q))); # # % compute natural parameter theta # # P = cond_probs(sub2ind(size(cond_probs), 1:q, 1:q)); # # PtP = P' * P; # # % first: off diagonal elements # # theta = log(((1 - PtP) .* cond_probs) ./ (PtP .* (1 - cond_probs))); # # % second: diagonal elements # # theta(sub2ind(size(theta), 1:q, 1:q)) = log(P ./ (1 - P)); q <- 20 # conditional probabilities cond_probs <- 0.75 ^ (1 + abs(outer(1:q, 1:q, `-`))) cond_probs[tail(1:q, 3), ] <- 0.1 cond_probs[, tail(1:q, 3)] <- 0.1 cond_probs[tail(1:q, 3), tail(1:q, 3)] <- diag(0.4, 3, 3) + 0.1 theta <- ising_theta_from_cond_prob(flip(cond_probs)[lower.tri(cond_probs, diag = TRUE)]) system.time(Y <- ising_sample(10000, theta)) ising_expectation(theta) stopifnot(all.equal(mean.mvbinary(Y), colMeans(as.mvbmatrix(Y)))) ising_cov(theta) stopifnot(all.equal(cov.mvbinary(Y), cov(as.mvbmatrix(Y)))) # covariances cov.true <- ising_cov(theta) cov.est <- cov.mvbinary(Y) # marginal probabilities mar_probs.true <- flip(vech.inv(ising_marginal_probs(theta))) mar_probs.est <- crossprod(as.mvbmatrix(Y)) / length(Y) par(mfrow = c(2, 3), mar = c(3, 2, 4, 1), oma = c(1, 0, 5, 0)) tensorPredictors::matrixImage(cond_probs, main = expression(pi == P[theta(pi)](paste(Y[i] == 1, ", ", Y[j] == 1, " | ", Y[paste(-i, ", ", -j)] == 0))) ) tensorPredictors::matrixImage(cov.true, main = expression(cov[theta(pi)](Y))) tensorPredictors::matrixImage(cov.est, main = expression(hat(cov)(Y)), sub = paste("Est. Error:", round(norm(cov.true - cov.est, "F"), 3))) tensorPredictors::matrixImage(flip(vech.inv(theta)), main = expression({vech^-1}(theta(pi))) ) tensorPredictors::matrixImage(mar_probs.true, main = expression(P[theta(pi)](Y[i] == 1, Y[j] == 1))) tensorPredictors::matrixImage(mar_probs.est, main = expression(hat(P)(Y[i] == 1, Y[j] == 1)), sub = paste("Est. Error:", round(norm(mar_probs.true - mar_probs.est, "F"), 3))) mtext(bquote( paste(Y, " ~ ", Ising[.(q)](theta(pi))) ), side = 3, line = 0, outer = TRUE) mtext(bquote( paste("Sample size ", n == .(length(Y))) ), side = 3, line = -1.5, outer = TRUE)