---
title: "XceptionNet 🌿 Leaf Disease"
output:
html_document:
number_sections: false
fig_caption: true
toc: false
theme: paper
highlight: tango
code_folding: show
---
```{r setup, include=FALSE}
knitr::opts_chunk$set(echo = TRUE)
```
```{r libs, message=FALSE, warning=FALSE, results='hide', include = FALSE, echo = FALSE}
library(data.table)
library(keras)
library(dplyr)
library(abind)
library(ggplot2)
library(gridExtra)
library(readxl)
#library(tensorflow)
options(warn=-1)
```
In this competition, Kaggle introduces a dataset of 21,367 labeled images collected during a regular survey in Uganda. Most images were crowdsourced from farmers taking photos of their gardens, and annotated by experts at the National Crops Resources Research Institute (NaCRRI) in collaboration with the AI lab at Makerere University, Kampala. This is in a format that most realistically represents what farmers would need to diagnose in real life.
In the previous versions, I tried to train a model from scratch. However, there are too many inconsistencies. Therefore, it is recommended to use pre-trained models. Then I froze the weights of the pre-trained model part and trained only the additional weights at first, and then unfroze the whole model and affected all the weights. The latest version directly trains the entire pre-trained model, but with larger image size and smaller batch size
Xception stands for Extreme-Inception. With a modified depthwise separable convolution, it performs often better than Inception-v3.
Image from: https://towardsdatascience.com/review-xception-with-depthwise-separable-convolution-better-than-inception-v3-image-dc967dd42568
Bi Tempered Logistic Loss from kernel: https://www.kaggle.com/wineplanetary/bi-tempered-and-taylor-logistic-loss-for-keras-tf
Let´s start.
Setting the parameters:
```{r params, message=FALSE, warning=FALSE, results='hide'}
w = 350
h = 350
bs = 15
factor = .4
reduceFrom = 2
early_stop = 4
b1 = .89
b2 = .99
leRa = 0.0025
clip = 4
eps = 20
labSm = .1
T1 = 0.2
T2 = 1.6
overUnderSample = list('0'=1.075, '1'=1.05, '2'=1.025, '3'=.95, '4'=1.025)
```
Image Generators
```{r generators, message=FALSE, warning=FALSE, results='hide'}
newImgs <- image_data_generator(
width_shift_range = 0.1,
height_shift_range = 0.1,
zoom_range = 0.1,
rotation_range = 25,
channel_shift_range = 5,
brightness_range = c(.9, 1.1),
shear_range = 15/180 * pi,
fill_mode = "reflect",
horizontal_flip = TRUE,
vertical_flip = TRUE,
rescale = 1/255
)
TestGenerator <- image_data_generator(
rescale = 1/255
)
```
Reading the data
```{r read, message=FALSE, warning=FALSE, results='hide'}
Y = fread("../input/cassava-leaf-disease-classification/train.csv", data.table = F)
Y1H <- Y[,"label"] %>% factor() %>% keras::to_categorical()
Y = cbind(Y, Y1H)
colnames(Y)[3:7] <- c('CBB', 'CBSD', 'CGM', 'CMD', 'Healthy')
```
Drop non-leaf images
```{r ruebenbilder, message=FALSE, warning=FALSE, results='hide'}
noLeaf <- readxl::read_xlsx("../input/testmodel/RuebenBilder.xlsx", col_types = "text")
noLeaf <- paste(unique(noLeaf$image_id), ".jpg", sep = "")
Y <- Y %>% filter(!Y$image_id %in% noLeaf)
```
# {.tabset .tabset-fade}
## Visualization
Augmented Images:
```{r pathset, message=FALSE, warning=FALSE, results='hide', echo = FALSE}
path <- "../input/cassava-leaf-disease-classification/train_images"
```
```{r imgs, message=FALSE, warning=FALSE, results='hide', echo = FALSE}
IMG <- function(VizImgPath, h, w){
VizImg <- image_load(path = VizImgPath, target_size = c(w, h))
VizImg <- image_to_array(img = VizImg)
VizImg <- VizImg %>%
array_reshape(c(1, w, h, 3))#shape: (samples, rows, cols, channels) if data_format='channels_last'
}
```
```{r apendReshape, message=FALSE, warning=FALSE, results='hide', echo = FALSE}
imgs <- list.files(path)[11:20]
for(i in 1:length(imgs)){
if(i == 1){
imgDF <- IMG(paste(path, "/", imgs[i], sep =""), w, h)
}else{
imgDF <- abind(imgDF,
IMG(paste(path, "/", imgs[i], sep =""), w, h),
along = 1)
}
}
dim(imgDF)
```
```{r viz, message=FALSE, warning=FALSE, results='hide', echo = FALSE}
Viz_Flow <-
flow_images_from_data(
imgDF,
generator = newImgs,
batch_size = 10
)
```
```{r vizApl, message=FALSE, warning=FALSE, results='hide', fig.width=10, fig.height=10, echo = FALSE}
options(repr.plot.width = 20,
repr.plot.height = 20)
par(mfrow=c(3,3))
for(i in 1:(3*3)){
r = as.integer(runif(1, 1, 10))
plot(as.raster(generator_next(Viz_Flow)[r,,,]))
}
```
```{r hidden, message=FALSE, warning=FALSE, results='hide', include = FALSE, echo = FALSE}
rm(imgDF); invisible(gc())
```
## Training & Validation
To save time, we use just a small part of the dataset
```{r Ytrain, message=FALSE, warning=FALSE, results='hide'}
z = runif(nrow(Y), 0, 1)
Y_tr <- Y[z <= .3,]
Y_te <- Y[z > .3 & z <= .5,]
head(Y_tr, n = 3)
```
Label Smoothing:
Also possible with tf$losses$CategoricalCrossentropy(label_smoothing = labSm). However accuracy is not evaluated in the metrics.
```{r Ys, message=FALSE, warning=FALSE, results='hide'}
for(i in 3:7){
Y_tr[,i] <- ifelse(Y_tr[,i] == 0, labSm, (1-labSm))
}
head(Y_tr, n = 3)
```
Creating the flows from the folder using a data frame.
```{r flowsTrainTest, message=FALSE, warning=FALSE, results='hide'}
flow_train <- flow_images_from_dataframe(dataframe = Y_tr,
directory = path,
x_col = "image_id",
class_mode = "other",
y_col = c('CBB', 'CBSD', 'CGM', 'CMD', 'Healthy'),
target_size = c(w, h),
batch_size = bs,
generator = newImgs
)
flow_test <- flow_images_from_dataframe(dataframe = Y_te,
directory = path,
x_col = "image_id",
class_mode = "other",
y_col = c('CBB', 'CBSD', 'CGM', 'CMD', 'Healthy'),
target_size = c(w, h),
batch_size = bs,
generator = TestGenerator
)
```
Callbacks:
```{r callbacks, message=FALSE, warning=FALSE, results='hide'}
reduce_lr <- callback_reduce_lr_on_plateau(factor = factor,
patience = reduceFrom,
verbose = 0,
mode = "auto",
monitor = "val_accuracy")
stop <- callback_early_stopping(monitor = 'val_accuracy',
patience = early_stop)
check_point <- callback_model_checkpoint("model.h5",
save_best_only = TRUE,
verbose = 0,
mode = "auto",
save_weights_only = TRUE)
lr_scheduler = function(epoch, leRa) {
if(epoch %% 10 == 0){
leRa = leRa *1.1
}
return(leRa)
}
lr_shake <- callback_learning_rate_scheduler(lr_scheduler)
```
Modeling
Loading the pretrained model
```{r loadModel, message=FALSE, warning=FALSE, results='hide'}
x <- load_model_hdf5("../input/testmodel/Xavg350.h5", compile = FALSE)
```
Define Bi Tempered Log Loss
```{r Taylor, message=FALSE, warning=FALSE, results='hide'}
log_t <- function(u, t){
epsilon = 1e-7
if(t == 1){
return(k_log(u + epsilon))
}else{
return((u**(1 - t) - 1) / (1 - t))
}
}
BTLL <- function(y_pred, y_true, t1=T1, t2=T2){
y_pred = k_cast(y_pred, dtype="float32")
y_true = k_cast(y_true, dtype="float32")
temp1 = (log_t(y_true + 1e-7, t1) - log_t(y_pred, t1)) * y_true
temp2 = (1 / (2 - t2)) * (k_pow(y_true, 2 - t2) - k_pow(y_pred, 2 - t2))
loss_values = temp1 - temp2
return(k_sum(loss_values, axis = -1))
}
```
Enlarge the Model
```{r modeling, message=FALSE, warning=FALSE, results='hide'}
model <- keras_model_sequential() %>%
x %>%
layer_batch_normalization() %>%
layer_dropout(rate=0.5) %>%
layer_dense(units=5,
activation="sigmoid")
summary(model)
model %>% compile(
loss = BTLL,
optimizer = optimizer_adamax(beta_1 = b1,
beta_2 = b2,
clipvalue = clip,
lr = leRa),
metrics = c('accuracy')
#tf$losses$CategoricalCrossentropy(label_smoothing = .001)
)
```
Fitting with the flows
```{r fitting, message=FALSE, warning=FALSE, results='hide'}
assign(paste("history", 1, sep = ""),
model %>%
fit_generator(
flow_train,
steps_per_epoch = flow_train$n %/% bs,
validation_data = flow_test,
epochs = eps,
verbose = 2,
callbacks = c(check_point,
reduce_lr,
stop,
lr_shake
),
class_weight = overUnderSample
)
)
```
Metrics
Let´s check the metrics
```{r graphs, message=FALSE, warning=FALSE, fig.width=16, fig.height=9, echo = FALSE}
options(repr.plot.width = 16, repr.plot.height = 9)
met <- as.data.frame(unlist(history1$metrics)) %>% rename(value = `unlist(history1$metrics)`)
met$metrics <- gsub("\\d+", "", rownames(met))
met$epochs <- rep(1:(nrow(met)/5), times = 5)
met <- met %>% filter(metrics %in% c("accuracy", "val_accuracy"))
p1 <- ggplot(met, aes(x=epochs, y=value, color=metrics)) +
geom_point(size=5,
shape=16) +
theme_minimal(base_size = 15) +
geom_smooth(method=loess,
aes(fill=metrics),
level = 0.5,
formula = y ~ x
) +
scale_color_manual(values=c("#7b8c59", "#B45E07")) +
scale_fill_manual(values = c("#7b8c59", "#B45E07")) +
ylab("Accuracy")
met <- as.data.frame(unlist(history1$metrics)) %>% rename(value = `unlist(history1$metrics)`)
met$metrics <- gsub("\\d+", "", rownames(met))
met$epochs <- rep(1:(nrow(met)/5), times = 5)
met <- met %>% filter(metrics %in% c("loss", "val_loss"))
p2 <- ggplot(met, aes(x=epochs, y=value, color=metrics)) +
geom_point(size=5,
shape=16) +
theme_minimal(base_size = 15) +
geom_smooth(method=loess,
aes(fill=metrics),
level = 0.5,
formula = y ~ x
) +
scale_color_manual(values=c("#7b8c59", "#B45E07")) +
scale_fill_manual(values = c("#7b8c59", "#B45E07")) +
ylab("Loss")
met <- as.data.frame(unlist(history1$metrics)) %>% rename(value = `unlist(history1$metrics)`)
met$metrics <- gsub("\\d+", "", rownames(met))
met$epochs <- rep(1:(nrow(met)/5), times = 5)
met <- met %>% filter(metrics %in% c("lr"))
p3 <- ggplot(met, aes(x=epochs, y=value, color=metrics)) +
geom_line(size=2,
linetype="dotted",
color="#B45E07") +
theme_minimal(base_size = 15) +
ylab("Learning Rate")
grid.arrange(p1, p3, p2, p3, nrow = 2)
```
How many epochs in the first run?
```{r epochs, message=FALSE, warning=FALSE}
eps1 = ifelse(stop$stopped_epoch > 0, stop$stopped_epoch, eps)
eps1
```
Schedule the final learning rate from the callback
```{r mets, message=FALSE, warning=FALSE, results='hide', echo = FALSE}
change = 1
k=1
for(i in 2:nrow(met)){
if(met$value[i] == met$value[i-1]){
change[i] <- k
}else{
k=i
change[i] <- i
}
}
change = unique(change)
lenChange = length(change)
if(lenChange < 10){
change <- c(change, rep(change[lenChange], times = 10 - lenChange))
}
```
There will never be so many reductions. So it is pretty safe to use such a schedule.
```{r scheduler, message=FALSE, warning=FALSE, results='hide'}
lr_scheduler = function(epoch, lr, chng = change, fctr = factor) {
if (epoch < chng[2]) {
leRa = lr
} else if(epoch >= chng[2] & epoch < chng[3]){
leRa = lr*fctr
} else if(epoch >= chng[3] & epoch < chng[4]){
leRa = lr*fctr**2
} else if(epoch >= chng[4] & epoch < chng[5]){
leRa = lr*fctr**3
} else if(epoch >= chng[5] & epoch < chng[6]){
leRa = lr*fctr**4
} else if(epoch >= chng[6] & epoch < chng[7]){
leRa = lr*fctr**5
} else if(epoch >= chng[7] & epoch < chng[8]){
leRa = lr*fctr**6
} else if(epoch >= chng[8] & epoch < chng[9]){
leRa = lr*fctr**7
} else if(epoch >= chng[9] & epoch < chng[10]){
leRa = lr*fctr**8
} else {
leRa = lr*fctr**9
}
if(epoch %% 10 == 0){
leRa = leRa * 1.1
}
return(leRa)
}
```
```{r graphs2, message=FALSE, warning=FALSE, fig.width=5, fig.height=5, echo = FALSE}
options(repr.plot.width = 14*1, repr.plot.height = 8*1)
epos = seq(from = 1, to = eps, by = 1)
lr_viz = NULL
for (i in 1:eps) {
lr_viz = c(lr_viz, lr_scheduler(epoch = i, lr = leRa))
}
plot(y = lr_viz,
x = epos,
type = "l",
col = "#B45E07",
main = "Scheduled Learning Rate over Epochs",
cex.lab=1.5, cex.axis=1.5,
cex.main=1.5, cex.sub=1.5,
xlab = "Epoch",
ylab = "Learning Rate",
lwd = 3)
grid()
```
## Final Training & Application
Label smoothing
```{r labelSmooth, message=FALSE, warning=FALSE, results='hide'}
head(Y, n = 3)
for(i in 3:7){
Y[,i] <- ifelse(Y[,i] == 0, labSm, (1-labSm))
}
head(Y, n = 3)
```
```{r gc, message=FALSE, warning=FALSE, results='hide', include = FALSE, echo = FALSE}
rm(Y_tr, Y_te, flow_train, flow_test); invisible(gc())
```
```{r cats, message=FALSE, warning=FALSE, results='hide'}
cat(paste("Due to the augmentation, we receive ", round(eps*nrow(Y), digits = 0), " generated images!", sep = ""))
```
Final Flow
```{r flowFinal, message=FALSE, warning=FALSE, results='hide'}
flow_train <- flow_images_from_dataframe(dataframe = Y,
directory = path,
x_col = "image_id",
class_mode = "other",
y_col = c('CBB', 'CBSD', 'CGM', 'CMD', 'Healthy'),
target_size = c(w, h),
batch_size = bs,
generator = newImgs
)
```
Reading in the submission dataset
```{r SamSub, message=FALSE, warning=FALSE, results='hide'}
sample_submission <- fread("../input/cassava-leaf-disease-classification/sample_submission.csv")
sample_submission
flow_final <- flow_images_from_dataframe(dataframe = sample_submission,
directory = "../input/cassava-leaf-disease-classification/test_images",
class_mode = NULL,
x_col = "image_id",
y_col = NULL,
target_size = c(w, h),
shuffle = FALSE,
batch_size=1,
generator = TestGenerator
)
```
Final Model
Creating the Final Model
```{r predict, message=FALSE, warning=FALSE, results='hide'}
xFinal <- load_model_hdf5("../input/testmodel/Xavg350.h5", compile = FALSE)
modelFinal <- keras_model_sequential() %>%
xFinal %>%
layer_batch_normalization() %>%
layer_dropout(rate=0.5) %>%
layer_dense(units=5, activation="sigmoid")
modelFinal %>% compile(
loss = BTLL,
optimizer = optimizer_adamax(beta_1 = b1,
beta_2 = b2,
clipvalue = clip),
metrics = c('accuracy')
#tf$losses$CategoricalCrossentropy(label_smoothing = .001)
)
assign(paste("history", 21, sep = ""),
modelFinal %>%
fit_generator(
flow_train,
steps_per_epoch = dim(Y)[1] %/% bs,
epochs = eps1,
verbose = 2,
callbacks = c(callback_learning_rate_scheduler(lr_scheduler)),
class_weight = overUnderSample
)
)
load_model_weights_hdf5(model, "model.h5")
pred1 <- model %>%
predict_generator(flow_final,
steps = nrow(sample_submission))
pred1
pred2 <- modelFinal %>%
predict_generator(flow_final,
steps = nrow(sample_submission))
pred2
pred <- pred1 * .1 + pred2 * .9
```
Reshaping the predictions
```{r parallel, message=FALSE, warning=FALSE, results='hide', class.source="bg-success"}
library(parallel)
cores = parallel::makeCluster(4)
classInd = function(DF,i){
c <- max(which(DF[i, ] == max(DF[i, ]))) - 1
return(c)
}
classes <- parallel::parSapply(cl = cores,
X = 1:nrow(pred),
FUN = classInd,
DF = pred)
sample_submission$label <- classes
fwrite(sample_submission, "submission.csv")
summary(classes)
```