IntroductionHopfieldNetworks.R
In hann: Hopfield Artificial Neural Networks

### R code from vignette source 'IntroductionHopfieldNetworks.Rnw'

###################################################
### code chunk number 1: IntroductionHopfieldNetworks.Rnw:15-16
###################################################
options(width = 80, prompt = "> ")


###################################################
### code chunk number 2: IntroductionHopfieldNetworks.Rnw:30-32
###################################################
N <- c(30, 60, 100)
2^N


###################################################
### code chunk number 3: IntroductionHopfieldNetworks.Rnw:41-57
###################################################
## double factorial (n!!) that we want vectorized to use with
## outer() below
dfact <- function(n) {
    ## seq() is not vectorized on its 2nd arg.
    x <- mapply(seq, from = 1, to = n, by = 2)
    sapply(x, prod)
}

## eq. 6 in Krotov & Hopfield (2016)
funM <- function(N, n)
    N^(n - 1) / (2 * dfact(2 * n - 3) * log(N))

n <- c(2, 10, 20, 30)
o <- outer(N, n, funM)
dimnames(o) <- list(paste("N =", N), paste("n =", n))
o


###################################################
### code chunk number 4: IntroductionHopfieldNetworks.Rnw:63-78
###################################################
N <- 60L
K <- 2000L

xi <- matrix(1L, K, N)

p <- 0.15 # not smaller than 0.15
probs <- c(p, 1 - p)
v <- c(-1L, 1L)

set.seed(1)
xi1 <- t(replicate(1000, sample(v, N, TRUE, probs)))
xi2 <- t(replicate(1000, sample(v, N, TRUE, rev(probs))))
xi <- rbind(xi1, xi2)

stopifnot(nrow(unique(xi)) == K)


###################################################
### code chunk number 5: IntroductionHopfieldNetworks.Rnw:85-87
###################################################
library(hann)
sigma20 <- buildSigma(xi, nrep = 10)


###################################################
### code chunk number 6: IntroductionHopfieldNetworks.Rnw:90-91
###################################################
sigma30 <- buildSigma(xi, n = 30, nrep = 10)


###################################################
### code chunk number 7: IntroductionHopfieldNetworks.Rnw:101-102
###################################################
cl <- rep(1:2, each = 1000)


###################################################
### code chunk number 8: IntroductionHopfieldNetworks.Rnw:108-111
###################################################
ctr <- control.hann()
ctr$trace.error <- TRUE
nt1 <- hann1(xi, sigma20, cl, control = ctr)


###################################################
### code chunk number 9: IntroductionHopfieldNetworks.Rnw:115-117
###################################################
ctr$target <- 0.1
nt3 <- hann3(xi, sigma20, cl, control = ctr)


###################################################
### code chunk number 10: IntroductionHopfieldNetworks.Rnw:124-126
###################################################
table(predict(nt1, xi, rawsignal = FALSE), cl)
table(predict(nt3, xi, rawsignal = FALSE), cl)


###################################################
### code chunk number 11: IntroductionHopfieldNetworks.Rnw:130-136
###################################################
ctr$iterlim <- 0
nt0 <- hann1(xi, sigma20, cl, control = ctr)
table(predict(nt0, xi, rawsignal = FALSE), cl)

nt0b <- hann3(xi, sigma20, cl, control = ctr)
table(predict(nt0b, xi, rawsignal = FALSE), cl)


###################################################
### code chunk number 12: IntroductionHopfieldNetworks.Rnw:153-156
###################################################
N <- 30
K <- 200
xi <- matrix(sample(v, K * N, TRUE), K, N)


###################################################
### code chunk number 13: IntroductionHopfieldNetworks.Rnw:160-165
###################################################
sigma <- buildSigma(xi, quiet = TRUE)
cl <- rep(1:2, each = 100)
ctr <- control.hann(iterlim = 1000, quiet = TRUE)
net1 <- hann1(xi, sigma, cl, control = ctr)
net3 <- hann3(xi, sigma, cl, control = ctr)


###################################################
### code chunk number 14: IntroductionHopfieldNetworks.Rnw:169-171
###################################################
table(predict(net1, xi, rawsignal = FALSE), cl)
table(predict(net3, xi, rawsignal = FALSE), cl)