Simple Neural Network Classifiers

Artificial Neural Networks have been used by researchers since at least the 1950s, and rose in prominence when computing resources became widely available. There have been at least 3-4 eras of ANN, with each success and exuberance followed by a quiescence and failure or replacement by other tools. There has always been an intetrplay in this area between computational neuroscientists, computational vision, machine learning, psychology, computer science, and statisticians, with many advances coming by modeling human processes and then applying these algorithms to real-life problems.

• In the 1950s, notions of the ANN were introduced (Perceptron, McCollough & Pitts)
• In the 1960s, inadequacy of these methods were found (XOR problems), and
• In the 1970s and 1980s, back-propagation provided a reasonable learning approach for multi-layer neural networks for supervised classification problems (Rumelhart & McClelland).
• In the 1970s-1990s, other advances in self-organizing maps, un-supervised learning and hebbian networks provided alternate means for representing knowledge.
• In the 1990s-2000s, other machine learning approaches appeared to take precedence, with lines blurring between ANNs, machine classification, reinforcement learning, and several approaches that linked supervised and unsupervised models (O’Reilly, HTMs, Grossberg).
• In the 2000s, Bayesian approaches were foremost
• In the 2010s, we have seen a resurgence of deep-learning methods. The advances here have been driven by (1) advances in software that allow us to use GPU (graphics cards) to efficiently train and use networks (2) large data labeled data sets, often generated through amazon mechanical turk or as a byproduct of CAPTCHA systems; (3) using 15+ hidden layers; (4) effective use of specific types of layer architectures, including convolutional networks that de-localize patterns from their position in an image.

A simple two-layer neural network can be considered that is essentially what our multinomial regression or logistic regression model is doing. Inputs include a set of features, and output nodes (possibly one per class) are classifications that are learned. Alterately, a pattern can be learned by the output nodes. The main issue here is estimating weights, which are done with heuristic error-propagation approaches rather than MLE or least squares. This is inefficient for two-layer problems, but the heuristic approach will pay off for more complex problems.

The main advance of the late 1970s and early 1980s was adoption of ‘hidden layer’ ANNs. These hidden layers permit solving the XOR problem: when a class is associated with an exclusive or logic. The category structure is stored in a distributed fashion across all nodes, but there is a sense in which the number of hidden nodes controls how complex the classification structure that is possible. With a hidden layer, optimization is difficult with traditional means, but the heuristic approaches generally work reasonably well.

We will start with an image processing example. We will take two images (S and X) and sample features from them to make exemplars:

# library(imager) s <-load.image('s.data.bmp') x <- load.image('x.bmp') svec
# <- as.vector(s) xvec <- as.vector(x) write.csv(svec,'s.csv')
# write.csv(xvec,'x.csv')

## here, the lower the value, the darker the image.

## reverse the numbers
svec$x <- 255 - svec$x
xvec$x <- 255 - xvec$x

par(mfrow = c(1, 2))

image(matrix(svec$x, 10, 10, byrow = T), col = grey(100:0/100)) image(matrix(xvec$x, 10, 10, byrow = T), col = grey(100:0/100))

To train the model, we will sample 500 examples of each template:

dataX <- matrix(0, ncol = 100, nrow = 250)
dataS <- matrix(0, ncol = 100, nrow = 250)
letter <- rep(c("x", "s"), each = 250)

par(mfrow = c(4, 2))

for (i in 1:250) {
x <- rep(0, 100)
xtmp <- table(sample(1:100, size = 50, prob = as.matrix(xvec$x), replace = T)) x[as.numeric(names(xtmp))] <- xtmp/max(xtmp) s <- rep(0, 100) stmp <- table(sample(1:100, size = 50, prob = as.matrix(svec$x), replace = T))
s[as.numeric(names(stmp))] <- stmp/max(stmp)

if (i <= 4) {
image(matrix(s, 10, 10, byrow = T), main = "S example", col = grey(100:0/100))
image(matrix(x, 10, 10, byrow = T), main = "X example", col = grey(100:0/100))
}

dataX[i, ] <- x
dataS[i, ] <- s
}

