Running 'cll.R' [4s]
  Comparing 'cll.Rout' to 'cll.Rout.save' ... OK
  Running 'debug-cond.R' [156s]
  Running 'debug-free.R' [1s]
  Comparing 'debug-free.Rout' to 'debug-free.Rout.save' ... OK
  Running 'debug.R' [179s]
  Running 'outfun.R' [167s]
  Running 'pack.R' [0s]
  Comparing 'pack.Rout' to 'pack.Rout.save' ... OK
  Running 'potts.R' [2s]
  Comparing 'potts.Rout' to 'potts.Rout.save' ... OK
Running the tests in 'tests/debug-cond.R' failed.
Complete output:
  > 
  >  library(potts)
  >  library(pooh)
  > 
  >  set.seed(42)
  > 
  >  ncolor <- as.integer(4)
  >  alpha <- rnorm(ncolor) * 0.01
  >  beta <- log(1 + sqrt(ncolor))
  >  theta <- c(alpha, beta)
  > 
  >  nrow <- 25
  >  ncol <- 20
  >  x <- matrix(1, nrow = nrow, ncol = ncol)
  >  foo <- packPotts(x, ncolor)
  > 
  >  out <- potts(foo, theta, nbatch = 5, blen = 3, nspac = 2, debug = TRUE,
  +      boundary = "condition")
  >  names(out)
   [1] "initial.seed" "final.seed"   "initial"      "final"        "param"       
   [6] "nbatch"       "blen"         "nspac"        "boundary"     "batch"       
  [11] "time"         "debug"        "pstate"       "hstate"       "vstate"      
  [16] "patch"        "hunif"        "vunif"        "punif"       
  > 
  >  identical(out$initial, foo)
  [1] TRUE
  > 
  >  before <- out$pstate
  >  dim(before)
  [1] 30 25 20
  > 
  >  niter <- dim(before)[1]
  >  niter == out$nbatch * out$blen * out$nspac
  [1] TRUE
  > 
  >  after <- before
  >  after[- niter, , ] <- before[- 1, ,]
  >  after[niter, , ] <- unpackPotts(out$final)
  > 
  >  sort(unique(as.vector(before)))
  [1] 1 2 3 4
  >  sort(unique(as.vector(after)))
  [1] 1 2 3 4
  >  all.equal(x, before[1, , ])
  [1] TRUE
  > 
  >  ##### check conditioning #####
  > 
  >  before.foo <- before
  >  before.foo[ , seq(2, nrow - 1), seq(2, ncol - 1)] <- 0
  >  after.foo <- after
  >  after.foo[ , seq(2, nrow - 1), seq(2, ncol - 1)] <- 0
  >  identical(apply(before.foo, c(2, 3), max), before.foo[1, , ])
  [1] TRUE
  >  identical(apply(before.foo, c(2, 3), min), before.foo[1, , ])
  [1] TRUE
  >  identical(apply(after.foo, c(2, 3), max), before.foo[1, , ])
  [1] TRUE
  >  identical(apply(after.foo, c(2, 3), min), before.foo[1, , ])
  [1] TRUE
  > 
  >  ##### calculate canonical statistics #####
  > 
  >  ttt <- matrix(NA, niter, ncolor + 1)
  >  for (icolor in 1:ncolor)
  +      ttt[ , icolor] <- apply(after - after.foo == icolor, 1, sum)
  > 
  >  colin <- seq(2, ncol - 1)
  >  rowin <- seq(2, nrow - 1)
  > 
  >  tstar <- rep(0, niter)
  >  for (i in 2:nrow)
  +      tstar <- tstar +
  +          apply(after[ , i, colin] == after[ , i - 1, colin], 1, sum)
  >  for (i in 2:ncol)
  +      tstar <- tstar +
  +          apply(after[ , rowin, i] == after[ , rowin, i - 1], 1, sum)
  >  ttt[ , ncolor + 1] <- tstar
  > 
  >  ##### check batch means #####
  > 
  >  foo <- ttt[seq(1, niter) %% out$nspac == 0, ]
  >  foo <- array(as.vector(foo), c(out$blen, out$nbatch, ncolor + 1))
  >  foo <- apply(foo, c(2, 3), mean)
  >  identical(foo, out$batch)
  [1] TRUE
  > 
  >  ##### check bonds #####
  > 
  >  bprob <- (- expm1(- beta))
  >  all.equal(bprob, 1 - exp(- beta))
  [1] TRUE
  > 
  >  my.hstate.possible <- array(FALSE, c(niter, nrow, ncol))
  >  for (i in seq(1, nrow - 1))
  +      my.hstate.possible[ , i, colin] <-
  +          before[ , i, colin] == before[ , i + 1, colin]
  >  storage.mode(my.hstate.possible) <- "integer"
  >  identical(my.hstate.possible == 1, out$hunif != -1)
  [1] TRUE
  >  my.hstate <- out$hunif < bprob
  >  storage.mode(my.hstate) <- "integer"
  >  my.hstate <- my.hstate * my.hstate.possible
  >  identical(my.hstate, out$hstate)
  [1] TRUE
  > 
  >  my.vstate.possible <- array(FALSE, c(niter, nrow, ncol))
  >  for (i in seq(1, ncol - 1))
  +      my.vstate.possible[ , rowin, i] <-
  +          before[ , rowin, i] == before[ , rowin, i + 1]
  >  storage.mode(my.vstate.possible) <- "integer"
  >  identical(my.vstate.possible == 1, out$vunif != -1)
  [1] TRUE
  >  my.vstate <- out$vunif < bprob
  >  storage.mode(my.vstate) <- "integer"
  >  my.vstate <- my.vstate * my.vstate.possible
  >  identical(my.vstate, out$vstate)
  [1] TRUE
  > 
  >  ##### check patches #####
  >  
  >  my.row <- row(my.hstate[1, , ])
  >  my.col <- col(my.hstate[1, , ])
  >  my.other.row <- my.row + 1
  >  my.other.row[my.other.row > nrow] <- 1
  >  my.other.col <- my.col + 1
  >  my.other.col[my.other.col > ncol] <- 1
  > 
  >  vertices <- paste(my.row, my.col, sep = ":")
  > 
  >  patch.equals <- NULL
  > 
  >  for (iiter in 1:niter) {
  + 
  +      isbond <- my.hstate[iiter, , ] == 1
  +      my.row.bond <- as.vector(my.row[isbond])
  +      my.col.bond <- as.vector(my.col[isbond])
  +      my.other.row.bond <- as.vector(my.other.row[isbond])
  +      my.from.h <- paste(my.row.bond, my.col.bond, sep = ":")
  +      my.to.h <- paste(my.other.row.bond, my.col.bond, sep = ":")
  + 
  +      isbond <- my.vstate[iiter, , ] == 1
  +      my.row.bond <- as.vector(my.row[isbond])
  +      my.col.bond <- as.vector(my.col[isbond])
  +      my.other.col.bond <- as.vector(my.other.col[isbond])
  +      my.from.v <- paste(my.row.bond, my.col.bond, sep = ":")
  +      my.to.v <- paste(my.row.bond, my.other.col.bond, sep = ":")
  + 
  +      wout <- weak(from = c(my.from.h, my.from.v), to = c(my.to.h, my.to.v),
  +          domain = vertices, markers = TRUE)
  +      blab <- as.vector(out$patch[iiter, , ])
  +      widx <- sort(unique(wout))
  +      bidx <- blab[match(widx, wout)]
  + 
  +      patch.equals <- c(patch.equals, identical(bidx[wout], blab))
  +  }
  > 
  >  all(patch.equals)
  [1] TRUE
  > 
  >  ##### check colors #####
  > 
  >  unif.equals <- NULL
  >  my.after <- after
  > 
  >  for (iiter in 1:niter) {
  +      fred <- out$patch[iiter, , ]
  +      blab <- as.vector(fred)
  +      blab.count <- tabulate(blab, nbins = nrow * ncol)
  +      blab.fixed <- c(fred[c(1, nrow), ], fred[ , c(1, ncol)])
  +      blab.fixed <- sort(unique(blab.fixed))
  +      punif <- out$punif[iiter, ]
  +      unif.equals <- c(unif.equals, identical(punif != -1, blab.count != 0))
  +      alpha.prod <- outer(blab.count, alpha)
  +      p.prod <- exp(alpha.prod)
  +      p.sum <- apply(p.prod, 1, sum)
  +      p <- sweep(p.prod, 1, p.sum, "/")
  +      p.cum <- apply(p, 1, cumsum)
  +      p.cum <- t(p.cum)
  +      p.foo <- sweep(p.cum, 1, out$punif[iiter, ])
  +      newcolor <- apply(p.foo < 0, 1, sum) + 1
  +      newcolor[blab.count == 0] <- NA
  +      is.fixed <- blab %in% blab.fixed
  +      color.old <- as.vector(before[iiter, , ])
  +      color.new <- newcolor[blab]
  +      color.new[is.fixed] <- color.old[is.fixed]
  +      my.after[iiter, , ] <- matrix(color.new, nrow, ncol)
  +  }
  > 
  >  all(unif.equals)
  [1] TRUE
  >  all.equal(after, my.after)
  [1] TRUE
  > 
  >  ##### check uniform random numbers #####
  > 
  >  u <- c(as.vector(out$hunif), as.vector(out$vunif), as.vector(out$punif))
  >  u <- u[u != -1]
  >  ks.test(x = u, y = "punif")
  
  	Asymptotic one-sample Kolmogorov-Smirnov test
  
  data:  u
  D = 0.0078639, p-value = 0.08553
  alternative hypothesis: two-sided
  
  > 
  >  ##### check alpha = 0 #####
  >  
  >  alpha <- rep(0, ncolor)
  >  theta <- c(alpha, beta)
  > 
  >  out.too <- potts(out, param = theta, debug = FALSE)
  > 
  >  alpha <- rep(0.1, ncolor)
  >  theta <- c(alpha, beta)
  > 
  >  out.too.too <- potts(out, param = theta, debug = FALSE)
  > 
  >  all.equal(out.too$batch, out.too.too$batch)
  [1] TRUE
  > 
  > 
  > proc.time()
     user  system elapsed 
     0.46    0.14    0.62 
