55 lines
1.6 KiB
R
55 lines
1.6 KiB
R
#' @export
|
|
ising_m2 <- function(
|
|
params, use_MC = NULL, nr_samples = 10000L,
|
|
warmup = 15L, nr_threads = 1L
|
|
) {
|
|
if (missing(use_MC)) {
|
|
use_MC <- if (is.matrix(params)) 19 < nrow(params) else 190 < length(params)
|
|
}
|
|
|
|
m2 <- .Call("C_ising_m2", params, use_MC, nr_samples, warmup, nr_threads,
|
|
PACKAGE = "tensorPredictors"
|
|
)
|
|
|
|
M2 <- vech.pinv(m2)
|
|
attr(M2, "prob_0") <- attr(m2, "prob_0")
|
|
|
|
M2
|
|
}
|
|
|
|
|
|
# library(tensorPredictors)
|
|
|
|
# dimX <- c(3, 4)
|
|
# dimF <- rep(1L, length(dimX))
|
|
|
|
# betas <- Map(diag, 1, dimX, dimF)
|
|
# Omegas <- list(
|
|
# 1 - diag(dimX[1]),
|
|
# toeplitz(rev(seq(0, len = dimX[2])) / dimX[2])
|
|
# )
|
|
# Omega <- Reduce(kronecker, rev(Omegas))
|
|
|
|
# y <- array(1, dimF)
|
|
# params <- diag(as.vector(mlm(y, betas))) + Omega
|
|
|
|
# # params <- array(0, dim(Omega))
|
|
|
|
# (prob_0 <- attr(ising_m2(params), "prob_0"))
|
|
# (probs <- replicate(20, attr(ising_m2(params, use_MC = TRUE, nr_threads = 8), "prob_0")))[1]
|
|
# m <- mean(probs)
|
|
# s <- sd(probs)
|
|
|
|
# (prob_a <- (function(p, M2) {
|
|
# (1 + p * (p + 1) / 2 + 2 * sum(M2) - 2 * (p + 1) * sum(diag(M2))) / 2^p
|
|
# })(prod(dimX), ising_m2(params, use_MC = FALSE)))
|
|
|
|
# par(mar = c(1, 2, 1, 2) + 0.1)
|
|
# plot(probs, ylim = pmax(0, range(probs, prob_0, prob_a)), pch = 16, cex = 1,
|
|
# xaxt = "n", xlab = "", col = "gray", log = "y", bty = "n")
|
|
# lines(cumsum(probs) / seq_along(probs), lty = 2, lwd = 2)
|
|
# abline(h = c(m - s, m, m + s), lty = c(3, 2, 3), col = "red", lwd = 2)
|
|
# abline(h = c(prob_0, prob_a), lwd = 2)
|
|
# axis(4, at = prob_0, labels = sprintf("%.1e", prob_0))
|
|
# axis(4, at = prob_a, labels = sprintf("%.1e", prob_a))
|