data <- rbind(dataX, dataS)

Let’s train a neural network on these. Note that we could probably have trained it on the prototypes–maybe from the mnist library examined in earlier chapters.

library(nnet)
options(warn = 2)
# model <- nnet(letter~data,size=2) #This doesn't work.

# Let's transform the letter to a numeric value
model <- nnet(y = as.numeric(letter == "s"), x = data, size = 2)
# weights:  205
initial  value 132.864566
final  value 0.000000
converged
model
a 100-2-1 network with 205 weights
options were -
# alternately, try using letter as a factor, and use a formula. This also
# plays with some of the learning parameters
merged <- data.frame(letter = as.factor(letter), data)
model2 <- nnet(letter ~ ., data = merged, size = 2, rarg = 0.1, decay = 1e-04,
maxit = 500)
# weights:  205
initial  value 325.456462
iter  10 value 4.559121
iter  20 value 0.066991
iter  30 value 0.058188
iter  40 value 0.053207
iter  50 value 0.050504
iter  60 value 0.049369
iter  70 value 0.047806
iter  80 value 0.046845
iter  90 value 0.045443
iter 100 value 0.044289
iter 110 value 0.043339
iter 120 value 0.042775
iter 130 value 0.042704
iter 140 value 0.042641
iter 150 value 0.042611
iter 160 value 0.042581
iter 170 value 0.042546
iter 180 value 0.042521
iter 190 value 0.042506
iter 200 value 0.042504
iter 210 value 0.042503
final  value 0.042503
converged

Obtaining predicted response

When we use predict, by default it gives us the ‘raw’ values–activation values returned by the trained network. Because the final layer of this network has just one node (100-2-1), it is just an activation value indicating the class (0 for X and 1 for S). The values are not exactly 0 and 1–they are floating point values very close.

out1 <- predict(model, newdata = data)
plot(out1)

If there were a combined example that was hard to distinguish we would get a different value:

test <- (data[3, ] + data[255, ])/2

par(mfrow = c(1, 3))
image(matrix(data[3, ], 10), col = grey(100:0/100))
image(matrix(data[255, ], 10), col = grey(100:0/100))
image(matrix(test, 10), col = grey(100:0/100))

predict(model, newdata = data[3, ] + data[4, ])
     [,1]
[1,]    0
predict(model, newdata = data[255, ])
     [,1]
[1,]    1
predict(model, newdata = test)
          [,1]
[1,] 0.9962509

In this case, the X shows up as a strong X, the S shows up as an S, but the combined version is a slightly weaker S.

We can get classifications using type=“class”:

predict(model2, type = "class")
 [1] "x" "x" "x" "x" "x" "x" "x" "x" "x" "x" "x" "x" "x" "x" "x" "x" "x"
[18] "x" "x" "x" "x" "x" "x" "x" "x" "x" "x" "x" "x" "x" "x" "x" "x" "x"
[35] "x" "x" "x" "x" "x" "x" "x" "x" "x" "x" "x" "x" "x" "x" "x" "x" "x"
[52] "x" "x" "x" "x" "x" "x" "x" "x" "x" "x" "x" "x" "x" "x" "x" "x" "x"
[69] "x" "x" "x" "x" "x" "x" "x"
[ reached getOption("max.print") -- omitted 425 entries ]
table(letter, predict(model2, type = "class"))

letter   s   x
s 250   0
x   0 250

Training with very limited/noisy examples

This classification is actually perfect, but there was a lot of information available. Let’s sample just 5 points out to create the pattern:

dataX <- matrix(0, ncol = 100, nrow = 250)
dataS <- matrix(0, ncol = 100, nrow = 250)
letter <- rep(c("x", "s"), each = 250)

par(mfrow = c(4, 2))

