{"cells":[{"metadata":{},"cell_type":"markdown","source":"Loading the packages"},{"metadata":{"_uuid":"051d70d956493feee0c6d64651c6a088724dca2a","_execution_state":"idle","trusted":true},"cell_type":"code","source":"library(knitr)\nlibrary(tidyverse) # Collection of all the good stuff like dplyr, ggplot2 ect.\nlibrary(magrittr)\nlibrary(data.table)\nlibrary(rjson)\nlibrary(jsonlite)\nlibrary(qdapTools)\nlibrary(purrr)\nlibrary(keras)\nlibrary(float)\nlibrary(ggplot2)\nlibrary(corrplot)\nlibrary(quantmod)\nlibrary(keras)\nlibrary(mltools)\nlibrary(onehot)\nlibrary(splitstackshape)\nlibrary(tensorflow)\nSys.setenv(RETICULATE_PYTHON=\"/usr/local/share/.virtualenvs/r-reticulate/bin/\") # Only necessary in kaggle currently","execution_count":null,"outputs":[]},{"metadata":{},"cell_type":"markdown","source":"We will load the images, labels for the images and the sample_submission which is the image that will be the test after getting the models.\nWe can see a head of what image is defined on what desease. What desease is categorised to what number you can see at the below code "},{"metadata":{"trusted":true},"cell_type":"code","source":"image_path<-'/kaggle/input/cassava-leaf-disease-classification//train_images'\nsample_submission <- read_csv(\"/kaggle/input/cassava-leaf-disease-classification/sample_submission.csv\")\nlabels <- fread('../input/cassava-leaf-disease-classification/train.csv',data.table=F)\n#test_labels = read_csv('')\nhead(labels)","execution_count":null,"outputs":[]},{"metadata":{},"cell_type":"markdown","source":"Here we categorize the labels as different deseases."},{"metadata":{"trusted":true},"cell_type":"code","source":"Y1H <- labels[,\"label\"] %>% factor() %>% keras::to_categorical()\nlabels = cbind(labels, Y1H)\ncolnames(labels)[3:7] <- c('CBB', 'CBSD', 'CGM', 'CMD', 'Healthy')\nhead(labels)","execution_count":null,"outputs":[]},{"metadata":{},"cell_type":"markdown","source":"We only have one dataset and then one image that will be the test. But we have to split the trainingset to a training- and testset. Afterwards we can see the first three images and what they are labeled to "},{"metadata":{"trusted":true},"cell_type":"code","source":"Y_tr <- labels[1:15000,]\nY_te <- labels[15001:21000,]\n\nhead(Y_tr, n = 3)","execution_count":null,"outputs":[]},{"metadata":{},"cell_type":"markdown","source":"Here we defines the variables for the whole file for the models"},{"metadata":{"trusted":true},"cell_type":"code","source":"w = 224\nh = 224\nbs = 32\nfactor = .4\nreduceFrom = 2\nearly_stop = 4\nb1 = .9\nb2 = .999\nleRa = 0.001\nclip = 5\neps = 20\nlabSm = .0011\nchannels=3\ntarget_size = c(w,h)","execution_count":null,"outputs":[]},{"metadata":{},"cell_type":"markdown","source":"Lets see three of the images in a table which will have a chance of 1-0.0011 chance of being the label"},{"metadata":{"trusted":true},"cell_type":"code","source":"for(i in 3:7){\n    Y_tr[,i] <- ifelse(Y_tr[,i] == 0,labSm,(1-labSm))\n}\n\nhead(Y_tr, n = 3)","execution_count":null,"outputs":[]},{"metadata":{"trusted":true},"cell_type":"code","source":"labels_plot<-labels %>% group_by(label) %>% count()\nlabels_plot","execution_count":null,"outputs":[]},{"metadata":{},"cell_type":"markdown","source":"Here we load the images from the directory. The function turns the imagefiles on disk into batches of preprocessed tensors. We rescale all the images by 1/255. We convert it to floating-point tensors and rescale the pixelvalue to [0,1] interval because neural networks prefer to deal with small input values. We do it for both training-, validation- and testing-dataset. See the comments for more information."},{"metadata":{"trusted":true},"cell_type":"code","source":"#optional data augmentation\ntrain_gen = image_data_generator(\n  rescale = 1/255, #Rescale the images\n  shear_range = 0.2, #Randomly applying shearing transformations\n  zoom_range = 0.2, #Randomly zooming inside pictures\n  horizontal_flip = TRUE, #Flipping randomly half the images horizontally - Here it is relevant when there is no assumptions of horizontal asymmetry\n  fill_mode = \"nearest\", #The strategy used for filling in  newly created pixels which can appear after a rotation or a width/height shift\n  rotation_range = 40, #Value in degrees (0-180) which will randomly rotate pictures \n  width_shift_range = 0.2, #A fraction  of total width or height which will randomly translate pictures vertically or horizontally\n  height_shift_range = 0.2\n \n)\n\n# Validation data shouldn't be augmented! But it should also be scaled.\nvalidation_gen <- image_data_generator(\n  rescale = 1/255\n  )  \n\ntest_gen <- image_data_generator(\n  rescale = 1/255\n  )","execution_count":null,"outputs":[]},{"metadata":{},"cell_type":"markdown","source":"Takes the dataframe and the path to a directory and generates batches of augmented/normalized data"},{"metadata":{"trusted":true},"cell_type":"code","source":"train_generator <- flow_images_from_dataframe(dataframe = Y_tr, #Takes the trainingset of the labels\n                                              directory = image_path, #Imports the images for different labels\n                                              generator = train_gen, #To use the normalizing/augmentation image data\n                                              class_mode = \"other\", #Array of y_col data\n                                              x_col = \"image_id\",\n                                              y_col = c(\"CBB\",\"CBSD\", \"CGM\", \"CMD\", \"Healthy\"), #List of the columns in the datafram that has the target data\n                                              target_size = c(w,h), #Resizes all the images to 224,224 in height and width\n                                              batch_size = bs,\n                                              shuffle = TRUE,\n                                              drop_duplicates = FALSE,\n                                              interpolation = \"nearest\" #Used to resample the image if the target is different from that of the loaded image\n                                             )\n\n\nvalidation_generator<-flow_images_from_dataframe(dataframe = Y_te, \n                                              directory = image_path,\n                                              generator= validation_gen,\n                                              class_mode = \"other\",\n                                              x_col = \"image_id\",\n                                              y_col = c(\"CBB\",\"CBSD\", \"CGM\", \"CMD\", \"Healthy\"),\n                                              target_size = c(w,h),\n                                              batch_size = bs,\n                                              shuffle = FALSE,\n                                              drop_duplicates = FALSE,\n                                              interpolation = \"nearest\"\n                                              \n                                                  )\n#This is not used anywhere and it is the same as the final generator\ntest_generator <- flow_images_from_dataframe(dataframe = sample_submission, \n                                         directory = '../input/cassava-leaf-\ndisease-classification/test_images',\n                                         class_mode = NULL,\n                                         x_col = \"image_id\",\n                                         y_col = NULL,\n                                         target_size = c(w, h),\n                                         shuffle = FALSE,\n                                         batch_size=1,\n                                         generator = test_gen\n                                         )\nfinal_generator <- flow_images_from_dataframe(dataframe = sample_submission, \n                                         directory = '../input/cassava-leaf-disease-classification/test_images',\n                                         class_mode = NULL,\n                                         x_col = \"image_id\",\n                                         y_col = NULL,\n                                         target_size = c(w, h),\n                                         shuffle = FALSE,\n                                         batch_size=1,\n                                         generator = test_gen\n                                         )","execution_count":null,"outputs":[]},{"metadata":{},"cell_type":"markdown","source":"Defining the callbacks which will automate some tasks after every epoch which will controle the proces after every epoch"},{"metadata":{"trusted":true},"cell_type":"code","source":"reduce_lr <- callback_reduce_lr_on_plateau(factor = factor, patience = reduceFrom, verbose = 0, mode = \"auto\", monitor = \"val_accuracy\") #Benefit from reducing the learning rate by a factor once the learning rate stagnates. \n#If there is no improvement for a patience number of epochs the learning rate is reduced\nstop <- callback_early_stopping(monitor = 'val_accuracy', patience = early_stop) #Will stop if there is no improvements after some epochs\ncheck_point <- callback_model_checkpoint(\"model4.h5\", save_best_only = TRUE, verbose = 0, mode = \"auto\") #Saves the model after every epoch","execution_count":null,"outputs":[]},{"metadata":{},"cell_type":"markdown","source":"Transfer learning  with vgg19 pretrained model"},{"metadata":{},"cell_type":"markdown","source":"In transfer learning we include pretrained models to our own model. These models are pretrained on predefined data and may improve our model"},{"metadata":{"trusted":true},"cell_type":"code","source":"base_model_vgg16 <- application_vgg16(\n  include_top = FALSE,\n  weights='imagenet',\n  input_shape = c(w,h,channels))\nbase_model_vgg19 <- application_vgg19(\n  include_top = FALSE,\n  weights='imagenet',\n  input_shape = c(w,h,channels))","execution_count":null,"outputs":[]},{"metadata":{"trusted":true},"cell_type":"code","source":"model_vgg16 <-keras_model_sequential() %>%\n  base_model_vgg16 %>% #The add of the pretrained model\n  layer_global_max_pooling_2d() %>% \n  layer_dropout(rate=0.5) %>%\n  layer_dense(units = 512,\n              activation = \"relu\") %>%\n  layer_batch_normalization() %>% \n  layer_dropout(rate=0.5) %>%\n  layer_dense(units=5, activation=\"softmax\")\n\nmodel_vgg19<-keras_model_sequential() %>%\n  base_model_vgg19 %>% \n  layer_global_max_pooling_2d() %>% \n  layer_dropout(rate=0.5) %>%\n  layer_dense(units = 512,\n              activation = \"relu\") %>%\n  layer_batch_normalization() %>% \n  layer_dropout(rate=0.5) %>%\n  layer_dense(units=5, activation=\"softmax\")","execution_count":null,"outputs":[]},{"metadata":{},"cell_type":"markdown","source":"Freezing layers"},{"metadata":{},"cell_type":"markdown","source":"The layers in the  vgg19 that has been trained from the models are freezed so it will not be changed with the new data. If we don't do this, the model will update the weights will be modified during training and the model is unimportant. The things that will learn is the layers we have got on the vgg-models you can see above. So we have the models (the vgg16 and vgg19) and use them with other layers on our data"},{"metadata":{"trusted":true},"cell_type":"code","source":"#first: train only the top layers \nfor (layer in base_model_vgg16$layers)\n  layer$trainable <- FALSE\n#first: train only the top layers \nfor (layer in base_model_vgg19$layers)\n  layer$trainable <- FALSE","execution_count":null,"outputs":[]},{"metadata":{},"cell_type":"markdown","source":"Compile"},{"metadata":{},"cell_type":"markdown","source":"Compile the model again with the new trainable models with some new parameters"},{"metadata":{"trusted":true},"cell_type":"code","source":"model_vgg16 %>% compile(\n  loss = loss_categorical_crossentropy,\n  optimizer = optimizer_adamax(beta_1 = b1, #Parameter between 0 and 1\n                               beta_2 = b2, #Parameter between 0 and 1\n                               clipvalue = clip, #The gradients will be clipped when their absolutte value exceeds this value\n                               lr = leRa), #Float of the learning rate\n  metrics = c('accuracy'))\n\nmodel_vgg19 %>% compile(\n  loss = loss_categorical_crossentropy,\n  optimizer = optimizer_adamax(beta_1 = b1,\n                               beta_2 = b2,\n                               clipvalue = clip,\n                               lr = leRa),\n  metrics = c('accuracy'))","execution_count":null,"outputs":[]},{"metadata":{},"cell_type":"markdown","source":"Training VGG-19 model"},{"metadata":{},"cell_type":"markdown","source":"Training the model again but with the base-models attached to them. We will run VGG-19. "},{"metadata":{"trusted":true},"cell_type":"code","source":"set.seed(1397)\nhistory_vgg19 <- model_vgg19 %>%\n              fit_generator(\n              train_generator,\n              steps_per_epoch = dim(Y_tr)[1] %/% bs,\n              validation_data = validation_generator,\n              epochs = eps,\n              verbose = 2,\n              callbacks = c(check_point,\n                            reduce_lr,\n                            stop))","execution_count":null,"outputs":[]},{"metadata":{},"cell_type":"markdown","source":"We can see an accuracy of 63% and 66% on the validation accuracy"},{"metadata":{"trusted":true},"cell_type":"code","source":"model_vgg19 %>% save_model_hdf5(\"Disease_detecter_vgg19.h5\")\nmodel_vgg19 %>% evaluate_generator(validation_generator, steps = 500)\nhistory_vgg19","execution_count":null,"outputs":[]},{"metadata":{},"cell_type":"markdown","source":"Training the model again with trainable layers from 19-22"},{"metadata":{},"cell_type":"markdown","source":"Here we first visualizes the layers from vgg19 and chooses to freeze the first layers and then unfreeze the rest to see if that can improve the model"},{"metadata":{"trusted":true},"cell_type":"code","source":"# let's visualize layer names and layer indices to see how many layers we should freeze:\nlayers <- base_model_vgg19$layers\nfor (i in 1:length(layers))\n  cat(i, layers[[i]]$name, \"\\n\")\n\n# we chose to train the top 2 inblocks, i.e. we will freeze the first layers and unfreeze the rest:\nfor (i in 1:18)\n  layers[[i]]$trainable <- FALSE\nfor (i in 19:length(layers))\n  layers[[i]]$trainable <- TRUE","execution_count":null,"outputs":[]},{"metadata":{},"cell_type":"markdown","source":"Compile the model with freezed layers"},{"metadata":{"trusted":true},"cell_type":"code","source":"model_vgg19 %>% compile(\n  loss = loss_categorical_crossentropy,\n  optimizer = optimizer_adamax(beta_1 = b1,\n                               beta_2 = b2,\n                               clipvalue = clip,\n                               lr = leRa),\n  metrics = c('accuracy'))","execution_count":null,"outputs":[]},{"metadata":{},"cell_type":"markdown","source":"Here we run the model and gets a very high lift in the accuracy to 75% and on validation accuracy we get 74%"},{"metadata":{"trusted":true},"cell_type":"code","source":"set.seed(1347)\nhistory_vgg19_final <- model_vgg19 %>%\n              fit_generator(\n              train_generator,\n              steps_per_epoch = dim(Y_tr)[1] %/% bs,\n              validation_data = validation_generator,\n              epochs = eps,\n              verbose = 2,\n              callbacks = c(check_point,\n                            reduce_lr,\n                            stop))","execution_count":null,"outputs":[]},{"metadata":{"trusted":true},"cell_type":"code","source":"model_vgg19 %>% save_model_hdf5(\"Disease_detecter_vgg19_final.h5\")\nmodel_vgg19 %>% evaluate_generator(validation_generator, steps = 500)\n\nhistory_vgg19_final","execution_count":null,"outputs":[]},{"metadata":{},"cell_type":"markdown","source":"Predictions"},{"metadata":{},"cell_type":"markdown","source":"Prediction on the test data for VGG-19.WE can see that this model has predicted the image correctly by assigning it to the category labeled 4."},{"metadata":{"trusted":true},"cell_type":"code","source":"\nhistory_vgg19_final\n\nnum_test_image <- nrow(sample_submission)\npred_vgg19_final<-model_vgg19 %>% predict_generator(final_generator,steps = num_test_image)\nhead(pred_vgg19_final)\n\nlabel_pred_vgg19_final <- pred_vgg19_final %>% apply(1, function(x) which(x==max(x))-1)\nprediction_vgg19_final <- tibble(image_id = sample_submission$image_id, label = label_pred_vgg19_final)\nhead(prediction_vgg19_final)","execution_count":null,"outputs":[]},{"metadata":{},"cell_type":"markdown","source":"**Training with Cyclical Learning Rates\n\n*This method was proposed by Leslie N. Smith in 2015 in paper   \"Cyclical Learning Rates for Training Neural\".This approach gives us a unique way of changing the learning rate at each iteration(batch) in order to maximise the performance of the training the neural network.This allows us to achieve maximum performance using fewer epochs which also saves time.\n\nThe method described is called “training with Cyclical Learning Rates”. The aim of this methodology is to train the neural network with a learning rate that changes in a cyclic way for each step or mini-batch, instead of a non-cyclic learning rate that is a constant value or maybe changes using a decay on every epoch.\n\nIn training neural networks,one of the most important hyperperameter in determining the performance of the model.Usually learning rate is set intuitively  through trail and error .This technique,instead of monotonically decreasing the learning rate (decay) ,tries to vary the learning rate cyclically between reasonable boundary values.\n\nThis methods improves the classification accuracy by not using fixed values for learning rate .\n\nIn our project we will be applying this method to determine the upper and lower boundaries of \"cyclical learning rate\" and hopefully try to improve the performance of the model.We will apply the code from the blog:thecooldata to our model.\n\nFor cyclical learning rate we need to set specific callback functions.\n*Callback functions is a set of functions applied to different stages of training process.You define callback functions in order to automate some process during the training and to have some control over the training processe.g stopping training when you reach a certain accuracy/loss,saving your model as checkpoint after an iteration,adjusting learning rate etc."},{"metadata":{"trusted":true},"cell_type":"code","source":"#Callback for logging metrics on each iteration\n#we are using R6 package for creating callback functions\n\nLogMetrics <- R6::R6Class(\"LogMetrics\", #this is a R6 function based on kerascallback which will log the accuracy/loss into logMetrics at the end of each batch\n  inherit = KerasCallback,\n  public = list(\n    loss = NULL,\n    acc = NULL,\n    on_batch_end = function(batch, logs=list()) {\n      self$loss <- c(self$loss, logs[[\"loss\"]])\n      self$acc <- c(self$acc, logs[[\"acc\"]])\n    }\n))","execution_count":null,"outputs":[]},{"metadata":{},"cell_type":"markdown","source":"Callbacks for changing the learning rate on each iteration"},{"metadata":{"trusted":true},"cell_type":"code","source":"#callback_lr_init: will set the counter to zero and clear the learning rate history lr_hist and iteration history iter_hist\ncallback_lr_init <- function(logs){\n      iter <<- 0\n      lr_hist <<- c()\n      iter_hist <<- c()\n}\n#callback_lr_set: will set the learning rate according to the l_rate vector for each iteration\ncallback_lr_set <- function(batch, logs){\n      iter <<- iter + 1\n      LR <- l_rate[iter] # if number of iterations > l_rate values, make LR constant to last value\n      if(is.na(LR)) LR <- l_rate[length(l_rate)]\n      k_set_value(model_vgg16$optimizer$lr, LR)\n}\n#callback_lr_log: will log the learning rate value and iteration number at the objects: lr_hist and iter_hist\ncallback_lr_log <- function(batch, logs){\n      lr_hist <<- c(lr_hist, k_get_value(model_vgg16$optimizer$lr))\n      iter_hist <<- c(iter_hist, k_get_value(model_vgg16$optimizer$iterations))\n}","execution_count":null,"outputs":[]},{"metadata":{},"cell_type":"markdown","source":"We will embed the above functions into callback_lambda"},{"metadata":{"trusted":true},"cell_type":"code","source":"callback_lr <- callback_lambda(on_train_begin=callback_lr_init, on_batch_begin=callback_lr_set)\ncallback_logger <- callback_lambda(on_batch_end=callback_lr_log)\ncallback_log_acc_lr <- LogMetrics$new()","execution_count":null,"outputs":[]},{"metadata":{},"cell_type":"markdown","source":"Now in this part we will find the best learning rates for base_leraning rate(lower bound) and max_learning rate (upper_bound)."},{"metadata":{"trusted":true},"cell_type":"code","source":"#setting the learning rate with base_lr of 0.001\nlr0<-0.001\n#setting the learning rate with max_lr of 0.1\nlr_max<-0.1\n\n#n_iteration :\nn<-120 #from 100 to 120\nq<-(lr_max/lr0)^(1/(n-1))\n\n#plotting the no of iteration against learning rate\ni<-1:n\nl_rate<-lr0*(q^i)\nplot(l_rate, type=\"b\", pch=16, cex=0.1, xlab=\"iteration\", ylab=\"learning rate\")","execution_count":null,"outputs":[]},{"metadata":{"trusted":true},"cell_type":"code","source":"#We will put all of the callbacks function in the callback_list object\ncallback_list = list(callback_lr, callback_logger, callback_log_acc_lr)","execution_count":null,"outputs":[]},{"metadata":{},"cell_type":"markdown","source":"Training the model with epoch=2 to find the learning rate boundaries."},{"metadata":{"trusted":true},"cell_type":"code","source":"set.seed(1327)\nhistory_lrfinder <- model_vgg16 %>% \n              fit_generator(\n              train_generator,\n              steps_per_epoch = dim(Y_tr)[1] %/% bs,\n              validation_data = validation_generator,\n              epochs = 2,\n              callbacks = callback_list)","execution_count":null,"outputs":[]},{"metadata":{"trusted":true},"cell_type":"code","source":"plot(history_lrfinder)\nhistory_lrfinder","execution_count":null,"outputs":[]},{"metadata":{},"cell_type":"markdown","source":"Plotting the learning rate against Loss to find the lower boundary and the upper boundary of learning rate.We will look for learning rate where loss starts to decrease and reaches a lowest point before it increases again.\nFrom the plot we have identified base_lr to be 0.001 and max_lr to be 0.02.We will use these two lr boundaries to call upon the cyclical learning rate function down below and then will add this function to our callbacks list and then train the model."},{"metadata":{},"cell_type":"markdown","source":"We need to make it clear that when ran this code previously the code was working well and we got the plots for learning rate against the loss from which we determined the max lr and base lr.Now somehow it is not working and due to time constrain we decided to use previously determine values."},{"metadata":{"trusted":true},"cell_type":"code","source":"#making a dataframe of learning rate and loss values for plotting\ndata <- data.frame(\"Learning_rate\" = history_lrfinder, \"Loss\" = callback_log_acc_lr$loss)\nggplot(data, aes(x=Learning_rate, y=Loss)) + scale_x_log10() + geom_point() +  geom_smooth(span = 0.5)\nlimits<-quantile(data$Loss, probs = c(0.10, 0.80))\nggplot(data, aes(x=Learning_rate, y=Loss)) + scale_x_log10() + \nscale_y_continuous(name=\"Loss\", limits=limits)+ geom_point() +  geom_smooth(span = 0.5)","execution_count":null,"outputs":[]},{"metadata":{},"cell_type":"markdown","source":"In order to do cyclical learning rate we have to define a function called Cyclic_LR which has been translated from Pyhthon to R(https://github.com/bckenstler/CLR/blob/master/clr_callback.py).This function will return a vector with the learning rate value for each iteration. This output vector will be used in the previous defined callback functions."},{"metadata":{"trusted":true},"cell_type":"code","source":"# Class also supports custom scaling functions with function output max value of 1:\n      # > clr_fn <- function(x) 1/x # > clr <- Cyclic_LR(base_lr=0.001, max_lr=0.006, step_size=400, # scale_fn=clr_fn, scale_mode='cycle', num_iterations=20000) # > plot(clr, cex=0.2)\n \n      # # Arguments\n      #   iteration:\n      #       if is a number:\n      #           id of the iteration where: max iteration = epochs * (samples/batch)\n      #       if \"iteration\" is a vector i.e.: iteration=1:10000:\n      #           returns the whole sequence of lr as a vector\n      #   base_lr: initial learning rate which is the\n      #       lower boundary in the cycle.\n      #   max_lr: upper boundary in the cycle. Functionally,\n      #       it defines the cycle amplitude (max_lr - base_lr).\n      #       The lr at any cycle is the sum of base_lr\n      #       and some scaling of the amplitude; therefore \n      #       max_lr may not actually be reached depending on\n      #       scaling function.\n      #   step_size: number of training iterations per\n      #       half cycle. Authors suggest setting step_size\n      #       2-8 x training iterations in epoch.\n      #   mode: one of {triangular, triangular2, exp_range, sinus}.\n      #       Default 'triangular'.\n      #       Values correspond to policies detailed above.\n      #       If scale_fn is not None, this argument is ignored.\n      #   gamma: constant in 'exp_range' scaling function:\n      #       gamma**(cycle iterations)\n      #   scale_fn: Custom scaling policy defined by a single\n      #       argument lambda function, where \n      #       0 <= scale_fn(x) <= 1 for all x >= 0.\n      #       mode paramater is ignored \n      #   scale_mode: {'cycle', 'iterations'}.\n      #       Defines whether scale_fn is evaluated on \n      #       cycle number or cycle iterations (training\n      #       iterations since start of cycle). Default is 'cycle'.\n \n      ########\n\nCyclic_LR1 <- function(iteration= 1:32000, #no of iterations =training images/batch size\n                      base_lr=0.001, \n                      max_lr=0.02,\n                      step_size=2000, #it is always a good method to set stepsize to epoch*2-8 times\n                      mode='triangular', \n                      gamma=1,\n                      scale_fn=NULL, \n                      scale_mode='cycle'){\n    \nif(is.null(scale_fn)==TRUE){\n            if(mode=='triangular'){scale_fn <- function(x) 1; scale_mode <- 'cycle';}\n            if(mode=='triangular2'){scale_fn <- function(x) 1/(2^(x-1)); scale_mode <- 'cycle';}\n            if(mode=='exp_range'){scale_fn <- function(x) gamma^(x); scale_mode <- 'iterations';}\n            if(mode=='sinus'){scale_fn <- function(x) 0.5*(1+sin(x*pi/2)); scale_mode <- 'cycle';}\n            if(mode=='halfcosine'){scale_fn <- function(x) 0.5*(1+cos(x*pi)^2); scale_mode <- 'cycle';}\n      }\n      lr <- list()\n      if(is.vector(iteration)==TRUE){\n            for(iter in iteration){\n                  cycle <- floor(1 + (iter / (2*step_size)))\n                  x2 <- abs(iter/step_size-2 * cycle+1)\n                  if(scale_mode=='cycle') x <- cycle\n                  if(scale_mode=='iterations') x <- iter\n                  lr[[iter]] <- base_lr + (max_lr-base_lr) * max(0,(1-x2))\n                \n scale_fn(x)\n            }\n      }\n\n      lr <- do.call(\"rbind\",lr)\n      return(as.vector(lr))\n}","execution_count":null,"outputs":[]},{"metadata":{},"cell_type":"markdown","source":"We can plot output vector of Cyclic_LR function using the mode =\"traingle\""},{"metadata":{"trusted":true},"cell_type":"code","source":"epochs<-2\nn_iter <- ceiling(epochs * (21397)/bs)\nl_rate <- Cyclic_LR1(iteration=1:n_iter, base_lr=0.005, max_lr=0.04, step_size=floor(n_iter/75),\n                        mode='triangular', gamma=1, scale_fn=NULL, scale_mode='cycle')\nplot(l_rate, type=\"b\", pch=16, xlab=\"iteration\", cex=0.2, ylab=\"learning rate\", col=\"grey50\")","execution_count":null,"outputs":[]},{"metadata":{},"cell_type":"markdown","source":"Now we have finalised the base_lr and max_lr values for Cyclical learning rate and alos the cyclical_LR function,we will train our model using the pretrained model of VGG16 with the traingular  cyclical learning rate .\n\nFirst we will call upon the callback function for Cyclical learning rate\"callback_log_acc_clr\" and then we load the pretrained model"},{"metadata":{"trusted":true},"cell_type":"code","source":"#Callback function for cyclical learning rate\ncallback_log_acc_clr <- LogMetrics$new()","execution_count":null,"outputs":[]},{"metadata":{"trusted":true},"cell_type":"code","source":"#loading the pretrained model\nbase_model_vgg16_lr <- application_vgg16(\n  include_top = FALSE,\n  weights='imagenet',\n  input_shape = c(w,h,channels))","execution_count":null,"outputs":[]},{"metadata":{"trusted":true},"cell_type":"code","source":"#Creating the model\nmodel_lr <- keras_model_sequential() %>%\n  base_model_vgg16_lr %>% \n  layer_global_max_pooling_2d() %>% #downsampling method\n  layer_dropout(rate=0.5) %>% #avoid overfitting\n  layer_dense(units = 512,\n              activation = \"relu\") %>%\n  layer_batch_normalization() %>% #for regularization\n  layer_dropout(rate=0.5) %>%\n  layer_dense(units=5, activation=\"softmax\") #softmax for multiclass classification","execution_count":null,"outputs":[]},{"metadata":{},"cell_type":"markdown","source":"In this part we will only train the top layers of the modeland putting the layer trainable argument to falls."},{"metadata":{"trusted":true},"cell_type":"code","source":"#first: train only the top layers \nfor (layer in base_model_vgg16_lr$layers)\n  layer$trainable <- FALSE","execution_count":null,"outputs":[]},{"metadata":{},"cell_type":"markdown","source":"We are using optimizer as adamax because it is superior to \"adam\" in cases where there is layer embeddings in the model"},{"metadata":{"trusted":true},"cell_type":"code","source":"#compling the model\nmodel_lr %>% compile(\n  loss = loss_categorical_crossentropy,\n  optimizer = optimizer_adamax(beta_1 = b1, #adamax superior to adam where there is embeddings.\n                               beta_2 = b2,\n                               clipvalue = clip,\n                               lr = leRa),\n  metrics = c('accuracy'))","execution_count":null,"outputs":[]},{"metadata":{},"cell_type":"markdown","source":"Training the model with the callback functions that we have specified above for clylical_LR function."},{"metadata":{"trusted":true},"cell_type":"code","source":"set.seed(5678)\nhistory_lr <- model_lr %>% \n              fit_generator(\n              train_generator,\n              steps_per_epoch = dim(Y_tr)[1] %/% bs,\n              validation_data = validation_generator,\n              epochs = eps,\n              verbose = 2,\n              callbacks = list(callback_lr, callback_logger, callback_log_acc_clr))","execution_count":null,"outputs":[]},{"metadata":{},"cell_type":"markdown","source":"Now we will train the model with only the top layers by using the callbacklist which have been specified before.\nWe get an overall accuracy of 64 and a loss of 1.02 which is not  good.We will see if it improves with unfreezing the layers of Vgg16"},{"metadata":{"trusted":true},"cell_type":"code","source":"#saving the model\nmodel_lr %>% save_model_hdf5(\"Disease_detector_lr.h5\")\n#Evaluating the model with the validation data  \nmodel_lr %>% evaluate_generator(validation_generator, steps = 500)\nplot(history_lr)\nhistory_lr","execution_count":null,"outputs":[]},{"metadata":{},"cell_type":"markdown","source":"Now lets train the model by unfreezing the layers from 16-19 "},{"metadata":{"trusted":true},"cell_type":"code","source":"# let's visualize layer names and layer indices to see how many layers we should freeze:\nlayers_lr <- base_model_vgg16_lr$layers\nfor (i in 1:length(layers_lr))\n  cat(i, layers_lr[[i]]$name, \"\\n\")\n\n#After trail and error we have decided on freezing the first 15 layers and and set the rest of the layer to trainable.\nfor (i in 1:15)\n  layers_lr[[i]]$trainable <- FALSE\nfor (i in 16:length(layers_lr))\n  layers_lr[[i]]$trainable <- TRUE","execution_count":null,"outputs":[]},{"metadata":{},"cell_type":"markdown","source":"We will train the model again with trainable layers."},{"metadata":{"trusted":true},"cell_type":"code","source":"set.seed(567)\nhistory_lr_freeze <- model_lr %>% \n              fit_generator(\n              train_generator,\n              steps_per_epoch = dim(Y_tr)[1] %/% bs,\n              validation_data = validation_generator,\n              epochs = eps,\n              verbose = 2,\n              callbacks = list(callback_lr, callback_logger, callback_log_acc_clr))#calling callback function for clyclical_LR ","execution_count":null,"outputs":[]},{"metadata":{},"cell_type":"markdown","source":"Saving and evaluating the model again to see the final results of training with cyclical learning rate method.\nWe see a slight improvement of accuray  from 63% to 64%  and loss improvement from 1.02 down to 1.01.But This approach of determinig the learning rate to train the model rather than fixing the learning rate or using the exponential method of decreasing or increasing the learning ,did not affect the accuracy of the models."},{"metadata":{"trusted":true},"cell_type":"code","source":"model_lr %>% save_model_hdf5(\"Disease_detector_lr_freeze.h5\")\nmodel_lr %>% evaluate_generator(validation_generator, steps = 500)\nhistory_lr_freeze\nplot(history_lr_freeze)","execution_count":null,"outputs":[]},{"metadata":{},"cell_type":"markdown","source":"Now we will see how the model predicts at the test data. It seems that model has pedict the picture as belonging to the category 3 which is wrong .\nSo overall our intention was to using the \"Cyclical Learning Rate\" to improve the accuracy of the model but it didn't resulted in improving the  accuracy  model."},{"metadata":{"trusted":true},"cell_type":"code","source":"num_test_image <- nrow(sample_submission)\npred_lr<-model_lr %>% predict_generator(final_generator,steps = num_test_image)\nhead(pred_lr)\n\nlabel_pred_lr <- pred_lr %>% apply(1, function(x) which(x==max(x))-1)\nprediction_lr <- tibble(image_id = sample_submission$image_id, label = label_pred_lr)\nhead(prediction_lr)","execution_count":null,"outputs":[]},{"metadata":{"trusted":true},"cell_type":"code","source":"\nhistory_vgg19\nhistory_vgg19_final\nhistory_lrfinder\nhistory_lr\nhistory_lr_freeze","execution_count":null,"outputs":[]}],"metadata":{"kernelspec":{"name":"ir","display_name":"R","language":"R"},"language_info":{"name":"R","codemirror_mode":"r","pygments_lexer":"r","mimetype":"text/x-r-source","file_extension":".r","version":"3.6.3"}},"nbformat":4,"nbformat_minor":4}