Running the tests in 'tests/debug.R' failed.
Complete output:
  > 
  >  library(potts)
  >  library(pooh)
  > 
  >  set.seed(42)
  > 
  >  ncolor <- as.integer(4)
  >  alpha <- rnorm(ncolor) * 0.01
  >  beta <- log(1 + sqrt(ncolor))
  >  theta <- c(alpha, beta)
  > 
  >  nrow <- 25
  >  ncol <- 20
  >  x <- matrix(1, nrow = nrow, ncol = ncol)
  >  foo <- packPotts(x, ncolor)
  > 
  >  out <- potts(foo, theta, nbatch = 5, blen = 3, nspac = 2, debug = TRUE)
  >  names(out)
   [1] "initial.seed" "final.seed"   "initial"      "final"        "param"       
   [6] "nbatch"       "blen"         "nspac"        "boundary"     "batch"       
  [11] "time"         "debug"        "pstate"       "hstate"       "vstate"      
  [16] "patch"        "hunif"        "vunif"        "punif"       
  > 
  >  identical(out$initial, foo)
  [1] TRUE
  > 
  >  before <- out$pstate
  >  dim(before)
  [1] 30 25 20
  > 
  >  niter <- dim(before)[1]
  >  niter == out$nbatch * out$blen * out$nspac
  [1] TRUE
  > 
  >  after <- before
  >  after[- niter, , ] <- before[- 1, ,]
  >  after[niter, , ] <- unpackPotts(out$final)
  > 
  >  sort(unique(as.vector(before)))
  [1] 1 2 3 4
  >  sort(unique(as.vector(after)))
  [1] 1 2 3 4
  >  all.equal(x, before[1, , ])
  [1] TRUE
  > 
  >  ##### calculate canonical statistics #####
  > 
  >  ttt <- matrix(NA, niter, ncolor + 1)
  >  for (icolor in 1:ncolor)
  +      ttt[ , icolor] <- apply(after == icolor, 1, sum)
  > 
  >  tstar <- rep(0, niter)
  >  tstar <- tstar + apply(after[ , 1, ] == after[ , nrow, ], 1, sum)
  >  for (i in 2:nrow)
  +      tstar <- tstar + apply(after[ , i, ] == after[ , i - 1, ], 1, sum)
  >  tstar <- tstar + apply(after[ , , 1] == after[ , , ncol], 1, sum)
  >  for (i in 2:ncol)
  +      tstar <- tstar + apply(after[ , , i] == after[ , , i - 1], 1, sum)
  >  ttt[ , ncolor + 1] <- tstar
  > 
  >  ##### check batch means #####
  > 
  >  foo <- ttt[seq(1, niter) %% out$nspac == 0, ]
  >  foo <- array(as.vector(foo), c(out$blen, out$nbatch, ncolor + 1))
  >  foo <- apply(foo, c(2, 3), mean)
  >  identical(foo, out$batch)
  [1] TRUE
  > 
  >  ##### check bonds #####
  > 
  >  bprob <- (- expm1(- beta))
  >  all.equal(bprob, 1 - exp(- beta))
  [1] TRUE
  > 
  >  my.hstate.possible <- array(FALSE, c(niter, nrow, ncol))
  >  for (i in 1:nrow) {
  +      ip1 <- ifelse(i < nrow, i + 1, 1)
  +      my.hstate.possible[ , i, ] <- before[ , i, ] == before[ , ip1, ]
  +  }
  >  storage.mode(my.hstate.possible) <- "integer"
  >  identical(my.hstate.possible == 1, out$hunif != -1)
  [1] TRUE
  >  my.hstate <- out$hunif < bprob
  >  storage.mode(my.hstate) <- "integer"
  >  my.hstate <- my.hstate * my.hstate.possible
  >  identical(my.hstate, out$hstate)
  [1] TRUE
  > 
  >  my.vstate.possible <- array(FALSE, c(niter, nrow, ncol))
  >  for (i in 1:ncol) {
  +      ip1 <- ifelse(i < ncol, i + 1, 1)
  +      my.vstate.possible[ , , i] <- before[ , , i] == before[ , , ip1]
  +  }
  >  storage.mode(my.vstate.possible) <- "integer"
  >  identical(my.vstate.possible == 1, out$vunif != -1)
  [1] TRUE
  >  my.vstate <- out$vunif < bprob
  >  storage.mode(my.vstate) <- "integer"
  >  my.vstate <- my.vstate * my.vstate.possible
  >  identical(my.vstate, out$vstate)
  [1] TRUE
  > 
  >  ##### check patches #####
  >  
  >  my.row <- row(my.hstate[1, , ])
  >  my.col <- col(my.hstate[1, , ])
  >  my.other.row <- my.row + 1
  >  my.other.row[my.other.row > nrow] <- 1
  >  my.other.col <- my.col + 1
  >  my.other.col[my.other.col > ncol] <- 1
  > 
  >  vertices <- paste(my.row, my.col, sep = ":")
  > 
  >  patch.equals <- NULL
  > 
  >  for (iiter in 1:niter) {
  + 
  +      isbond <- my.hstate[iiter, , ] == 1
  +      my.row.bond <- as.vector(my.row[isbond])
  +      my.col.bond <- as.vector(my.col[isbond])
  +      my.other.row.bond <- as.vector(my.other.row[isbond])
  +      my.from.h <- paste(my.row.bond, my.col.bond, sep = ":")
  +      my.to.h <- paste(my.other.row.bond, my.col.bond, sep = ":")
  + 
  +      isbond <- my.vstate[iiter, , ] == 1
  +      my.row.bond <- as.vector(my.row[isbond])
  +      my.col.bond <- as.vector(my.col[isbond])
  +      my.other.col.bond <- as.vector(my.other.col[isbond])
  +      my.from.v <- paste(my.row.bond, my.col.bond, sep = ":")
  +      my.to.v <- paste(my.row.bond, my.other.col.bond, sep = ":")
  + 
  +      wout <- weak(from = c(my.from.h, my.from.v), to = c(my.to.h, my.to.v),
  +          domain = vertices, markers = TRUE)
  +      blab <- as.vector(out$patch[iiter, , ])
  +      widx <- sort(unique(wout))
  +      bidx <- blab[match(widx, wout)]
  + 
  +      patch.equals <- c(patch.equals, identical(bidx[wout], blab))
  +  }
  > 
  >  all(patch.equals)
  [1] TRUE
  > 
  >  ##### check colors #####
  > 
  >  unif.equals <- NULL
  >  my.after <- after
  > 
  >  for (iiter in 1:niter) {
  +      blab <- as.vector(out$patch[iiter, , ])
  +      blab.count <- tabulate(blab, nbins = nrow * ncol)
  +      punif <- out$punif[iiter, ]
  +      unif.equals <- c(unif.equals, identical(punif != -1, blab.count != 0))
  +      alpha.prod <- outer(blab.count, alpha)
  +      p.prod <- exp(alpha.prod)
  +      p.sum <- apply(p.prod, 1, sum)
  +      p <- sweep(p.prod, 1, p.sum, "/")
  +      p.cum <- apply(p, 1, cumsum)
  +      p.cum <- t(p.cum)
  +      p.foo <- sweep(p.cum, 1, out$punif[iiter, ])
  +      newcolor <- apply(p.foo < 0, 1, sum) + 1
  +      newcolor[blab.count == 0] <- NA
  +      blab.new <- newcolor[blab]
  +      my.after[iiter, , ] <- matrix(blab.new, nrow, ncol)
  +  }
  > 
  >  all(unif.equals)
  [1] TRUE
  >  all.equal(after, my.after)
  [1] TRUE
  > 
  >  ##### check uniform random numbers #####
  > 
  >  u <- c(as.vector(out$hunif), as.vector(out$vunif), as.vector(out$punif))
  >  u <- u[u != -1]
  >  ks.test(x = u, y = "punif")
  
  	Asymptotic one-sample Kolmogorov-Smirnov test
  
  data:  u
  D = 0.007499, p-value = 0.08961
  alternative hypothesis: two-sided
  
  > 
  >  ##### check alpha = 0 #####
  >  
  >  alpha <- rep(0, ncolor)
  >  theta <- c(alpha, beta)
  > 
  >  out.too <- potts(out, param = theta, debug = FALSE)
  > 
  >  alpha <- rep(0.1, ncolor)
  >  theta <- c(alpha, beta)
  > 
  >  out.too.too <- potts(out, param = theta, debug = FALSE)
  > 
  >  all.equal(out.too$batch, out.too.too$batch)
  [1] TRUE
  > 
  > 
  > proc.time()
     user  system elapsed 
     0.56    0.14    0.67 