for (i in 1:250) {
x <- rep(0, 100)
xtmp <- table(sample(1:100, size = 5, prob = as.matrix(xvec$x), replace = T)) x[as.numeric(names(xtmp))] <- xtmp/max(xtmp) s <- rep(0, 100) stmp <- table(sample(1:100, size = 5, prob = as.matrix(svec$x), replace = T))
s[as.numeric(names(stmp))] <- stmp/max(stmp)

## plot the first few examples:
if (i <= 4) {
image(matrix(s, 10, 10, byrow = T), main = "S example", col = grey(100:0/100))
image(matrix(x, 10, 10, byrow = T), main = "X example", col = grey(100:0/100))
}
dataX[i, ] <- x
dataS[i, ] <- s
}

data <- rbind(dataX, dataS)

merged <- data.frame(letter = as.factor(letter), data)
model3 <- nnet(letter ~ ., data = merged, size = 2, rarg = 0.1, decay = 1e-04,
maxit = 500)
# weights:  205
initial  value 365.797187
iter  10 value 113.984639
iter  20 value 40.661819
iter  30 value 27.034230
iter  40 value 21.056257
iter  50 value 20.708048
iter  60 value 19.980680
iter  70 value 18.353278
iter  80 value 17.770561
iter  90 value 16.049042
iter 100 value 14.885579
iter 110 value 14.136124
iter 120 value 13.572573
iter 130 value 13.048346
iter 140 value 12.124278
iter 150 value 9.756285
iter 160 value 9.547611
iter 170 value 9.232650
iter 180 value 8.995707
iter 190 value 8.907128
iter 200 value 8.834860
iter 210 value 8.739258
iter 220 value 7.448673
iter 230 value 7.397582
iter 240 value 7.346586
iter 250 value 7.141233
iter 260 value 6.974592
iter 270 value 6.649162
iter 280 value 6.292651
iter 290 value 6.054385
iter 300 value 5.491237
iter 310 value 4.807021
iter 320 value 4.731742
iter 330 value 4.703940
iter 340 value 4.686917
iter 350 value 4.657098
iter 360 value 4.634437
iter 370 value 4.618265
iter 380 value 4.604122
iter 390 value 4.588082
iter 400 value 4.521566
iter 410 value 3.999597
iter 420 value 3.800972
iter 430 value 3.640904
iter 440 value 2.857335
iter 450 value 2.731335
iter 460 value 2.706048
iter 470 value 2.690638
iter 480 value 2.682754
iter 490 value 2.678482
iter 500 value 2.674817
final  value 2.674817
stopped after 500 iterations
table(letter, predict(model3, type = "class"))

letter   s   x
s 250   0
x   1 249

It still does very well, with a few errors, for very sparse data. In fact, it might be doing TOO well. That is, in a sense, it is picking up on arbitrary but highly diagnostic features. A human observer would never be confident in the outcome, because the information is too sparse, but in this limited world, a single pixel is enough to make a good guess.

Neural Networks and the XOR problem

Neural networks became popular when researchers realized that networks with a hidden layer could solve ‘XOR classification problems’. Early on, researchers recognized that a simple perception (2-layer) neural network could be used for AND or OR combinations, but not XOR, as these are not linearly separable. XOR classification maps onto many real-world interaction problems. For example, two safe pharmaceuticals might be dangerous when taken together, and a simple neural network could never detect this state–if one is good, and the other is good, both must be better. An XOR problem is one in which one feature or another (but not both or neither) indicate class membership. In order to perform classification with this logic, a hidden layer is required.

Here is a class defined by an XOR structure:

library(MASS)
library(DAAG)
feature1 <- rnorm(200)
feature2 <- rnorm(200)
outcome <- as.factor((feature1 > 0.6 & feature2 > 0.3) | (feature1 > 0.6 & feature2 <
0.3))
outcome <- as.factor((feature1 * (-feature2) + rnorm(200)) > 0)

