Flower Recognition
Yevonnael Andrew
4/11/2020
Introduction
This analysis is wanted to recognize flower images. The dataset is obtained from Kaggle https://www.kaggle.com/alxmamaev/flowers-recognition
“The pictures are divided into five classes: chamomile, tulip, rose, sunflower, dandelion. For each class there are about 800 photos. Photos are not high resolution, about 320x240 pixels. Photos are not reduced to a single size, they have different proportions.”
## Linking to ImageMagick 6.9.9.14
## Enabled features: cairo, freetype, fftw, ghostscript, lcms, pango, rsvg, webp
## Disabled features: fontconfig, x11## -- Attaching packages ----------------------------------------------------------------------------- tidyverse 1.3.0 --## v ggplot2 3.3.0 v purrr 0.3.3
## v tibble 3.0.0 v dplyr 0.8.5
## v tidyr 1.0.2 v stringr 1.4.0
## v readr 1.3.1 v forcats 0.5.0## -- Conflicts -------------------------------------------------------------------------------- tidyverse_conflicts() --
## x dplyr::explain() masks lime::explain()
## x dplyr::filter() masks stats::filter()
## x dplyr::lag() masks stats::lag()Define Parameter
I will define parametes in the beginning. Just to make it simpler and easier in the next step.
flower_list <- c("Tulip", "Sunflower", "Rose", "Dandelion", "Daisy")
output_n <- length(flower_list)# to scale the read image
img_width <- 64
img_height <- 64
target_size <- c(img_width, img_height)
channels <- 3
# define directory which contain both train and test set
train_path <- "/Users/Yevonnael Andrew/Documents/Data Science Material/Flower Recognition/flowers/train"
test_path <- "/Users/Yevonnael Andrew/Documents/Data Science Material/Flower Recognition/flowers/test"Loading Image
In this step, we will scale the pixe values and we did not augmenting the data.
train_data <- image_data_generator(
rescale = 1/255
)
test_data <- image_data_generator(
rescale = 1/255
)Next, by using the flow_images_from_directory, I will load the images from the defined directory before and load them into memory and resizing them.
train_array <- flow_images_from_directory(train_path,
train_data,
target_size = target_size,
class_mode = "categorical",
classes = flower_list,
seed = 42
)
test_array <- flow_images_from_directory(test_path,
train_data,
target_size = target_size,
class_mode = "categorical",
classes = flower_list,
seed = 42
)##
## 0 1 2 3 4
## 884 654 696 942 692## $Tulip
## [1] 0
##
## $Sunflower
## [1] 1
##
## $Rose
## [1] 2
##
## $Dandelion
## [1] 3
##
## $Daisy
## [1] 4Define Model
# number of train samples
train_samples <- train_array$n
# number of test samples
test_samples <- test_array$nModel used: simple sequential convolutional neural net with the following hidden layers: 2 convolutional layers, one pooling layer and one dense layer.
First, we will initialise the model.
Then we will add layers.
model %>%
layer_conv_2d(filter = 32, kernel_size = c(3,3), padding = "same", input_shape = c(img_width, img_height, channels)) %>%
layer_activation("relu") %>%
# Second hidden layer
layer_conv_2d(filter = 16, kernel_size = c(3,3), padding = "same") %>%
layer_activation_leaky_relu(0.5) %>%
layer_batch_normalization() %>%
# Use max pooling
layer_max_pooling_2d(pool_size = c(2,2)) %>%
layer_dropout(0.25) %>%
# Flatten max filtered output into feature vector
# and feed into dense layer
layer_flatten() %>%
layer_dense(100) %>%
layer_activation("relu") %>%
layer_dropout(0.5) %>%
# Outputs from dense layer are projected onto output layer
layer_dense(output_n) %>%
layer_activation("softmax")model %>% compile(
loss = "categorical_crossentropy",
optimizer = optimizer_rmsprop(lr = 0.0001, decay = 1e-6),
metrics = "accuracy"
)Here I will use fit_generator to train the model.
hist <- model %>% fit_generator(
train_array,
steps_per_epoch = as.integer(train_samples / batch_size),
epochs = epochs,
validation_data = test_array,
validation_steps = as.integer(test_samples / batch_size),
verbose = 2,
callbacks = list(
# save best model after every epoch
callback_model_checkpoint("fruits_checkpoints.h5", save_best_only = TRUE)
)
)## `geom_smooth()` using formula 'y ~ x'
By looking the graph, we can conclude that the model created is accurate enough.
## Model
## Model: "sequential"
## ________________________________________________________________________________
## Layer (type) Output Shape Param #
## ================================================================================
## conv2d (Conv2D) (None, 64, 64, 32) 896
## ________________________________________________________________________________
## activation (Activation) (None, 64, 64, 32) 0
## ________________________________________________________________________________
## conv2d_1 (Conv2D) (None, 64, 64, 16) 4624
## ________________________________________________________________________________
## leaky_re_lu (LeakyReLU) (None, 64, 64, 16) 0
## ________________________________________________________________________________
## batch_normalization (BatchNormaliza (None, 64, 64, 16) 64
## ________________________________________________________________________________
## max_pooling2d (MaxPooling2D) (None, 32, 32, 16) 0
## ________________________________________________________________________________
## dropout (Dropout) (None, 32, 32, 16) 0
## ________________________________________________________________________________
## flatten (Flatten) (None, 16384) 0
## ________________________________________________________________________________
## dense (Dense) (None, 100) 1638500
## ________________________________________________________________________________
## activation_1 (Activation) (None, 100) 0
## ________________________________________________________________________________
## dropout_1 (Dropout) (None, 100) 0
## ________________________________________________________________________________
## dense_1 (Dense) (None, 5) 505
## ________________________________________________________________________________
## activation_2 (Activation) (None, 5) 0
## ================================================================================
## Total params: 1,644,589
## Trainable params: 1,644,557
## Non-trainable params: 32
## ________________________________________________________________________________Making Predictions and Explanation.
For this demonstration purpuse, we will take one image for each category to see the prediction.
img_path_1 <- file.path(test_path, "rose", "102501987_3cdb8e5394_n.jpg")
img_path_2 <- file.path(test_path, "daisy", "100080576_f52e8ee070_n.jpg")
img_path_3 <- file.path(test_path, "dandelion", "10919961_0af657c4e8.jpg")
img_path_4 <- file.path(test_path, "sunflower", "1064662314_c5a7891b9f_m.jpg")
img_path_5 <- file.path(test_path, "tulip", "110147301_ad921e2828.jpg")Loading Previous Saved Model
Superpixels
I will plot the superpixels using lime package, here is the explanation of the plot_superpixels from https://www.rdocumentation.org/packages/lime/versions/0.5.1/topics/plot_superpixels
“The segmentation of an image into superpixels are an important step in generating explanations for image models. It is both important that the segmentation is correct and follows meaningful patterns in the picture, but also that the size/number of superpixels are appropriate. If the important features in the image are chopped into too many segments the permutations will probably damage the picture beyond recognition in almost all cases leading to a poor or failing explanation model. As the size of the object of interest is varying it is impossible to set up hard rules for the number of superpixels to segment into - the larger the object is relative to the size of the image, the fewer superpixels should be generated.”
Image Preparation
In this step, I will prepare images for the prediction and for the explanation example.
test_datagen <- image_data_generator(rescale = 1/255)
test_generator <- flow_images_from_directory(
test_path,
test_datagen,
target_size = c(64, 64),
class_mode = 'categorical')
predictions <- as.data.frame(predict_generator(model, test_generator, steps = 1))
flower_indices_df <- data.frame(indices = unlist(flower_indices))
#flower_indices_df <- flower_indices_df[order(flower_indices_df$indices), , drop = FALSE]
colnames(predictions) <- rownames(flower_indices_df)
t(round(predictions, digits = 2))## [,1] [,2] [,3] [,4] [,5] [,6] [,7] [,8] [,9] [,10] [,11] [,12] [,13]
## Tulip 0.35 0.00 0.06 0.32 0.03 0.14 0.61 0.45 0.19 0.03 0.13 0.36 0.05
## Sunflower 0.05 0.69 0.83 0.16 0.00 0.05 0.02 0.01 0.08 0.06 0.29 0.19 0.82
## Rose 0.22 0.01 0.02 0.22 0.06 0.17 0.29 0.54 0.04 0.10 0.10 0.23 0.02
## Dandelion 0.12 0.27 0.06 0.17 0.77 0.16 0.04 0.00 0.45 0.41 0.31 0.11 0.10
## Daisy 0.25 0.03 0.02 0.13 0.13 0.48 0.05 0.01 0.25 0.39 0.17 0.11 0.02
## [,14] [,15] [,16] [,17] [,18] [,19] [,20] [,21] [,22] [,23] [,24]
## Tulip 0.23 0.66 0.11 0.16 0.13 0.19 0.03 0.31 0.04 0.07 0.94
## Sunflower 0.01 0.00 0.42 0.13 0.10 0.16 0.09 0.01 0.02 0.82 0.00
## Rose 0.53 0.34 0.05 0.14 0.29 0.23 0.16 0.50 0.02 0.03 0.06
## Dandelion 0.03 0.00 0.36 0.30 0.25 0.18 0.73 0.06 0.47 0.07 0.00
## Daisy 0.20 0.00 0.07 0.26 0.24 0.23 0.00 0.11 0.44 0.01 0.00
## [,25] [,26] [,27] [,28] [,29] [,30] [,31] [,32]
## Tulip 0.08 0.30 0.16 0.43 0.06 0.30 0.52 0.03
## Sunflower 0.12 0.00 0.14 0.20 0.02 0.13 0.01 0.01
## Rose 0.28 0.69 0.28 0.28 0.03 0.27 0.46 0.01
## Dandelion 0.26 0.00 0.21 0.05 0.61 0.18 0.01 0.62
## Daisy 0.25 0.00 0.21 0.04 0.27 0.12 0.01 0.33image_prep <- function(x) {
arrays <- lapply(x, function(path) {
img <- image_load(path, target_size = c(64, 64))
x <- image_to_array(img)
x <- reticulate::array_reshape(x, c(1, dim(x)))
x <- x / 255
})
do.call(abind::abind, c(arrays, list(along = 1)))
}flower_indices_list <- rownames(flower_indices_df)
names(flower_indices_list) <- unlist(flower_indices)
flower_indices_list## 0 1 2 3 4
## "Tulip" "Sunflower" "Rose" "Dandelion" "Daisy"In this chunk, we will train the explainer.
explainer <- lime(c(img_path_1, img_path_2, img_path_3, img_path_4, img_path_5),
as_classifier(model, flower_indices_list), image_prep)I will choose top 1 class and use 35 features.
explanation <- lime::explain(c(img_path_1, img_path_2, img_path_3, img_path_4, img_path_5),
explainer,
n_labels = 1,
n_features = 35,
n_superpixels = 50,
weight = 10
)explanation %>%
ggplot(aes(x = feature_weight)) +
facet_wrap(~case, scales = "free") + geom_density()
exp <- as.data.frame(explanation)
plot <- exp[exp$case == "100080576_f52e8ee070_n.jpg",]
plot_image_explanation((plot))
