Building a Keras Model for Automatic Ultrasound Tongue Images Classification
This document details an attempt at building an image-classification model for Ultrasound Tongue Imaging (UTI) data using R interface for Keras. The goal was to train a neural network to recognize and classify tongue shapes for the articulation of /r/ as retroflex or bunched.
The supervised model presented below was trained based on a 400 pictures dataset of pre-labeled ultrasound tongue images of /r/ collected by King & Ferragne (2019).
This script is adapted from the Image Recognition and Classification Script published by Rai BK (2019) in open access via the following link: https://raw.githubusercontent.com/bkrai/DeepLearningR/master/ImageRecognitionAndClassificationWithR. See also the author’s demonstration video on how to apply the script to your own data: https://www.youtube.com/watch?v=iExh0qj2Ouo&t=381s
The full script can be found at the end of the page. You can find below a step-by-step description of how the script was adapted to our own UTI data. Changes made to the original script are explained, and deleted lines of code were left in comment.
Load packages
We load the {keras} and the {tensorflow} packages. As the {EBImage} package is not compatible with the bitmap format of our data pictures, we used the {imager} package instead.
#library(EBImage)
library(imager)
library(keras)
library(tensorflow)Read Images
First, data pictures used for training and testing need to be imported in R.
We load data pictures from our working directory (i.e. set to the directory where pictures are stored). As we are dealing with larger data, instead of concatenating all the pictures name one by one, a list of all the ‘.bmp’ files found in the working directory is created.
setwd("~/Keras-Tensorflow/toy")
#pics <- c('p1.jpg', 'p2.jpg', 'p3.jpg', 'p4.jpg', 'p5.jpg', 'p6.jpg',
# 'c1.jpg', 'c2.jpg', 'c3.jpg', 'c4.jpg', 'c5.jpg', 'c6.jpg')
mypath <- getwd()
pics <- list.files(path = mypath, pattern="*.bmp")
mypic <- as.list(list.files(path = mypath, pattern="*.bmp"))Then, we import the pictures corresponding to each file name of the list. An empty list is filled with the pictures by looping through the list of files. We used the function load.image() of {imager} instead of readImage() of {EBImage}, not compatible with our data format.
mypic <- list()
#for (i in 1:12) {mypic[[i]] <- readImage(pics[i])}
for (i in 1:length(pics)) {mypic[[i]] <- load.image(pics[i])}Explore the pictures
We can explore the imported data to check that everything was correctly imported.
print(mypic[[1]]) #prints the picture matrix
display(mypic[[120]]) #displays the picture - note that this function will not work
#with the datasets linked to that script as the pictures they
#contain are already pre-processed.
summary(mypic[[1]]) #computes the min, max, median, mean, 1st and 3rd quartiles
#of the picture's matrix
hist(mypic[[2]]) #plots the image
str(mypic) #displays the structure of the image list object Pre-processing image data
Resize
Pictures are resized to the same dimensions. Our images are all 480 x 600 pixels but we resize them to a square ratio required by the model using a loop and the function resize(). Images are resized to the smallest dimension (480 x 480) to limit the loss of resolution.
for (i in 1:length(pics)) {
#mypic[[i]] <- resize(mypic[[i]], 28, 28)
mypic[[i]] <- resize(mypic[[i]], 480, 480)
}Reshape
Resized data needs to be turned into a single array, using the function array_reshape(), which transforms each image into a single vector.
#for (i in 1:length(pics)) {mypic[[i]] <- array_reshape(mypic[[i]], c(28, 28, 4))}
for (i in 1:length(pics)) {mypic[[i]] <- array_reshape(mypic[[i]], c(480, 480, 4))}Row Bind
Data is split into a training set and a test set: 80% of our sample for training, 20% for testing. The number of pictures within the training set and the test set is equal across classification categories (i.e. bunched and retroflex). The training set will be used to train the model to recognize the two types of tongue configuration, while the test set will be automatically classified by the model to test its efficiency on new data.
trainx <- NULL
for (i in 1:160) {trainx <- rbind(trainx, mypic[[i]])}
for (i in 201:360) {trainx <- rbind(trainx, mypic[[i]])}
str(trainx)## num [1:320, 1:921600] 0 0 0 0 0 0 0 0 0 0 ...#testx <- ---(mypic[[6]], mypic[[12]])
testx <- NULL
for (i in 161:200) {testx <- rbind(testx, mypic[[i]])}
for (i in 361:400) {testx <- rbind(testx, mypic[[i]])}Vectors are created assigning corresponding categories to each image of the training and the test set. 0 corresponds to the bunched group and 1 to the retroflex group.
#trainy <- c(0,0,0,0,0,1,1,1,1,1 )
#testy <- c(---, ---)
vecb <- rep(0,160)
vecr <- rep(1,160)
trainy <- c(vecb, vecr)
vecbtest <- rep(0,40)
vecrtest <- rep(1,40)
testy <- c(vecbtest, vecrtest)One Hot encoding
The integer values 0 and 1 assigned to each category (bunched/retroflex) are converted into 2 binary variables: 01 for bunched and 10 for retroflex.
trainLabels <- to_categorical(trainy)
testLabels <- to_categorical(testy)Building a model
Time to build the deep learning model! The original script uses keras sequential model. We kept the arbitrary number of units and the activation functions used in the video example of the script. Only the input_shape argument was changed to fit our own data shape, obtained using the str(trainx) function.
str(trainx)## num [1:320, 1:921600] 0 0 0 0 0 0 0 0 0 0 ...model <- keras_model_sequential()
model %>%
#layer_dense(units = 256, activation = 'relu', input_shape = c(2304))
layer_dense(units = 512, activation = 'relu', input_shape = c(921600)) %>%
layer_dropout(rate = 0.1) %>%
layer_dense(units = 256, activation = 'relu') %>%
layer_dropout(rate = 0.1) %>%
layer_dense(units = 256, activation = 'relu') %>%
layer_dropout(rate = 0.1) %>%
layer_dense(units = 2, activation = 'softmax')
summary(model)## Model: "sequential"
## ________________________________________________________________________________
## Layer (type) Output Shape Param #
## ================================================================================
## dense_3 (Dense) (None, 512) 471859712
## ________________________________________________________________________________
## dropout_2 (Dropout) (None, 512) 0
## ________________________________________________________________________________
## dense_2 (Dense) (None, 256) 131328
## ________________________________________________________________________________
## dropout_1 (Dropout) (None, 256) 0
## ________________________________________________________________________________
## dense_1 (Dense) (None, 256) 65792
## ________________________________________________________________________________
## dropout (Dropout) (None, 256) 0
## ________________________________________________________________________________
## dense (Dense) (None, 2) 514
## ================================================================================
## Total params: 472,057,346
## Trainable params: 472,057,346
## Non-trainable params: 0
## ________________________________________________________________________________Compile
This is the last step to build the model. The model is compiled using the sgd optimizer ( adam was used in Rai’s video demo and the script used optimizer_rmsprop() ). The evaluation of the model performance is set to be based on accuracy.
model %>%
compile(loss = 'binary_crossentropy',
#optimizer = optimizer_rmsprop(),
optimizer = 'sgd',
metrics = c('accuracy'))Fit model
We call the fit() function to train the model on the training dataset built. epochs determine how many times will the model pass through the entire training dataset and batch_size the number of samples processed by the network in one batch.
history <- model %>%
fit(trainx,
trainLabels,
epochs = 30,
batch_size = 16,
validation_split = 0.2)The training evolution and results can be plotted using the plot() function
plot(history)
Evaluation & Prediction - train data
The keras function evaluate() gives loss and accuracy of the predictions made by the model on the training set.
model %>% evaluate(trainx, trainLabels)## loss accuracy
## 0.2753821 0.9000000The predictions made by the model are turned into a data frame and the highest predicted probability of each element to belong to a category is combined to the true label of each picture to form a confusion matrix. The table obtained shows how many pictures were predicted right or wrong by the model on the training set.
#pred <- model %>% predict_classes(trainx)
#prob <- model %>% predict_proba(trainx)
prob <- model %>% predict(trainx)
DF <- as.data.frame(prob)
colnames(DF)<- c(0,1)
pred <- as.numeric(colnames(DF)[max.col(DF,ties.method="first")])
#cbind(prob, Prected = pred, Actual= trainy)
table(Predicted = pred, Actual = trainy)## Actual
## Predicted 0 1
## 0 160 32
## 1 0 128We can also compute the probability of each picture to belong to a certain target category.
cbind(prob, Predicted = pred, Actual= trainy)## Predicted Actual
## [1,] 9.983928e-01 1.607265e-03 0 0
## [2,] 9.997187e-01 2.812827e-04 0 0
## [3,] 9.998105e-01 1.895178e-04 0 0
## [4,] 9.999202e-01 7.968653e-05 0 0
## [5,] 9.999446e-01 5.544783e-05 0 0
## [6,] 9.993873e-01 6.127420e-04 0 0
## [7,] 9.997994e-01 2.005497e-04 0 0
## [8,] 9.965559e-01 3.444072e-03 0 0
## [9,] 9.958761e-01 4.123930e-03 0 0
## [10,] 9.994928e-01 5.071991e-04 0 0
## [11,] 9.998599e-01 1.400289e-04 0 0
## [12,] 9.999353e-01 6.476170e-05 0 0
## [13,] 9.993562e-01 6.437785e-04 0 0
## [14,] 9.999642e-01 3.578198e-05 0 0
## [15,] 9.999731e-01 2.690405e-05 0 0
## [16,] 9.998533e-01 1.466823e-04 0 0
## [17,] 9.999325e-01 6.746127e-05 0 0
## [18,] 9.999642e-01 3.580311e-05 0 0
## [19,] 9.999543e-01 4.560950e-05 0 0
## [20,] 9.998989e-01 1.010829e-04 0 0
## [21,] 9.998378e-01 1.622035e-04 0 0
## [22,] 9.998840e-01 1.159476e-04 0 0
## [23,] 9.998257e-01 1.743407e-04 0 0
## [24,] 9.992697e-01 7.303728e-04 0 0
## [25,] 9.998688e-01 1.312600e-04 0 0
## [26,] 9.997234e-01 2.766586e-04 0 0
## [27,] 9.999748e-01 2.515052e-05 0 0
## [28,] 9.999450e-01 5.497586e-05 0 0
## [29,] 9.999722e-01 2.777813e-05 0 0
## [30,] 9.999158e-01 8.421243e-05 0 0
## [31,] 9.999436e-01 5.633336e-05 0 0
## [32,] 9.998851e-01 1.148450e-04 0 0
## [33,] 9.999490e-01 5.097740e-05 0 0
## [34,] 9.999050e-01 9.497710e-05 0 0
## [35,] 9.994659e-01 5.341377e-04 0 0
## [36,] 9.998389e-01 1.610776e-04 0 0
## [37,] 9.998995e-01 1.005302e-04 0 0
## [38,] 9.997607e-01 2.393010e-04 0 0
## [39,] 9.998065e-01 1.935270e-04 0 0
## [40,] 9.995885e-01 4.114039e-04 0 0
## [41,] 9.999282e-01 7.171014e-05 0 0
## [42,] 9.999170e-01 8.301160e-05 0 0
## [43,] 9.994650e-01 5.349584e-04 0 0
## [44,] 9.998946e-01 1.053848e-04 0 0
## [45,] 9.993062e-01 6.937773e-04 0 0
## [46,] 9.997864e-01 2.135395e-04 0 0
## [47,] 9.997455e-01 2.544932e-04 0 0
## [48,] 9.998424e-01 1.575113e-04 0 0
## [49,] 9.998037e-01 1.962455e-04 0 0
## [50,] 9.997198e-01 2.802393e-04 0 0
## [51,] 9.998119e-01 1.881134e-04 0 0
## [52,] 9.997907e-01 2.092560e-04 0 0
## [53,] 9.995937e-01 4.063467e-04 0 0
## [54,] 9.998031e-01 1.968630e-04 0 0
## [55,] 9.996995e-01 3.005625e-04 0 0
## [56,] 9.996552e-01 3.447658e-04 0 0
## [57,] 9.996697e-01 3.302988e-04 0 0
## [58,] 9.997674e-01 2.326602e-04 0 0
## [59,] 9.997037e-01 2.962399e-04 0 0
## [60,] 9.998654e-01 1.345486e-04 0 0
## [61,] 9.996248e-01 3.751273e-04 0 0
## [62,] 9.994236e-01 5.763771e-04 0 0
## [63,] 9.999242e-01 7.584775e-05 0 0
## [64,] 9.997894e-01 2.105489e-04 0 0
## [65,] 9.997467e-01 2.532141e-04 0 0
## [66,] 9.995308e-01 4.692310e-04 0 0
## [67,] 9.995390e-01 4.610046e-04 0 0
## [68,] 9.994606e-01 5.393968e-04 0 0
## [69,] 9.997650e-01 2.349825e-04 0 0
## [70,] 9.993581e-01 6.419197e-04 0 0
## [71,] 9.998016e-01 1.984769e-04 0 0
## [72,] 9.996489e-01 3.510246e-04 0 0
## [73,] 9.897090e-01 1.029104e-02 0 0
## [74,] 9.705392e-01 2.946085e-02 0 0
## [75,] 9.964329e-01 3.567069e-03 0 0
## [76,] 9.809007e-01 1.909924e-02 0 0
## [77,] 9.763268e-01 2.367314e-02 0 0
## [78,] 9.592965e-01 4.070359e-02 0 0
## [79,] 9.997405e-01 2.594950e-04 0 0
## [80,] 9.891267e-01 1.087323e-02 0 0
## [81,] 9.969009e-01 3.099093e-03 0 0
## [82,] 9.995621e-01 4.378707e-04 0 0
## [83,] 9.993976e-01 6.024084e-04 0 0
## [84,] 9.989133e-01 1.086679e-03 0 0
## [85,] 9.993761e-01 6.238799e-04 0 0
## [86,] 9.997076e-01 2.923679e-04 0 0
## [87,] 9.997794e-01 2.205620e-04 0 0
## [88,] 9.978207e-01 2.179232e-03 0 0
## [89,] 9.990898e-01 9.101505e-04 0 0
## [90,] 9.994504e-01 5.495541e-04 0 0
## [91,] 9.986405e-01 1.359481e-03 0 0
## [92,] 9.995605e-01 4.394192e-04 0 0
## [93,] 9.998757e-01 1.243461e-04 0 0
## [94,] 9.994690e-01 5.310808e-04 0 0
## [95,] 9.999018e-01 9.827721e-05 0 0
## [96,] 9.994963e-01 5.036197e-04 0 0
## [97,] 9.995683e-01 4.317169e-04 0 0
## [98,] 9.981782e-01 1.821726e-03 0 0
## [99,] 9.987741e-01 1.225926e-03 0 0
## [100,] 9.997625e-01 2.375587e-04 0 0
## [101,] 9.996375e-01 3.625412e-04 0 0
## [102,] 9.998091e-01 1.908870e-04 0 0
## [103,] 9.998490e-01 1.510247e-04 0 0
## [104,] 9.997655e-01 2.346069e-04 0 0
## [105,] 9.997800e-01 2.199928e-04 0 0
## [106,] 9.998614e-01 1.386408e-04 0 0
## [107,] 9.999511e-01 4.891308e-05 0 0
## [108,] 9.999301e-01 6.984831e-05 0 0
## [109,] 9.998388e-01 1.611186e-04 0 0
## [110,] 9.998859e-01 1.141078e-04 0 0
## [111,] 9.997677e-01 2.323437e-04 0 0
## [112,] 9.994817e-01 5.182424e-04 0 0
## [113,] 9.980999e-01 1.900131e-03 0 0
## [114,] 9.999551e-01 4.499256e-05 0 0
## [115,] 9.996215e-01 3.784181e-04 0 0
## [116,] 9.994530e-01 5.469955e-04 0 0
## [117,] 9.997959e-01 2.041502e-04 0 0
## [118,] 9.993704e-01 6.296542e-04 0 0
## [119,] 9.997162e-01 2.837860e-04 0 0
## [120,] 9.984024e-01 1.597550e-03 0 0
## [121,] 9.988310e-01 1.169065e-03 0 0
## [122,] 9.998375e-01 1.624088e-04 0 0
## [123,] 9.990018e-01 9.982351e-04 0 0
## [124,] 9.988493e-01 1.150750e-03 0 0
## [125,] 9.992896e-01 7.103460e-04 0 0
## [126,] 9.995304e-01 4.695576e-04 0 0
## [127,] 9.994133e-01 5.867181e-04 0 0
## [128,] 9.997699e-01 2.301944e-04 0 0
## [129,] 9.996663e-01 3.336288e-04 0 0
## [130,] 9.995202e-01 4.797843e-04 0 0
## [131,] 9.992406e-01 7.593267e-04 0 0
## [132,] 9.996607e-01 3.392560e-04 0 0
## [133,] 9.998280e-01 1.719469e-04 0 0
## [134,] 9.994214e-01 5.786485e-04 0 0
## [135,] 9.980814e-01 1.918562e-03 0 0
## [136,] 9.995969e-01 4.031673e-04 0 0
## [137,] 9.997558e-01 2.442212e-04 0 0
## [138,] 9.997025e-01 2.974875e-04 0 0
## [139,] 9.997738e-01 2.262408e-04 0 0
## [140,] 9.997324e-01 2.675446e-04 0 0
## [141,] 9.998316e-01 1.684522e-04 0 0
## [142,] 9.997084e-01 2.915745e-04 0 0
## [143,] 9.993795e-01 6.204367e-04 0 0
## [144,] 9.994606e-01 5.393318e-04 0 0
## [145,] 9.993840e-01 6.159692e-04 0 0
## [146,] 9.987645e-01 1.235451e-03 0 0
## [147,] 9.995714e-01 4.285795e-04 0 0
## [148,] 9.995151e-01 4.849239e-04 0 0
## [149,] 9.997014e-01 2.985428e-04 0 0
## [150,] 9.998289e-01 1.709800e-04 0 0
## [151,] 9.998087e-01 1.912372e-04 0 0
## [152,] 9.996707e-01 3.292525e-04 0 0
## [153,] 9.997466e-01 2.534254e-04 0 0
## [154,] 9.996703e-01 3.297400e-04 0 0
## [155,] 9.997622e-01 2.377364e-04 0 0
## [156,] 9.996877e-01 3.123992e-04 0 0
## [157,] 9.983680e-01 1.632065e-03 0 0
## [158,] 9.998674e-01 1.324968e-04 0 0
## [159,] 9.995942e-01 4.058457e-04 0 0
## [160,] 9.944971e-01 5.502940e-03 0 0
## [161,] 1.098772e-04 9.998901e-01 1 1
## [162,] 3.713932e-04 9.996285e-01 1 1
## [163,] 1.652771e-04 9.998347e-01 1 1
## [164,] 4.967576e-04 9.995033e-01 1 1
## [165,] 7.339979e-05 9.999266e-01 1 1
## [166,] 1.440088e-03 9.985599e-01 1 1
## [167,] 5.924499e-04 9.994075e-01 1 1
## [168,] 2.416391e-04 9.997583e-01 1 1
## [169,] 4.271963e-04 9.995728e-01 1 1
## [170,] 2.831558e-03 9.971685e-01 1 1
## [171,] 2.933191e-03 9.970668e-01 1 1
## [172,] 1.053041e-03 9.989470e-01 1 1
## [173,] 2.538522e-04 9.997461e-01 1 1
## [174,] 2.561758e-03 9.974382e-01 1 1
## [175,] 5.502952e-04 9.994497e-01 1 1
## [176,] 4.892538e-04 9.995108e-01 1 1
## [177,] 6.583488e-04 9.993417e-01 1 1
## [178,] 8.733877e-04 9.991266e-01 1 1
## [179,] 6.125733e-04 9.993874e-01 1 1
## [180,] 3.163244e-04 9.996837e-01 1 1
## [181,] 1.482092e-03 9.985179e-01 1 1
## [182,] 2.917250e-04 9.997082e-01 1 1
## [183,] 2.858832e-04 9.997141e-01 1 1
## [184,] 4.229792e-04 9.995770e-01 1 1
## [185,] 3.639577e-05 9.999636e-01 1 1
## [186,] 2.926911e-05 9.999707e-01 1 1
## [187,] 3.001961e-05 9.999700e-01 1 1
## [188,] 1.548625e-05 9.999845e-01 1 1
## [189,] 3.182485e-05 9.999682e-01 1 1
## [190,] 2.870591e-05 9.999713e-01 1 1
## [191,] 2.643285e-05 9.999735e-01 1 1
## [192,] 3.288033e-05 9.999671e-01 1 1
## [193,] 2.306892e-05 9.999769e-01 1 1
## [194,] 5.441360e-04 9.994559e-01 1 1
## [195,] 2.434788e-04 9.997565e-01 1 1
## [196,] 4.226490e-05 9.999577e-01 1 1
## [197,] 5.872261e-04 9.994128e-01 1 1
## [198,] 3.939705e-04 9.996061e-01 1 1
## [199,] 7.764243e-05 9.999224e-01 1 1
## [200,] 3.274001e-04 9.996727e-01 1 1
## [201,] 8.168266e-05 9.999183e-01 1 1
## [202,] 3.351775e-04 9.996648e-01 1 1
## [203,] 6.156992e-05 9.999384e-01 1 1
## [204,] 7.538503e-05 9.999247e-01 1 1
## [205,] 8.919882e-05 9.999108e-01 1 1
## [206,] 1.590679e-04 9.998409e-01 1 1
## [207,] 8.910980e-05 9.999108e-01 1 1
## [208,] 1.132958e-04 9.998866e-01 1 1
## [209,] 7.889375e-05 9.999211e-01 1 1
## [210,] 1.088529e-04 9.998912e-01 1 1
## [211,] 1.380411e-04 9.998620e-01 1 1
## [212,] 1.399320e-04 9.998600e-01 1 1
## [213,] 8.967549e-05 9.999104e-01 1 1
## [214,] 1.792290e-04 9.998208e-01 1 1
## [215,] 1.316856e-04 9.998683e-01 1 1
## [216,] 2.215968e-04 9.997784e-01 1 1
## [217,] 1.649701e-04 9.998350e-01 1 1
## [218,] 1.628802e-04 9.998370e-01 1 1
## [219,] 1.150189e-04 9.998850e-01 1 1
## [220,] 4.486065e-05 9.999552e-01 1 1
## [221,] 7.869471e-04 9.992130e-01 1 1
## [222,] 2.267137e-04 9.997733e-01 1 1
## [223,] 1.662027e-03 9.983380e-01 1 1
## [224,] 3.571720e-04 9.996428e-01 1 1
## [225,] 1.830104e-03 9.981699e-01 1 1
## [226,] 7.419904e-04 9.992580e-01 1 1
## [227,] 4.017781e-03 9.959822e-01 1 1
## [228,] 1.455445e-03 9.985446e-01 1 1
## [229,] 1.164197e-02 9.883581e-01 1 1
## [230,] 4.265411e-04 9.995734e-01 1 1
## [231,] 3.042598e-04 9.996958e-01 1 1
## [232,] 3.595449e-03 9.964045e-01 1 1
## [233,] 1.204935e-03 9.987950e-01 1 1
## [234,] 6.430979e-04 9.993569e-01 1 1
## [235,] 7.319025e-05 9.999268e-01 1 1
## [236,] 1.357673e-04 9.998642e-01 1 1
## [237,] 8.991079e-05 9.999101e-01 1 1
## [238,] 7.881683e-05 9.999212e-01 1 1
## [239,] 6.846207e-04 9.993154e-01 1 1
## [240,] 7.286671e-05 9.999272e-01 1 1
## [241,] 8.723323e-05 9.999127e-01 1 1
## [242,] 1.207841e-04 9.998792e-01 1 1
## [243,] 7.124616e-05 9.999287e-01 1 1
## [244,] 6.981249e-05 9.999301e-01 1 1
## [245,] 2.118583e-04 9.997881e-01 1 1
## [246,] 4.826977e-04 9.995173e-01 1 1
## [247,] 3.288905e-04 9.996711e-01 1 1
## [248,] 8.712062e-04 9.991288e-01 1 1
## [249,] 2.358101e-03 9.976419e-01 1 1
## [250,] 3.663628e-04 9.996337e-01 1 1
## [251,] 2.287251e-04 9.997713e-01 1 1
## [252,] 8.998202e-04 9.991002e-01 1 1
## [253,] 5.631665e-04 9.994368e-01 1 1
## [254,] 2.892806e-03 9.971072e-01 1 1
## [255,] 2.565000e-04 9.997435e-01 1 1
## [256,] 7.324066e-05 9.999268e-01 1 1
## [257,] 5.529892e-04 9.994470e-01 1 1
## [258,] 1.184998e-04 9.998815e-01 1 1
## [259,] 1.403889e-03 9.985961e-01 1 1
## [260,] 1.556015e-04 9.998444e-01 1 1
## [261,] 7.255790e-04 9.992744e-01 1 1
## [262,] 9.368851e-04 9.990631e-01 1 1
## [263,] 3.263004e-04 9.996737e-01 1 1
## [264,] 2.946075e-04 9.997054e-01 1 1
## [265,] 5.160413e-04 9.994839e-01 1 1
## [266,] 3.777939e-04 9.996222e-01 1 1
## [267,] 4.773724e-04 9.995227e-01 1 1
## [268,] 4.065840e-04 9.995934e-01 1 1
## [269,] 7.069447e-04 9.992931e-01 1 1
## [270,] 1.593244e-03 9.984068e-01 1 1
## [271,] 9.598916e-01 4.010841e-02 0 1
## [272,] 8.780370e-04 9.991220e-01 1 1
## [273,] 4.164776e-04 9.995835e-01 1 1
## [274,] 6.882777e-01 3.117223e-01 0 1
## [275,] 4.074494e-04 9.995926e-01 1 1
## [276,] 2.456729e-04 9.997544e-01 1 1
## [277,] 4.121721e-04 9.995878e-01 1 1
## [278,] 6.098999e-04 9.993901e-01 1 1
## [279,] 3.464999e-04 9.996535e-01 1 1
## [280,] 4.585216e-04 9.995415e-01 1 1
## [281,] 1.503594e-04 9.998497e-01 1 1
## [282,] 1.964552e-04 9.998036e-01 1 1
## [283,] 9.796051e-01 2.039498e-02 0 1
## [284,] 3.069145e-04 9.996932e-01 1 1
## [285,] 9.791078e-01 2.089216e-02 0 1
## [286,] 9.521503e-01 4.784973e-02 0 1
## [287,] 8.798040e-01 1.201961e-01 0 1
## [288,] 9.409662e-01 5.903386e-02 0 1
## [289,] 9.561330e-01 4.386695e-02 0 1
## [290,] 9.614549e-01 3.854518e-02 0 1
## [291,] 7.887657e-01 2.112342e-01 0 1
## [292,] 9.309083e-01 6.909171e-02 0 1
## [293,] 8.914774e-01 1.085226e-01 0 1
## [294,] 9.227560e-01 7.724402e-02 0 1
## [295,] 2.022789e-04 9.997978e-01 1 1
## [296,] 9.023197e-01 9.768032e-02 0 1
## [297,] 9.984826e-01 1.517319e-03 0 1
## [298,] 9.199539e-01 8.004607e-02 0 1
## [299,] 9.052089e-01 9.479112e-02 0 1
## [300,] 9.040343e-01 9.596578e-02 0 1
## [301,] 9.851795e-01 1.482058e-02 0 1
## [302,] 9.541298e-01 4.587018e-02 0 1
## [303,] 5.601168e-01 4.398831e-01 0 1
## [304,] 9.938062e-01 6.193795e-03 0 1
## [305,] 8.566729e-01 1.433271e-01 0 1
## [306,] 1.040735e-04 9.998959e-01 1 1
## [307,] 9.064919e-01 9.350810e-02 0 1
## [308,] 5.539749e-01 4.460251e-01 0 1
## [309,] 9.192756e-01 8.072436e-02 0 1
## [310,] 9.382939e-01 6.170611e-02 0 1
## [311,] 9.104283e-01 8.957173e-02 0 1
## [312,] 8.064916e-01 1.935084e-01 0 1
## [313,] 9.648029e-01 3.519709e-02 0 1
## [314,] 9.560360e-01 4.396398e-02 0 1
## [315,] 8.793966e-01 1.206034e-01 0 1
## [316,] 1.659405e-04 9.998341e-01 1 1
## [317,] 2.153188e-04 9.997846e-01 1 1
## [318,] 7.771777e-05 9.999223e-01 1 1
## [319,] 1.401607e-03 9.985984e-01 1 1
## [320,] 3.301175e-04 9.996699e-01 1 1For the test cases
The same process can be used for the test cases to see how the model actually performs on new data.
The evaluate() function can be applied to the test set, on which the model did not train, to estimate how well the model can generalize and perform on new data.
model %>% evaluate(testx,testLabels)## loss accuracy
## 0.1289199 0.9500000As with the training set, a confusion matrix can be obtained detailing which picture were correctly predicted as belonging to one or the other category.
prob.test <- model %>% predict(testx)
DF2 <- as.data.frame(prob.test)
colnames(DF2)<- c(0,1)
pred.test <- as.numeric(colnames(DF2)[max.col(DF2,ties.method="first")])
table(Predicted = pred.test, Actual = testy)## Actual
## Predicted 0 1
## 0 36 0
## 1 4 40Full script
##----------------------------------------------------------------
# Load packages
##----------------------------------------------------------------
#library(EBImage)
library(imager)
library(keras)
library(tensorflow)
##----------------------------------------------------------------
# Read Images
##----------------------------------------------------------------
setwd("~/Keras-Tensorflow/toy")
#pics <- c('p1.jpg', 'p2.jpg', 'p3.jpg', 'p4.jpg', 'p5.jpg', 'p6.jpg',
# 'c1.jpg', 'c2.jpg', 'c3.jpg', 'c4.jpg', 'c5.jpg', 'c6.jpg')
mypath <- getwd()
pics <- list.files(path = mypath, pattern="*.bmp")
mypic <- as.list(list.files(path = mypath, pattern="*.bmp"))
mypic <- list()
#for (i in 1:12) {mypic[[i]] <- readImage(pics[i])}
for (i in 1:length(pics)) {mypic[[i]] <- load.image(pics[i])}
##----------------------------------------------------------------
# Explore the pictures
##----------------------------------------------------------------
print(mypic[[1]]) #prints the picture matrix
display(mypic[[120]]) #displays the picture - note that this function will not work
#with the datasets linked to that script as the pictures they
#contain are already pre-processed.
summary(mypic[[1]]) #computes the min, max, median, mean, 1st and 3rd quartiles
#of the picture's matrix
hist(mypic[[2]]) #plots the image
str(mypic) #displays the structure of the image list object
##----------------------------------------------------------------
# Resize
##----------------------------------------------------------------
for (i in 1:length(pics)) {
#mypic[[i]] <- resize(mypic[[i]], 28, 28)
mypic[[i]] <- resize(mypic[[i]], 480, 480)
}
##----------------------------------------------------------------
# Reshape
##----------------------------------------------------------------
#for (i in 1:length(pics)) {mypic[[i]] <- array_reshape(mypic[[i]], c(28, 28, 4))}
for (i in 1:length(pics)) {mypic[[i]] <- array_reshape(mypic[[i]], c(480, 480, 4))}
##----------------------------------------------------------------
# Row Bind
##----------------------------------------------------------------
trainx <- NULL
for (i in 1:160) {trainx <- rbind(trainx, mypic[[i]])}
for (i in 201:360) {trainx <- rbind(trainx, mypic[[i]])}
#testx <- ---(mypic[[6]], mypic[[12]])
testx <- NULL
for (i in 161:200) {testx <- rbind(testx, mypic[[i]])}
for (i in 361:400) {testx <- rbind(testx, mypic[[i]])}
#trainy <- c(0,0,0,0,0,1,1,1,1,1 )
#testy <- c(---, ---)
vecb <- rep(0,160)
vecr <- rep(1,160)
trainy <- c(vecb, vecr)
vecbtest <- rep(0,40)
vecrtest <- rep(1,40)
testy <- c(vecbtest, vecrtest)
##----------------------------------------------------------------
# One Hot encoding
##----------------------------------------------------------------
trainLabels <- to_categorical(trainy)
testLabels <- to_categorical(testy)
##----------------------------------------------------------------
# Building a model
##----------------------------------------------------------------
str(trainx)
model <- keras_model_sequential()
model %>%
#layer_dense(units = 256, activation = 'relu', input_shape = c(2304))
layer_dense(units = 512, activation = 'relu', input_shape = c(921600)) %>%
layer_dropout(rate = 0.1) %>%
layer_dense(units = 256, activation = 'relu') %>%
layer_dropout(rate = 0.1) %>%
layer_dense(units = 256, activation = 'relu') %>%
layer_dropout(rate = 0.1) %>%
layer_dense(units = 2, activation = 'softmax')
summary(model)
##----------------------------------------------------------------
# Compile
##----------------------------------------------------------------
model %>%
compile(loss = 'binary_crossentropy',
#optimizer = optimizer_rmsprop(),
optimizer = 'sgd',
metrics = c('accuracy'))
##----------------------------------------------------------------
# Fit
##----------------------------------------------------------------
history <- model %>%
fit(trainx,
trainLabels,
epochs = 30,
batch_size = 16,
validation_split = 0.2)
plot(history)
##----------------------------------------------------------------
# Evaluation and prediction - training data
##----------------------------------------------------------------
#model loss and accuracy on training set
model %>% evaluate(trainx, trainLabels)
#confusion matrix
#pred <- model %>% predict_classes(trainx)
#prob <- model %>% predict_proba(trainx)
prob <- model %>% predict(trainx)
DF <- as.data.frame(prob)
colnames(DF)<- c(0,1)
pred <- as.numeric(colnames(DF)[max.col(DF,ties.method="first")])
#cbind(prob, Prected = pred, Actual= trainy)
table(Predicted = pred, Actual = trainy)
#probability to belong to a certain category
cbind(prob, Predicted = pred, Actual= trainy)
##----------------------------------------------------------------
# For the test cases
##----------------------------------------------------------------
model %>% evaluate(testx,testLabels)
prob.test <- model %>% predict(testx)
DF2 <- as.data.frame(prob.test)
colnames(DF2)<- c(0,1)
pred.test <- as.numeric(colnames(DF2)[max.col(DF2,ties.method="first")])
table(Predicted = pred.test, Actual = testy)References
King, H., & Ferragne, E. (2019). The Contribution of Lip Protrusion to Anglo-English /r/: Evidence from Hyper- and Non- Hyperarticulated Speech. Interspeech 2019, 3322–3326.https://doi.org/10.21437/Interspeech.2019-2851
Rai BK, (2019). “Advanced Deep Learning with R: Become an expert at designing, building, and improving advanced neural network models using R”, Packt Publishing, ASIN: B07ZFN5MXN. Retrieved May 17, 2022, from https://raw.githubusercontent.com/bkrai/DeepLearningR/master/ImageRecognitionAndClassificationWithR