The linear discriminant model fails to discriminate (at least without an interaction)

lmodel <- lda(outcome ~ feature1 + feature2)

confusion(outcome, predict(lmodel)$class) Overall accuracy = 0.515 Confusion matrix Predicted (cv) Actual FALSE TRUE FALSE 0.748 0.252 TRUE 0.753 0.247 lmodel2 <- lda(outcome ~ feature1 * feature2) confusion(outcome, predict(lmodel2)$class)
Overall accuracy = 0.745

Confusion matrix
Predicted (cv)
Actual  FALSE  TRUE
FALSE 0.841 0.159
TRUE  0.366 0.634

Similarly, the neural networks with an empty single layer (skip=TRUE) are not great at discriminating, but with a few hidden nodes they work well.

n1 <- nnet(outcome ~ feature1 + feature2, size = 0, skip = TRUE)
# weights:  3
initial  value 156.228785
iter  10 value 136.519758
final  value 136.519669
converged
confusion(outcome, factor(predict(n1, type = "class"), levels = c(TRUE, FALSE)))
Overall accuracy = 0.485

Confusion matrix
Predicted (cv)
Actual  FALSE  TRUE
FALSE 0.252 0.748
TRUE  0.247 0.753
n2 <- nnet(outcome ~ feature1 + feature2, size = 3)
# weights:  13
initial  value 140.296005
iter  10 value 124.829796
iter  20 value 108.221506
iter  30 value 106.021984
iter  40 value 105.512720
iter  50 value 102.931669
iter  60 value 101.519958
iter  70 value 101.005351
iter  80 value 100.766655
iter  90 value 100.696543
iter 100 value 100.567358
final  value 100.567358
stopped after 100 iterations
confusion(outcome, factor(predict(n2, type = "class"), levels = c(TRUE, FALSE)))
Overall accuracy = 0.27

Confusion matrix
Predicted (cv)
Actual  FALSE  TRUE
FALSE 0.196 0.804
TRUE  0.645 0.355

Because we have the XOR structure, the simple neural network without a hidden layer is essentially LDA, and in fact often gets a similar level of accuracy (53%).

IPhone Data using the NNet

To model the iphone data set, we need to decide on how large of a model we want. We need to also remember that training a model like this is not deterministic–every time we do it the situation will be a little different. Because we have just two classes, maybe a 2-layer hidden network would work.

By fitting the model several times, we can see that it performs differently every time. At times, the model does reasonably well. This does about as well as any of the best classification models. Curiously, this particular model has a bias toward Android accuracy.

phone <- read.csv("data_study1.csv")

set.seed(100)
phonemodel <- nnet(Smartphone ~ ., data = phone, size = 2)
# weights:  29
initial  value 366.608558
iter  10 value 343.487057
iter  20 value 319.174388
iter  30 value 310.580512
iter  40 value 302.513345
iter  50 value 300.470075
iter  60 value 300.402561
final  value 300.400881
converged
confusion(phone$Smartphone, factor(predict(phonemodel, newdata = phone, type = "class"), levels = c("Android", "iPhone"))) Overall accuracy = 0.679 Confusion matrix Predicted (cv) Actual Android iPhone Android 0.868 0.132 iPhone 0.455 0.545 Other times, it does poorly: Here, it calls everything an iPhone: set.seed(101) phonemodel2 <- nnet(Smartphone ~ ., data = phone, size = 2) # weights: 29 initial value 457.291975 final value 358.808675 converged confusion(phone$Smartphone, factor(predict(phonemodel2, newdata = phone, type = "class"),
levels = c("Android", "iPhone")))
Overall accuracy = 0.586

Confusion matrix
Predicted (cv)
Actual    Android iPhone
Android       0      1
iPhone        0      1

