
R version 4.3.1 (2023-06-16) -- "Beagle Scouts"
Copyright (C) 2023 The R Foundation for Statistical Computing
Platform: x86_64-pc-linux-gnu (64-bit)

R is free software and comes with ABSOLUTELY NO WARRANTY.
You are welcome to redistribute it under certain conditions.
Type 'license()' or 'licence()' for distribution details.

R is a collaborative project with many contributors.
Type 'contributors()' for more information and
'citation()' on how to cite R or R packages in publications.

Type 'demo()' for some demos, 'help()' for on-line help, or
'help.start()' for an HTML browser interface to help.
Type 'q()' to quit R.

> 
>  # test outfun (function)
> 
>  epsilon <- 1e-15
> 
>  library(mcmc)
> 
>  suppressWarnings(RNGkind("Marsaglia-Multicarry"))
>  set.seed(42)
> 
>  n <- 100
>  rho <- 0.5
>  beta0 <- 0.25
>  beta1 <- 1
>  beta2 <- 0.5
> 
>  x1 <- rnorm(n)
>  x2 <- rho * x1 + sqrt(1 - rho^2) * rnorm(n)
>  eta <- beta0 + beta1 * x1 + beta2 * x2
>  p <- 1 / (1 + exp(- eta))
>  y <- as.numeric(runif(n) < p)
> 
>  out <- glm(y ~ x1 + x2, family = binomial())
> 
>  logl <- function(beta) {
+      if (length(beta) != 3) stop("length(beta) != 3")
+      beta0 <- beta[1]
+      beta1 <- beta[2]
+      beta2 <- beta[3]
+      eta <- beta0 + beta1 * x1 + beta2 * x2
+      p <- exp(eta) / (1 + exp(eta))
+      return(sum(log(p[y == 1])) + sum(log(1 - p[y == 0])))
+  }
> 
>  out.metro <- metrop(logl, coefficients(out), 1e3, scale = 0.01)
>  out.metro$accept
[1] 0.982
> 
>  out.metro <- metrop(out.metro, scale = 0.1)
>  out.metro$accept
[1] 0.795
> 
>  out.metro <- metrop(out.metro, scale = 0.5)
>  out.metro$accept
[1] 0.264
> 
>  apply(out.metro$batch, 2, mean)
[1] 0.06080257 1.42304941 0.52634149
> 
>  out.metro <- metrop(logl, as.numeric(coefficients(out)), 1e2,
+      scale = 0.5, debug = TRUE, outfun = function(x) c(x, x^2))
> 
>  out.metro <- metrop(out.metro)
>  out.metro$outfun
function (x) 
c(x, x^2)
<bytecode: 0x55a0dee70e70>
>  dim(out.metro$batch)
[1] 100   6
> 
>  logl <- function(beta, x1, x2, y) {
+      if (length(beta) != 3) stop("length(beta) != 3")
+      beta0 <- beta[1]
+      beta1 <- beta[2]
+      beta2 <- beta[3]
+      eta <- beta0 + beta1 * x1 + beta2 * x2
+      p <- exp(eta) / (1 + exp(eta))
+      return(sum(log(p[y == 1])) + sum(log(1 - p[y == 0])))
+  }
> 
>  out.metro <- metrop(logl, as.numeric(coefficients(out)), 1e2,
+      scale = 0.5, debug = TRUE, x1 = x1, x2 = x2, y = y)
>  out.metro$lud
function (beta, x1, x2, y) 
{
    if (length(beta) != 3) 
        stop("length(beta) != 3")
    beta0 <- beta[1]
    beta1 <- beta[2]
    beta2 <- beta[3]
    eta <- beta0 + beta1 * x1 + beta2 * x2
    p <- exp(eta)/(1 + exp(eta))
    return(sum(log(p[y == 1])) + sum(log(1 - p[y == 0])))
}
>  out.metro <- metrop(out.metro, x1 = x1, x2 = x2, y = y)
>  out.metro$lud
function (beta, x1, x2, y) 
{
    if (length(beta) != 3) 
        stop("length(beta) != 3")
    beta0 <- beta[1]
    beta1 <- beta[2]
    beta2 <- beta[3]
    eta <- beta0 + beta1 * x1 + beta2 * x2
    p <- exp(eta)/(1 + exp(eta))
    return(sum(log(p[y == 1])) + sum(log(1 - p[y == 0])))
}
> 
> 
> proc.time()
   user  system elapsed 
  0.347   0.028   0.367 