Running the tests in 'tests/outfun.R' failed.
Complete output:
  > 
  >  library(potts)
  > 
  >  set.seed(42)
  > 
  >  ncolor <- as.integer(4)
  >  alpha <- rnorm(ncolor) * 0.01
  >  beta <- log(1 + sqrt(ncolor))
  >  theta <- c(alpha, beta)
  > 
  >  nrow <- 25
  >  ncol <- 20
  >  x <- matrix(1, nrow = nrow, ncol = ncol)
  >  foo <- packPotts(x, ncolor)
  > 
  >  outfun <- function(tt) {
  +      qux <- outer(tt, tt)
  +      c(tt, qux[lower.tri(qux, diag = TRUE)])
  +  }
  > 
  >  outfun(c(485, 2, 9, 4, 954))
   [1]    485      2      9      4    954 235225    970   4365   1940 462690
  [11]      4     18      8   1908     81     36   8586     16   3816 910116
  > 
  >  out <- potts(foo, theta, nbatch = 5, blen = 3, nspac = 2, debug = TRUE,
  +      outfun = outfun)
  >  names(out)
   [1] "initial.seed" "final.seed"   "initial"      "final"        "param"       
   [6] "nbatch"       "blen"         "nspac"        "boundary"     "batch"       
  [11] "time"         "debug"        "pstate"       "hstate"       "vstate"      
  [16] "patch"        "hunif"        "vunif"        "punif"       
  > 
  >  niter <- out$nbatch * out$blen * out$nspac
  > 
  >  .Random.seed <- out$initial.seed
  >  out.too <- potts(foo, theta, nbatch = niter)
  > 
  >  tt <- out.too$batch
  >  ttaug <- t(apply(tt, 1, outfun))
  >  identical(tt, ttaug[ , 1:ncol(tt)])
  [1] TRUE
  >  nout <- ncol(ttaug)
  >  ncol(out$batch) == nout
  [1] TRUE
  > 
  >  ##### check batch means #####
  > 
  >  foo <- ttaug[seq(1, niter) %% out$nspac == 0, ]
  >  foo <- array(as.vector(foo), c(out$blen, out$nbatch, nout))
  >  foo <- apply(foo, c(2, 3), mean)
  >  identical(foo, out$batch)
  [1] TRUE
  > 
  > 
  > proc.time()
     user  system elapsed 
     0.26    0.07    0.31