In this case, it called everything in iPhone, resulting in 58.6% accuracy. Like many of our approaches, we are doing heuristic optimization and so may end up in local optima. It is thus useful to run the model many several times and look for the best model. Running this many times, the best models seem to get around 370-390 correct, which is in the low 70% for accuracy.

preds <- matrix(0, 100)
for (i in 1:100) {
phonemodel3 <- nnet(Smartphone ~ ., data = phone, size = 2)
preds[i] <- confusion(phone$Smartphone, factor(predict(phonemodel3, newdata = phone, type = "class"), levels = c("Android", "iPhone")))$overall

}

hist(preds, col = "gold", main = "Accuracy of 100 fitted models (2 hidden nodes)",
xlim = c(0, 1))

Do we do any better, on average, with more hidden nodes?

preds <- matrix(0, 100)
for (i in 1:100) {
phonemodel3 <- nnet(Smartphone ~ ., data = phone, size = 6)
preds[i] <- confusion(phone$Smartphone, factor(predict(phonemodel3, newdata = phone, type = "class"), levels = c("Android", "iPhone")))$overall

}

hist(preds, col = "gold", main = "Accuracy of 100 fitted models (6 hidden nodes)",
xlim = c(0, 1))

This seems to be more consistent, and do better overall–usually above 70% accuracy. But like every model we have examined, the best models are likely to be over-fitting, and getting lucky at re-predicting their own data. It would also be important to implement a cross-validation scheme. There is no built-in cross-validation here, but you can implement one using subset functions.

train <- rep(FALSE, nrow(phone))
train[sample(1:nrow(phone), size = 300)] <- TRUE
test <- !train

phonemodel2 <- nnet(Smartphone ~ ., data = phone, size = 6, subset = train)
# weights:  85
initial  value 368.591552
iter  10 value 202.685599
iter  20 value 200.485475
iter  30 value 185.820962
iter  40 value 177.941509
iter  50 value 171.618293
iter  60 value 162.139666
iter  70 value 158.984191
iter  80 value 158.401304
iter  90 value 158.307395
iter 100 value 158.290424
final  value 158.290424
stopped after 100 iterations
confusion(phone$Smartphone[test], predict(phonemodel2, newdata = phone[test, ], type = "class")) Overall accuracy = 0.598 Confusion matrix Predicted (cv) Actual Android iPhone Android 0.722 0.278 iPhone 0.492 0.508 We can try this 100 times and see how well it does on the cross-validation set: preds <- rep(0, 100) for (i in 1:100) { train <- rep(FALSE, nrow(phone)) train[sample(1:nrow(phone), size = 300)] <- TRUE test <- !train phonemodel2 <- nnet(Smartphone ~ ., data = phone, size = 6, subset = train) preds[i] <- confusion(phone$Smartphone[test], factor(predict(phonemodel2,
newdata = phone[test, ], type = "class"), levels = c("Android", "iPhone")))$overall } hist(preds, col = "gold", main = "Accuracy of 100 cross-validated models (6 hidden nodes)", xlim = c(0, 1)) The cross-validation scores are typically a bit lower, with models getting around 60% on average, and up to 70% for the best. Now that we have built this, we could use average cross-validation accuracy to help select variables for exclusion. Here, let’s just test the predictors we have found previously to be fairly good: preds <- rep(0, 100) for (i in 1:100) { train <- rep(FALSE, nrow(phone)) train[sample(1:nrow(phone), size = 300)] <- TRUE test <- !train phonemodel2 <- nnet(Smartphone ~ Gender + Avoidance.Similarity + Phone.as.status.object + Age, data = phone, size = 6, subset = train) preds[i] <- confusion(phone$Smartphone[test], factor(predict(phonemodel2,
newdata = phone[test, ], type = "class"), levels = c("Android", "iPhone")))\$overall

}

hist(preds, col = "gold", main = "Accuracy of 100 cross-validated models (6 hidden nodes)",
xlim = c(0, 1))

Most of these are better than chance, and it seems to do about as well as the full set of predictors as well.

2019-03-15