🥇Quick Draw Doodle Recognition: how to make friends R, C++ and neural networks

Hey Habr!

Last fall, Kaggle hosted the Quick Draw Doodle Recognition competition for classifying hand-drawn pictures, in which, among others, a team of R-students participated in Artem Klevtsov, Philip the Administrator и Andrey Ogurtsov. We will not describe the competition in detail, this has already been done in recent publication.

This time it didn’t work out with medals farming, but a lot of valuable experience was gained, so I would like to tell the community about a number of the most interesting and useful things on Kagle and in everyday work. Among the topics covered: a difficult life without OpenCV, parsing JSONs (these examples consider integrating C++ code into R scripts or packages using rcpp), parameterization of scripts and dockerization of the final solution. All code from the message in a form suitable for running is available in repositories.

The data in this competition is not provided in the form of ready-made images, but in the form of 340 CSV files (one file for each class) containing JSONs with point coordinates. By connecting these points with lines, we get the final image of 256x256 pixels. Also, for each entry, a label is given, whether the picture was correctly recognized by the classifier used at the time the dataset was collected, a two-letter code of the country of residence of the author of the picture, a unique identifier, a timestamp, and a class name that matches the file name. The simplified version of the original data weighs 7.4 GB in the archive and about 20 GB after unpacking, the full data after unpacking takes 240 GB. The organizers guaranteed that both versions reproduce the same drawings, that is, the full version is redundant. In any case, storing 50 million images in graphic files or as arrays was immediately recognized as unprofitable, and we decided to merge all CSV files from the archive train_simplified.zip to the database with subsequent generation of images of the required size "on the fly" for each batch.

As a DBMS, a well-proven MonetDB, namely the implementation for R as a package MonetDBLite. The package includes an embedded version of the database server and allows you to raise the server directly from the R session and work with it there. Creating a database and connecting to it is done with one command:

con <- DBI::dbConnect(drv = MonetDBLite::MonetDBLite(), Sys.getenv("DBDIR"))

We will need to create two tables: one for all data, the other for service information about uploaded files (it will come in handy if something goes wrong and the process has to be resumed after uploading several files):

Creating tables

if (!DBI::dbExistsTable(con, "doodles")) {
  DBI::dbCreateTable(
    con = con,
    name = "doodles",
    fields = c(
      "countrycode" = "char(2)",
      "drawing" = "text",
      "key_id" = "bigint",
      "recognized" = "bool",
      "timestamp" = "timestamp",
      "word" = "text"
    )
  )
}

if (!DBI::dbExistsTable(con, "upload_log")) {
  DBI::dbCreateTable(
    con = con,
    name = "upload_log",
    fields = c(
      "id" = "serial",
      "file_name" = "text UNIQUE",
      "uploaded" = "bool DEFAULT false"
    )
  )
}

The fastest way to load data into the database was to directly copy CSV files using SQL - the command COPY OFFSET 2 INTO tablename FROM path USING DELIMITERS ',','n','"' NULL AS '' BEST EFFORTWhere tablename - table name and path - the path to the file. While working with the archive, it was found that the built-in implementation unzip in R does not work correctly with a number of files from the archive, so we used the system unzip (using the parameter getOption("unzip")).

Function for writing to the database

#' @title Извлечение и загрузка файлов
#'
#' @description
#' Извлечение CSV-файлов из ZIP-архива и загрузка их в базу данных
#'
#' @param con Объект подключения к базе данных (класс `MonetDBEmbeddedConnection`).
#' @param tablename Название таблицы в базе данных.
#' @oaram zipfile Путь к ZIP-архиву.
#' @oaram filename Имя файла внури ZIP-архива.
#' @param preprocess Функция предобработки, которая будет применена извлечённому файлу.
#'   Должна принимать один аргумент `data` (объект `data.table`).
#'
#' @return `TRUE`.
#'
upload_file <- function(con, tablename, zipfile, filename, preprocess = NULL) {
  # Проверка аргументов
  checkmate::assert_class(con, "MonetDBEmbeddedConnection")
  checkmate::assert_string(tablename)
  checkmate::assert_string(filename)
  checkmate::assert_true(DBI::dbExistsTable(con, tablename))
  checkmate::assert_file_exists(zipfile, access = "r", extension = "zip")
  checkmate::assert_function(preprocess, args = c("data"), null.ok = TRUE)

  # Извлечение файла
  path <- file.path(tempdir(), filename)
  unzip(zipfile, files = filename, exdir = tempdir(), 
        junkpaths = TRUE, unzip = getOption("unzip"))
  on.exit(unlink(file.path(path)))

  # Применяем функция предобработки
  if (!is.null(preprocess)) {
    .data <- data.table::fread(file = path)
    .data <- preprocess(data = .data)
    data.table::fwrite(x = .data, file = path, append = FALSE)
    rm(.data)
  }

  # Запрос к БД на импорт CSV
  sql <- sprintf(
    "COPY OFFSET 2 INTO %s FROM '%s' USING DELIMITERS ',','n','"' NULL AS '' BEST EFFORT",
    tablename, path
  )
  # Выполнение запроса к БД
  DBI::dbExecute(con, sql)

  # Добавление записи об успешной загрузке в служебную таблицу
  DBI::dbExecute(con, sprintf("INSERT INTO upload_log(file_name, uploaded) VALUES('%s', true)",
                              filename))

  return(invisible(TRUE))
}

If you need to convert the table before writing to the database, it is enough to pass in the argument preprocess a function that will transform the data.

Code for sequential loading of data into the database:

Writing data to the database

# Список файлов для записи
files <- unzip(zipfile, list = TRUE)$Name

# Список исключений, если часть файлов уже была загружена
to_skip <- DBI::dbGetQuery(con, "SELECT file_name FROM upload_log")[[1L]]
files <- setdiff(files, to_skip)

if (length(files) > 0L) {
  # Запускаем таймер
  tictoc::tic()
  # Прогресс бар
  pb <- txtProgressBar(min = 0L, max = length(files), style = 3)
  for (i in seq_along(files)) {
    upload_file(con = con, tablename = "doodles", 
                zipfile = zipfile, filename = files[i])
    setTxtProgressBar(pb, i)
  }
  close(pb)
  # Останавливаем таймер
  tictoc::toc()
}

# 526.141 sec elapsed - копирование SSD->SSD
# 558.879 sec elapsed - копирование USB->SSD

Data download time may vary depending on the speed characteristics of the drive used. In our case, reading and writing within one SSD or from a flash drive (source file) to an SSD (DB) takes less than 10 minutes.

It takes a few more seconds to create a column with an integer class label and an index column (ORDERED INDEX) with line numbers, according to which observations will be sampled when creating batches:

Create additional columns and index

message("Generate lables")
invisible(DBI::dbExecute(con, "ALTER TABLE doodles ADD label_int int"))
invisible(DBI::dbExecute(con, "UPDATE doodles SET label_int = dense_rank() OVER (ORDER BY word) - 1"))

message("Generate row numbers")
invisible(DBI::dbExecute(con, "ALTER TABLE doodles ADD id serial"))
invisible(DBI::dbExecute(con, "CREATE ORDERED INDEX doodles_id_ord_idx ON doodles(id)"))

To solve the problem of forming a batch on the fly, we needed to achieve the maximum speed of extracting random rows from the table doodles. To do this, we used 3 tricks. The first was to reduce the dimension of the type in which the observation ID is stored. In the original dataset, ID storage requires a type bigint, but the number of observations allows us to fit their identifiers, equal to the ordinal number, into the type int. The search is much faster. The second trick was to use ORDERED INDEX - we came to this decision empirically, going through all the available options. The third was to use parameterized queries. The essence of the method is to execute the command once PREPARE with the subsequent use of a prepared expression when creating a bunch of queries of the same type, but in fact, a win over comparison with a simple SELECT was in the region of statistical error.

The process of pouring data consumes no more than 450 MB of RAM. That is, the described approach allows you to move datasets weighing tens of gigabytes on almost any budget hardware, including some single-board devices, which is pretty cool.

It remains to measure the speed of extracting (random) data and evaluate the scaling when sampling batches of different sizes:

Database Benchmark

library(ggplot2)

set.seed(0)
# Подключение к базе данных
con <- DBI::dbConnect(MonetDBLite::MonetDBLite(), Sys.getenv("DBDIR"))

# Функция для подготовки запроса на стороне сервера
prep_sql <- function(batch_size) {
  sql <- sprintf("PREPARE SELECT id FROM doodles WHERE id IN (%s)",
                 paste(rep("?", batch_size), collapse = ","))
  res <- DBI::dbSendQuery(con, sql)
  return(res)
}

# Функция для извлечения данных
fetch_data <- function(rs, batch_size) {
  ids <- sample(seq_len(n), batch_size)
  res <- DBI::dbFetch(DBI::dbBind(rs, as.list(ids)))
  return(res)
}

# Проведение замера
res_bench <- bench::press(
  batch_size = 2^(4:10),
  {
    rs <- prep_sql(batch_size)
    bench::mark(
      fetch_data(rs, batch_size),
      min_iterations = 50L
    )
  }
)
# Параметры бенчмарка
cols <- c("batch_size", "min", "median", "max", "itr/sec", "total_time", "n_itr")
res_bench[, cols]

#   batch_size      min   median      max `itr/sec` total_time n_itr
#        <dbl> <bch:tm> <bch:tm> <bch:tm>     <dbl>   <bch:tm> <int>
# 1         16   23.6ms  54.02ms  93.43ms     18.8        2.6s    49
# 2         32     38ms  84.83ms 151.55ms     11.4       4.29s    49
# 3         64   63.3ms 175.54ms 248.94ms     5.85       8.54s    50
# 4        128   83.2ms 341.52ms 496.24ms     3.00      16.69s    50
# 5        256  232.8ms 653.21ms 847.44ms     1.58      31.66s    50
# 6        512  784.6ms    1.41s    1.98s     0.740       1.1m    49
# 7       1024  681.7ms    2.72s    4.06s     0.377      2.16m    49

ggplot(res_bench, aes(x = factor(batch_size), y = median, group = 1)) +
  geom_point() +
  geom_line() +
  ylab("median time, s") +
  theme_minimal()

DBI::dbDisconnect(con, shutdown = TRUE)

2. Preparation of batches

The whole batch preparation process consists of the following steps:

Parsing several JSONs containing vectors of strings with point coordinates.
Drawing colored lines based on the coordinates of points on the image of the required size (for example, 256x256 or 128x128).
Converting the resulting images into a tensor.

As part of the competition among Python kernels, the problem was solved mainly by means of OpenCV. One of the simplest and most obvious analogues in R would look like this:

Implementing JSON to Tensor Transformation in R

r_process_json_str <- function(json, line.width = 3, 
                               color = TRUE, scale = 1) {
  # Парсинг JSON
  coords <- jsonlite::fromJSON(json, simplifyMatrix = FALSE)
  tmp <- tempfile()
  # Удаляем временный файл по завершению функции
  on.exit(unlink(tmp))
  png(filename = tmp, width = 256 * scale, height = 256 * scale, pointsize = 1)
  # Пустой график
  plot.new()
  # Размер окна графика
  plot.window(xlim = c(256 * scale, 0), ylim = c(256 * scale, 0))
  # Цвета линий
  cols <- if (color) rainbow(length(coords)) else "#000000"
  for (i in seq_along(coords)) {
    lines(x = coords[[i]][[1]] * scale, y = coords[[i]][[2]] * scale, 
          col = cols[i], lwd = line.width)
  }
  dev.off()
  # Преобразование изображения в 3-х мерный массив
  res <- png::readPNG(tmp)
  return(res)
}

r_process_json_vector <- function(x, ...) {
  res <- lapply(x, r_process_json_str, ...)
  # Объединение 3-х мерных массивов картинок в 4-х мерный в тензор
  res <- do.call(abind::abind, c(res, along = 0))
  return(res)
}

Drawing is performed by standard R tools, saving to a temporary PNG stored in RAM (on Linux, R temporary directories are located in the directory /tmpmounted in RAM). This file is then read in as a 0D array with numbers ranging from 1 to XNUMX. This is important because a more conventional BMP would be read into a raw array with hex color codes.

Let's test the result:

zip_file <- file.path("data", "train_simplified.zip")
csv_file <- "cat.csv"
unzip(zip_file, files = csv_file, exdir = tempdir(), 
      junkpaths = TRUE, unzip = getOption("unzip"))
tmp_data <- data.table::fread(file.path(tempdir(), csv_file), sep = ",", 
                              select = "drawing", nrows = 10000)
arr <- r_process_json_str(tmp_data[4, drawing])
dim(arr)
# [1] 256 256   3
plot(magick::image_read(arr))

The batch itself will be formed as follows:

res <- r_process_json_vector(tmp_data[1:4, drawing], scale = 0.5)
str(res)
 # num [1:4, 1:128, 1:128, 1:3] 1 1 1 1 1 1 1 1 1 1 ...
 # - attr(*, "dimnames")=List of 4
 #  ..$ : NULL
 #  ..$ : NULL
 #  ..$ : NULL
 #  ..$ : NULL

This implementation seemed suboptimal to us, since the formation of large batches takes an indecently long time, and we decided to take advantage of the experience of colleagues by using a powerful library OpenCV. At that time, there was no ready-made package for R (there is none now), so a minimal implementation of the required functionality was written in C ++ with integration into R code using rcpp.

The following packages and libraries were used to solve the problem:

OpenCV for working with images and drawing lines. We used pre-installed system libraries and header files, as well as dynamic linking.
xtensor for working with multidimensional arrays and tensors. We used the header files included in the R-package of the same name. The library allows you to work with multidimensional arrays, both in row major and column major order.
ndjson for parsing JSON. This library is used in xtensor automatically if it is present in the project.
RcppThread for organizing multi-threaded processing of a vector from JSONs. Used the header files provided by this package. From more popular RcppParallel the package, among other things, is distinguished by a built-in interrupt mechanism for the cycle (interrupt).

It is worth noting that xtensor turned out to be just a godsend: besides the fact that it has extensive functionality and high performance, its developers turned out to be quite responsive and promptly and in detail answered questions that arose. With their help, it was possible to implement the transformation of OpenCV matrices into xtensor tensors, as well as a way to combine 3-dimensional image tensors into a 4-dimensional tensor of the correct dimension (actually a batch).

Materials for learning Rcpp, xtensor and RcppThread

https://thecoatlessprofessor.com/programming/unofficial-rcpp-api-documentation

https://docs.opencv.org/4.0.1/d7/dbd/group__imgproc.html

https://xtensor.readthedocs.io/en/latest/

https://xtensor.readthedocs.io/en/latest/file_loading.html#loading-json-data-into-xtensor

https://cran.r-project.org/web/packages/RcppThread/vignettes/RcppThread-vignette.pdf

To compile files using system files and dynamic linking with libraries installed in the system, we used the plugin mechanism implemented in the package rcpp. To automatically find paths and flags, we used the popular linux utility pkg-config.

Rcpp plugin implementation to use the OpenCV library

Rcpp::registerPlugin("opencv", function() {
  # Возможные названия пакета
  pkg_config_name <- c("opencv", "opencv4")
  # Бинарный файл утилиты pkg-config
  pkg_config_bin <- Sys.which("pkg-config")
  # Проврека наличия утилиты в системе
  checkmate::assert_file_exists(pkg_config_bin, access = "x")
  # Проверка наличия файла настроек OpenCV для pkg-config
  check <- sapply(pkg_config_name, 
                  function(pkg) system(paste(pkg_config_bin, pkg)))
  if (all(check != 0)) {
    stop("OpenCV config for the pkg-config not found", call. = FALSE)
  }

  pkg_config_name <- pkg_config_name[check == 0]
  list(env = list(
    PKG_CXXFLAGS = system(paste(pkg_config_bin, "--cflags", pkg_config_name), 
                          intern = TRUE),
    PKG_LIBS = system(paste(pkg_config_bin, "--libs", pkg_config_name), 
                      intern = TRUE)
  ))
})

As a result of the plugin's operation, the following values will be substituted during compilation:

Rcpp:::.plugins$opencv()$env

# $PKG_CXXFLAGS
# [1] "-I/usr/include/opencv"
#
# $PKG_LIBS
# [1] "-lopencv_shape -lopencv_stitching -lopencv_superres -lopencv_videostab -lopencv_aruco -lopencv_bgsegm -lopencv_bioinspired -lopencv_ccalib -lopencv_datasets -lopencv_dpm -lopencv_face -lopencv_freetype -lopencv_fuzzy -lopencv_hdf -lopencv_line_descriptor -lopencv_optflow -lopencv_video -lopencv_plot -lopencv_reg -lopencv_saliency -lopencv_stereo -lopencv_structured_light -lopencv_phase_unwrapping -lopencv_rgbd -lopencv_viz -lopencv_surface_matching -lopencv_text -lopencv_ximgproc -lopencv_calib3d -lopencv_features2d -lopencv_flann -lopencv_xobjdetect -lopencv_objdetect -lopencv_ml -lopencv_xphoto -lopencv_highgui -lopencv_videoio -lopencv_imgcodecs -lopencv_photo -lopencv_imgproc -lopencv_core"

The implementation code for parsing JSON and generating a batch for transfer to the model is given under the spoiler. First, add a local project directory to search for header files (needed for ndjson):

Sys.setenv("PKG_CXXFLAGS" = paste0("-I", normalizePath(file.path("src"))))

Implementing JSON to Tensor Transformation in C++

// [[Rcpp::plugins(cpp14)]]
// [[Rcpp::plugins(opencv)]]
// [[Rcpp::depends(xtensor)]]
// [[Rcpp::depends(RcppThread)]]

#include <xtensor/xjson.hpp>
#include <xtensor/xadapt.hpp>
#include <xtensor/xview.hpp>
#include <xtensor-r/rtensor.hpp>
#include <opencv2/core/core.hpp>
#include <opencv2/highgui/highgui.hpp>
#include <opencv2/imgproc/imgproc.hpp>
#include <Rcpp.h>
#include <RcppThread.h>

// Синонимы для типов
using RcppThread::parallelFor;
using json = nlohmann::json;
using points = xt::xtensor<double,2>;     // Извлечённые из JSON координаты точек
using strokes = std::vector<points>;      // Извлечённые из JSON координаты точек
using xtensor3d = xt::xtensor<double, 3>; // Тензор для хранения матрицы изоображения
using xtensor4d = xt::xtensor<double, 4>; // Тензор для хранения множества изображений
using rtensor3d = xt::rtensor<double, 3>; // Обёртка для экспорта в R
using rtensor4d = xt::rtensor<double, 4>; // Обёртка для экспорта в R

// Статические константы
// Размер изображения в пикселях
const static int SIZE = 256;
// Тип линии
// См. https://en.wikipedia.org/wiki/Pixel_connectivity#2-dimensional
const static int LINE_TYPE = cv::LINE_4;
// Толщина линии в пикселях
const static int LINE_WIDTH = 3;
// Алгоритм ресайза
// https://docs.opencv.org/3.1.0/da/d54/group__imgproc__transform.html#ga5bb5a1fea74ea38e1a5445ca803ff121
const static int RESIZE_TYPE = cv::INTER_LINEAR;

// Шаблон для конвертирования OpenCV-матрицы в тензор
template <typename T, int NCH, typename XT=xt::xtensor<T,3,xt::layout_type::column_major>>
XT to_xt(const cv::Mat_<cv::Vec<T, NCH>>& src) {
  // Размерность целевого тензора
  std::vector<int> shape = {src.rows, src.cols, NCH};
  // Общее количество элементов в массиве
  size_t size = src.total() * NCH;
  // Преобразование cv::Mat в xt::xtensor
  XT res = xt::adapt((T*) src.data, size, xt::no_ownership(), shape);
  return res;
}

// Преобразование JSON в список координат точек
strokes parse_json(const std::string& x) {
  auto j = json::parse(x);
  // Результат парсинга должен быть массивом
  if (!j.is_array()) {
    throw std::runtime_error("'x' must be JSON array.");
  }
  strokes res;
  res.reserve(j.size());
  for (const auto& a: j) {
    // Каждый элемент массива должен быть 2-мерным массивом
    if (!a.is_array() || a.size() != 2) {
      throw std::runtime_error("'x' must include only 2d arrays.");
    }
    // Извлечение вектора точек
    auto p = a.get<points>();
    res.push_back(p);
  }
  return res;
}

// Отрисовка линий
// Цвета HSV
cv::Mat ocv_draw_lines(const strokes& x, bool color = true) {
  // Исходный тип матрицы
  auto stype = color ? CV_8UC3 : CV_8UC1;
  // Итоговый тип матрицы
  auto dtype = color ? CV_32FC3 : CV_32FC1;
  auto bg = color ? cv::Scalar(0, 0, 255) : cv::Scalar(255);
  auto col = color ? cv::Scalar(0, 255, 220) : cv::Scalar(0);
  cv::Mat img = cv::Mat(SIZE, SIZE, stype, bg);
  // Количество линий
  size_t n = x.size();
  for (const auto& s: x) {
    // Количество точек в линии
    size_t n_points = s.shape()[1];
    for (size_t i = 0; i < n_points - 1; ++i) {
      // Точка начала штриха
      cv::Point from(s(0, i), s(1, i));
      // Точка окончания штриха
      cv::Point to(s(0, i + 1), s(1, i + 1));
      // Отрисовка линии
      cv::line(img, from, to, col, LINE_WIDTH, LINE_TYPE);
    }
    if (color) {
      // Меняем цвет линии
      col[0] += 180 / n;
    }
  }
  if (color) {
    // Меняем цветовое представление на RGB
    cv::cvtColor(img, img, cv::COLOR_HSV2RGB);
  }
  // Меняем формат представления на float32 с диапазоном [0, 1]
  img.convertTo(img, dtype, 1 / 255.0);
  return img;
}

// Обработка JSON и получение тензора с данными изображения
xtensor3d process(const std::string& x, double scale = 1.0, bool color = true) {
  auto p = parse_json(x);
  auto img = ocv_draw_lines(p, color);
  if (scale != 1) {
    cv::Mat out;
    cv::resize(img, out, cv::Size(), scale, scale, RESIZE_TYPE);
    cv::swap(img, out);
    out.release();
  }
  xtensor3d arr = color ? to_xt<double,3>(img) : to_xt<double,1>(img);
  return arr;
}

// [[Rcpp::export]]
rtensor3d cpp_process_json_str(const std::string& x, 
                               double scale = 1.0, 
                               bool color = true) {
  xtensor3d res = process(x, scale, color);
  return res;
}

// [[Rcpp::export]]
rtensor4d cpp_process_json_vector(const std::vector<std::string>& x, 
                                  double scale = 1.0, 
                                  bool color = false) {
  size_t n = x.size();
  size_t dim = floor(SIZE * scale);
  size_t channels = color ? 3 : 1;
  xtensor4d res({n, dim, dim, channels});
  parallelFor(0, n, [&x, &res, scale, color](int i) {
    xtensor3d tmp = process(x[i], scale, color);
    auto view = xt::view(res, i, xt::all(), xt::all(), xt::all());
    view = tmp;
  });
  return res;
}

This code should be placed in a file src/cv_xt.cpp and compile with command Rcpp::sourceCpp(file = "src/cv_xt.cpp", env = .GlobalEnv); also required to work nlohmann/json.hpp of repository. The code is divided into several functions:

to_xt is a templated function for transforming the image matrix (cv::Mat) into a tensor xt::xtensor;
parse_json - the function parses a JSON string, extracts the coordinates of points, packing them into a vector;
ocv_draw_lines - from the received vector of points draws multi-colored lines;
process - combines the above functions, and also adds the ability to scale the resulting image;
cpp_process_json_str - a wrapper over a function process, which exports the result to an R-object (multidimensional array);
cpp_process_json_vector - a wrapper over a function cpp_process_json_str, which allows you to process a string vector in multithreaded mode.

To draw multi-colored lines, the HSV color model was used, followed by conversion to RGB. Let's test the result:

arr <- cpp_process_json_str(tmp_data[4, drawing])
dim(arr)
# [1] 256 256   3
plot(magick::image_read(arr))

Speed comparison of R and C++ implementations

res_bench <- bench::mark(
  r_process_json_str(tmp_data[4, drawing], scale = 0.5),
  cpp_process_json_str(tmp_data[4, drawing], scale = 0.5),
  check = FALSE,
  min_iterations = 100
)
# Параметры бенчмарка
cols <- c("expression", "min", "median", "max", "itr/sec", "total_time", "n_itr")
res_bench[, cols]

#   expression                min     median       max `itr/sec` total_time  n_itr
#   <chr>                <bch:tm>   <bch:tm>  <bch:tm>     <dbl>   <bch:tm>  <int>
# 1 r_process_json_str     3.49ms     3.55ms    4.47ms      273.      490ms    134
# 2 cpp_process_json_str   1.94ms     2.02ms    5.32ms      489.      497ms    243

library(ggplot2)
# Проведение замера
res_bench <- bench::press(
  batch_size = 2^(4:10),
  {
    .data <- tmp_data[sample(seq_len(.N), batch_size), drawing]
    bench::mark(
      r_process_json_vector(.data, scale = 0.5),
      cpp_process_json_vector(.data,  scale = 0.5),
      min_iterations = 50,
      check = FALSE
    )
  }
)

res_bench[, cols]

#    expression   batch_size      min   median      max `itr/sec` total_time n_itr
#    <chr>             <dbl> <bch:tm> <bch:tm> <bch:tm>     <dbl>   <bch:tm> <int>
#  1 r                   16   50.61ms  53.34ms  54.82ms    19.1     471.13ms     9
#  2 cpp                 16    4.46ms   5.39ms   7.78ms   192.      474.09ms    91
#  3 r                   32   105.7ms 109.74ms 212.26ms     7.69        6.5s    50
#  4 cpp                 32    7.76ms  10.97ms  15.23ms    95.6     522.78ms    50
#  5 r                   64  211.41ms 226.18ms 332.65ms     3.85      12.99s    50
#  6 cpp                 64   25.09ms  27.34ms  32.04ms    36.0        1.39s    50
#  7 r                  128   534.5ms 627.92ms 659.08ms     1.61      31.03s    50
#  8 cpp                128   56.37ms  58.46ms  66.03ms    16.9        2.95s    50
#  9 r                  256     1.15s    1.18s    1.29s     0.851     58.78s    50
# 10 cpp                256  114.97ms 117.39ms 130.09ms     8.45       5.92s    50
# 11 r                  512     2.09s    2.15s    2.32s     0.463       1.8m    50
# 12 cpp                512  230.81ms  235.6ms 261.99ms     4.18      11.97s    50
# 13 r                 1024        4s    4.22s     4.4s     0.238       3.5m    50
# 14 cpp               1024  410.48ms 431.43ms 462.44ms     2.33      21.45s    50

ggplot(res_bench, aes(x = factor(batch_size), y = median, 
                      group =  expression, color = expression)) +
  geom_point() +
  geom_line() +
  ylab("median time, s") +
  theme_minimal() +
  scale_color_discrete(name = "", labels = c("cpp", "r")) +
  theme(legend.position = "bottom")

As you can see, the speed increase turned out to be very significant, and it is not possible to catch up with C++ code using R code parallelization.

3. Iterators for unloading batches from the database

R has a well-deserved reputation as a language for processing data that fits in RAM, while Python is more characterized by iterative data processing, which allows you to easily implement out-of-core calculations (calculations using external memory). Classical and relevant for us in the context of the described problem, an example of such calculations are deep neural networks trained by the gradient descent method with gradient approximation at each step using a small portion of observations, or a mini-batch.

Deep learning frameworks written in Python have special classes that implement iterators over data: tables, pictures in folders, binary formats, etc. You can use ready-made options or write your own for specific tasks. In R, we can take advantage of all the features of the Python library hard with its various backends using the package of the same name, which in turn runs on top of the package reticulate. The latter deserves a separate large article; not only does it allow you to run Python code from within R, but it also allows objects to be passed between R and Python sessions, automatically doing all the necessary type conversions.

We got rid of the need to store all the data in RAM by using MonetDBLite, all the “neural network” work will be done by the original Python code, we just have to write an iterator over the data, since neither R nor Python is ready for such a situation. There are essentially only two requirements for it: it must return batches in an infinite loop and save its state between iterations (the latter in R is implemented in the simplest way using closures). Previously, it was required to explicitly convert R arrays to numpy arrays inside the iterator, but the current version of the package hard does it herself.

The iterator for the training and validation data is as follows:

Iterator for training and validation data

train_generator <- function(db_connection = con,
                            samples_index,
                            num_classes = 340,
                            batch_size = 32,
                            scale = 1,
                            color = FALSE,
                            imagenet_preproc = FALSE) {
  # Проверка аргументов
  checkmate::assert_class(con, "DBIConnection")
  checkmate::assert_integerish(samples_index)
  checkmate::assert_count(num_classes)
  checkmate::assert_count(batch_size)
  checkmate::assert_number(scale, lower = 0.001, upper = 5)
  checkmate::assert_flag(color)
  checkmate::assert_flag(imagenet_preproc)

  # Перемешиваем, чтобы брать и удалять использованные индексы батчей по порядку
  dt <- data.table::data.table(id = sample(samples_index))
  # Проставляем номера батчей
  dt[, batch := (.I - 1L) %/% batch_size + 1L]
  # Оставляем только полные батчи и индексируем
  dt <- dt[, if (.N == batch_size) .SD, keyby = batch]
  # Устанавливаем счётчик
  i <- 1
  # Количество батчей
  max_i <- dt[, max(batch)]

  # Подготовка выражения для выгрузки
  sql <- sprintf(
    "PREPARE SELECT drawing, label_int FROM doodles WHERE id IN (%s)",
    paste(rep("?", batch_size), collapse = ",")
  )
  res <- DBI::dbSendQuery(con, sql)

  # Аналог keras::to_categorical
  to_categorical <- function(x, num) {
    n <- length(x)
    m <- numeric(n * num)
    m[x * n + seq_len(n)] <- 1
    dim(m) <- c(n, num)
    return(m)
  }

  # Замыкание
  function() {
    # Начинаем новую эпоху
    if (i > max_i) {
      dt[, id := sample(id)]
      data.table::setkey(dt, batch)
      # Сбрасываем счётчик
      i <<- 1
      max_i <<- dt[, max(batch)]
    }

    # ID для выгрузки данных
    batch_ind <- dt[batch == i, id]
    # Выгрузка данных
    batch <- DBI::dbFetch(DBI::dbBind(res, as.list(batch_ind)), n = -1)

    # Увеличиваем счётчик
    i <<- i + 1

    # Парсинг JSON и подготовка массива
    batch_x <- cpp_process_json_vector(batch$drawing, scale = scale, color = color)
    if (imagenet_preproc) {
      # Шкалирование c интервала [0, 1] на интервал [-1, 1]
      batch_x <- (batch_x - 0.5) * 2
    }

    batch_y <- to_categorical(batch$label_int, num_classes)
    result <- list(batch_x, batch_y)
    return(result)
  }
}

The function takes as input a variable with a database connection, the numbers of rows used, the number of classes, the batch size, the scale (scale = 1 corresponds to drawing pictures of 256x256 pixels, scale = 0.5 - 128x128 pixels), color indicator (color = FALSE specifies rendering in grayscale, when using color = TRUE each stroke is drawn in a new color) and a preprocessing indicator for networks pretrained on imagenet. The latter is needed in order to scale the pixel values from the interval [0, 1] to the interval [-1, 1], which was used when training the supplied hard models.

External function contains argument type checking, table data.table with randomly shuffled line numbers from samples_index and batch numbers, the counter and the maximum number of batches, as well as an SQL expression for unloading data from the database. Additionally, we have defined inside a fast analogue of the function keras::to_categorical(). We used almost all the data for training, leaving half a percent for validation, so the epoch size was limited by the parameter steps_per_epoch when called keras::fit_generator(), and the condition if (i > max_i) only worked for the validation iterator.

In the internal function, row indices are selected for the next batch, records are unloaded from the database with an increase in the batch counter, JSON parsing (function cpp_process_json_vector(), written in C++) and creating arrays corresponding to pictures. Then one-hot vectors with class labels are created, arrays with pixel values and labels are combined into a list, which is the returned value. To speed up work, we used the creation of indexes in tables data.table and modification by reference - without these "chips" of the package data.table it is rather difficult to imagine efficient work with any significant amount of data in R.

The results of measuring the speed of work on a notebook Core i5 are as follows:

Iterator Benchmark

library(Rcpp)
library(keras)
library(ggplot2)

source("utils/rcpp.R")
source("utils/keras_iterator.R")

con <- DBI::dbConnect(drv = MonetDBLite::MonetDBLite(), Sys.getenv("DBDIR"))

ind <- seq_len(DBI::dbGetQuery(con, "SELECT count(*) FROM doodles")[[1L]])
num_classes <- DBI::dbGetQuery(con, "SELECT max(label_int) + 1 FROM doodles")[[1L]]

# Индексы для обучающей выборки
train_ind <- sample(ind, floor(length(ind) * 0.995))
# Индексы для проверочной выборки
val_ind <- ind[-train_ind]
rm(ind)
# Коэффициент масштаба
scale <- 0.5

# Проведение замера
res_bench <- bench::press(
  batch_size = 2^(4:10),
  {
    it1 <- train_generator(
      db_connection = con,
      samples_index = train_ind,
      num_classes = num_classes,
      batch_size = batch_size,
      scale = scale
    )
    bench::mark(
      it1(),
      min_iterations = 50L
    )
  }
)
# Параметры бенчмарка
cols <- c("batch_size", "min", "median", "max", "itr/sec", "total_time", "n_itr")
res_bench[, cols]

#   batch_size      min   median      max `itr/sec` total_time n_itr
#        <dbl> <bch:tm> <bch:tm> <bch:tm>     <dbl>   <bch:tm> <int>
# 1         16     25ms  64.36ms   92.2ms     15.9       3.09s    49
# 2         32   48.4ms 118.13ms 197.24ms     8.17       5.88s    48
# 3         64   69.3ms 117.93ms 181.14ms     8.57       5.83s    50
# 4        128  157.2ms 240.74ms 503.87ms     3.85      12.71s    49
# 5        256  359.3ms 613.52ms 988.73ms     1.54       30.5s    47
# 6        512  884.7ms    1.53s    2.07s     0.674      1.11m    45
# 7       1024     2.7s    3.83s    5.47s     0.261      2.81m    44

ggplot(res_bench, aes(x = factor(batch_size), y = median, group = 1)) +
    geom_point() +
    geom_line() +
    ylab("median time, s") +
    theme_minimal()

DBI::dbDisconnect(con, shutdown = TRUE)

If you have enough RAM, you can seriously speed up the database by moving it to this same RAM (32 GB is enough for our task). On Linux, the partition is mounted by default. /dev/shmoccupies up to half the amount of RAM. You can highlight more by editing /etc/fstabto get a record like tmpfs /dev/shm tmpfs defaults,size=25g 0 0. Be sure to reboot and check the result by running the command df -h.

The test data iterator looks much simpler, since the test dataset fits entirely in RAM:

Iterator for test data

test_generator <- function(dt,
                           batch_size = 32,
                           scale = 1,
                           color = FALSE,
                           imagenet_preproc = FALSE) {

  # Проверка аргументов
  checkmate::assert_data_table(dt)
  checkmate::assert_count(batch_size)
  checkmate::assert_number(scale, lower = 0.001, upper = 5)
  checkmate::assert_flag(color)
  checkmate::assert_flag(imagenet_preproc)

  # Проставляем номера батчей
  dt[, batch := (.I - 1L) %/% batch_size + 1L]
  data.table::setkey(dt, batch)
  i <- 1
  max_i <- dt[, max(batch)]

  # Замыкание
  function() {
    batch_x <- cpp_process_json_vector(dt[batch == i, drawing], 
                                       scale = scale, color = color)
    if (imagenet_preproc) {
      # Шкалирование c интервала [0, 1] на интервал [-1, 1]
      batch_x <- (batch_x - 0.5) * 2
    }
    result <- list(batch_x)
    i <<- i + 1
    return(result)
  }
}

4. Choice of model architecture

The first architecture used was mobile net v1, the features of which are analyzed in This message. It is included in the standard delivery. hard and, accordingly, is available in the package of the same name for R. But when trying to use it with single-channel images, a strange thing turned out: the input tensor must always have the dimension (batch, height, width, 3), that is, the number of channels cannot be changed. There is no such restriction in Python, so we hurried and wrote our own implementation of this architecture, following the original article (without the dropout, which is in the keras version):

mobilenet v1 architecture

library(keras)

top_3_categorical_accuracy <- custom_metric(
    name = "top_3_categorical_accuracy",
    metric_fn = function(y_true, y_pred) {
         metric_top_k_categorical_accuracy(y_true, y_pred, k = 3)
    }
)

layer_sep_conv_bn <- function(object, 
                              filters,
                              alpha = 1,
                              depth_multiplier = 1,
                              strides = c(2, 2)) {

  # NB! depth_multiplier !=  resolution multiplier
  # https://github.com/keras-team/keras/issues/10349

  layer_depthwise_conv_2d(
    object = object,
    kernel_size = c(3, 3), 
    strides = strides,
    padding = "same",
    depth_multiplier = depth_multiplier
  ) %>%
  layer_batch_normalization() %>% 
  layer_activation_relu() %>%
  layer_conv_2d(
    filters = filters * alpha,
    kernel_size = c(1, 1), 
    strides = c(1, 1)
  ) %>%
  layer_batch_normalization() %>% 
  layer_activation_relu() 
}

get_mobilenet_v1 <- function(input_shape = c(224, 224, 1),
                             num_classes = 340,
                             alpha = 1,
                             depth_multiplier = 1,
                             optimizer = optimizer_adam(lr = 0.002),
                             loss = "categorical_crossentropy",
                             metrics = c("categorical_crossentropy",
                                         top_3_categorical_accuracy)) {

  inputs <- layer_input(shape = input_shape)

  outputs <- inputs %>%
    layer_conv_2d(filters = 32, kernel_size = c(3, 3), strides = c(2, 2), padding = "same") %>%
    layer_batch_normalization() %>% 
    layer_activation_relu() %>%
    layer_sep_conv_bn(filters = 64, strides = c(1, 1)) %>%
    layer_sep_conv_bn(filters = 128, strides = c(2, 2)) %>%
    layer_sep_conv_bn(filters = 128, strides = c(1, 1)) %>%
    layer_sep_conv_bn(filters = 256, strides = c(2, 2)) %>%
    layer_sep_conv_bn(filters = 256, strides = c(1, 1)) %>%
    layer_sep_conv_bn(filters = 512, strides = c(2, 2)) %>%
    layer_sep_conv_bn(filters = 512, strides = c(1, 1)) %>%
    layer_sep_conv_bn(filters = 512, strides = c(1, 1)) %>%
    layer_sep_conv_bn(filters = 512, strides = c(1, 1)) %>%
    layer_sep_conv_bn(filters = 512, strides = c(1, 1)) %>%
    layer_sep_conv_bn(filters = 512, strides = c(1, 1)) %>%
    layer_sep_conv_bn(filters = 1024, strides = c(2, 2)) %>%
    layer_sep_conv_bn(filters = 1024, strides = c(1, 1)) %>%
    layer_global_average_pooling_2d() %>%
    layer_dense(units = num_classes) %>%
    layer_activation_softmax()

    model <- keras_model(
      inputs = inputs,
      outputs = outputs
    )

    model %>% compile(
      optimizer = optimizer,
      loss = loss,
      metrics = metrics
    )

    return(model)
}

The disadvantages of this approach are obvious. I want to check a lot of models, but I don’t want to rewrite each architecture manually, on the contrary. Also, we were deprived of the opportunity to use the weights of models previously trained on imagenet. As usual, studying the documentation helped. Function get_config() allows you to get a description of the model in a form suitable for editing (base_model_conf$layers is an ordinary R-list), and the function from_config() performs the reverse transformation to the model object:

base_model_conf <- get_config(base_model)
base_model_conf$layers[[1]]$config$batch_input_shape[[4]] <- 1L
base_model <- from_config(base_model_conf)

Now it's easy to write a universal function to get any of the supplied hard models with or without imagenet-trained weights:

Function for loading ready-made architectures

get_model <- function(name = "mobilenet_v2",
                      input_shape = NULL,
                      weights = "imagenet",
                      pooling = "avg",
                      num_classes = NULL,
                      optimizer = keras::optimizer_adam(lr = 0.002),
                      loss = "categorical_crossentropy",
                      metrics = NULL,
                      color = TRUE,
                      compile = FALSE) {
  # Проверка аргументов
  checkmate::assert_string(name)
  checkmate::assert_integerish(input_shape, lower = 1, upper = 256, len = 3)
  checkmate::assert_count(num_classes)
  checkmate::assert_flag(color)
  checkmate::assert_flag(compile)

  # Получаем объект из пакета keras
  model_fun <- get0(paste0("application_", name), envir = asNamespace("keras"))
  # Проверка наличия объекта в пакете
  if (is.null(model_fun)) {
    stop("Model ", shQuote(name), " not found.", call. = FALSE)
  }

  base_model <- model_fun(
    input_shape = input_shape,
    include_top = FALSE,
    weights = weights,
    pooling = pooling
  )

  # Если изображение не цветное, меняем размерность входа
  if (!color) {
    base_model_conf <- keras::get_config(base_model)
    base_model_conf$layers[[1]]$config$batch_input_shape[[4]] <- 1L
    base_model <- keras::from_config(base_model_conf)
  }

  predictions <- keras::get_layer(base_model, "global_average_pooling2d_1")$output
  predictions <- keras::layer_dense(predictions, units = num_classes, activation = "softmax")
  model <- keras::keras_model(
    inputs = base_model$input,
    outputs = predictions
  )

  if (compile) {
    keras::compile(
      object = model,
      optimizer = optimizer,
      loss = loss,
      metrics = metrics
    )
  }

  return(model)
}

When using single-band images, pre-trained weights are not used. This could be corrected by using the function get_weights() get the weights of the model as a list of R arrays, change the dimension of the first element of this list (by taking one color channel or averaging all three), and then load the weights back into the model with the function set_weights(). We never added this functionality, because at this stage it was already clear that it was more productive to work with color pictures.

We did the bulk of the experiments using mobilenet versions 1 and 2, as well as resnet34. In this competition, more modern architectures such as SE-ResNeXt performed well. Unfortunately, we did not have ready-made implementations at our disposal, and we did not write our own (but we will definitely write).

5. Parameterization of scripts

For convenience, the entire code for starting training was formatted as a single script, parameterized using docpt in the following way:

doc <- '
Usage:
  train_nn.R --help
  train_nn.R --list-models
  train_nn.R [options]

Options:
  -h --help                   Show this message.
  -l --list-models            List available models.
  -m --model=<model>          Neural network model name [default: mobilenet_v2].
  -b --batch-size=<size>      Batch size [default: 32].
  -s --scale-factor=<ratio>   Scale factor [default: 0.5].
  -c --color                  Use color lines [default: FALSE].
  -d --db-dir=<path>          Path to database directory [default: Sys.getenv("db_dir")].
  -r --validate-ratio=<ratio> Validate sample ratio [default: 0.995].
  -n --n-gpu=<number>         Number of GPUs [default: 1].
'
args <- docopt::docopt(doc)

Plastic bag docpt is an implementation http://docopt.org/ for R. With its help, scripts are launched with simple commands of the form Rscript bin/train_nn.R -m resnet50 -c -d /home/andrey/doodle_db or ./bin/train_nn.R -m resnet50 -c -d /home/andrey/doodle_dbif the file train_nn.R is executable (this command will start training the model resnet50 on three-color images of 128x128 pixels, the database must be located in the folder /home/andrey/doodle_db). You can add learning rate, optimizer type, and any other customizable parameters to the list. In the process of preparing the publication, it turned out that the architecture mobilenet_v2 from current version hard in R use must not due to changes not taken into account in the R-package - we wait until they fix it.

This approach allowed us to significantly speed up experiments with different models compared to the more traditional launch of scripts in RStudio (as a possible alternative, we note the package tfruns). But the main advantage is the ability to easily manage the launch of scripts in docker or just on the server without installing RStudio for this.

6. Dockerize scripts

We used docker to provide a portable environment for model training between team members and for live deployment in the cloud. You can start your acquaintance with this relatively unusual tool for an R programmer with this series of publications or video course.

Docker allows you to create your own images from scratch, or use other images as a basis for creating your own. When analyzing the available options, we came to the conclusion that installing NVIDIA drivers, CUDA + cuDNN and Python libraries is a rather voluminous part of the image, and decided to take the official image as a basis tensorflow/tensorflow:1.12.0-gpu, adding the necessary R packages there.

The resulting docker file looks like this:

Dockerfile

FROM tensorflow/tensorflow:1.12.0-gpu

MAINTAINER Artem Klevtsov <[email protected]>

SHELL ["/bin/bash", "-c"]

ARG LOCALE="en_US.UTF-8"
ARG APT_PKG="libopencv-dev r-base r-base-dev littler"
ARG R_BIN_PKG="futile.logger checkmate data.table rcpp rapidjsonr dbi keras jsonlite curl digest remotes"
ARG R_SRC_PKG="xtensor RcppThread docopt MonetDBLite"
ARG PY_PIP_PKG="keras"
ARG DIRS="/db /app /app/data /app/models /app/logs"

RUN source /etc/os-release && 
    echo "deb https://cloud.r-project.org/bin/linux/ubuntu ${UBUNTU_CODENAME}-cran35/" > /etc/apt/sources.list.d/cran35.list && 
    apt-key adv --keyserver keyserver.ubuntu.com --recv-keys E084DAB9 && 
    add-apt-repository -y ppa:marutter/c2d4u3.5 && 
    add-apt-repository -y ppa:timsc/opencv-3.4 && 
    apt-get update && 
    apt-get install -y locales && 
    locale-gen ${LOCALE} && 
    apt-get install -y --no-install-recommends ${APT_PKG} && 
    ln -s /usr/lib/R/site-library/littler/examples/install.r /usr/local/bin/install.r && 
    ln -s /usr/lib/R/site-library/littler/examples/install2.r /usr/local/bin/install2.r && 
    ln -s /usr/lib/R/site-library/littler/examples/installGithub.r /usr/local/bin/installGithub.r && 
    echo 'options(Ncpus = parallel::detectCores())' >> /etc/R/Rprofile.site && 
    echo 'options(repos = c(CRAN = "https://cloud.r-project.org"))' >> /etc/R/Rprofile.site && 
    apt-get install -y $(printf "r-cran-%s " ${R_BIN_PKG}) && 
    install.r ${R_SRC_PKG} && 
    pip install ${PY_PIP_PKG} && 
    mkdir -p ${DIRS} && 
    chmod 777 ${DIRS} && 
    rm -rf /tmp/downloaded_packages/ /tmp/*.rds && 
    rm -rf /var/lib/apt/lists/*

COPY utils /app/utils
COPY src /app/src
COPY tests /app/tests
COPY bin/*.R /app/

ENV DBDIR="/db"
ENV CUDA_HOME="/usr/local/cuda"
ENV PATH="/app:${PATH}"

WORKDIR /app

VOLUME /db
VOLUME /app

CMD bash

For convenience, the packages used have been moved to variables; the main part of the written scripts is copied inside the containers during assembly. We also changed the command shell to /bin/bash for ease of use of content /etc/os-release. This avoided the need to specify the OS version in the code.

Additionally, a small bash script was written that allows you to run a container with various commands. For example, these can be scripts for training neural networks, previously placed inside the container, or a command shell for debugging and monitoring the operation of the container:

Script to run container

#!/bin/sh

DBDIR=${PWD}/db
LOGSDIR=${PWD}/logs
MODELDIR=${PWD}/models
DATADIR=${PWD}/data
ARGS="--runtime=nvidia --rm -v ${DBDIR}:/db -v ${LOGSDIR}:/app/logs -v ${MODELDIR}:/app/models -v ${DATADIR}:/app/data"

if [ -z "$1" ]; then
    CMD="Rscript /app/train_nn.R"
elif [ "$1" = "bash" ]; then
    ARGS="${ARGS} -ti"
else
    CMD="Rscript /app/train_nn.R $@"
fi

docker run ${ARGS} doodles-tf ${CMD}

If this bash script is run without parameters, the script will be called inside the container train_nn.R with default values; if the first positional argument is "bash", then the container will start in interactive mode with a shell. In all other cases, the values of the positional arguments are substituted: CMD="Rscript /app/train_nn.R $@".

It is worth noting that the directories with the source data and the database, as well as the directory for saving the trained models, are mounted inside the container from the host system, which allows you to access the results of the scripts without unnecessary manipulations.

7. Using multiple GPUs in Google Cloud

One of the highlights of the competition was some very noisy data (see header image borrowed from @Leigh.plt from ODS Slack). Large batch sizes help to combat this, and after experimenting on a PC with 1 GPU, we decided to learn how to train models on multiple GPUs in the cloud. Used Google Cloudgood basics guide) due to the large selection of available configurations, reasonable prices and bonus $300. Out of greed, I ordered an instance with a 4xV100 with an SSD and a bunch of RAM, and this was a big mistake. Such a machine eats money quickly, and you can go broke on experiments without a proven pipeline. For training purposes, it is better to take the K80. But a large amount of RAM came in handy - the cloud SSD did not impress with speed, so the database was transferred to dev/shm.

Of greatest interest is the code snippet responsible for using multiple GPUs. First, the model is created on the CPU using the context manager, just like in Python:

with(tensorflow::tf$device("/cpu:0"), {
  model_cpu <- get_model(
    name = model_name,
    input_shape = input_shape,
    weights = weights,
    metrics =(top_3_categorical_accuracy,
    compile = FALSE
  )
})

Then the uncompiled (this is important) model is copied to the specified number of available GPUs, and only after that it is compiled:

model <- keras::multi_gpu_model(model_cpu, gpus = n_gpu)
keras::compile(
  object = model,
  optimizer = keras::optimizer_adam(lr = 0.0004),
  loss = "categorical_crossentropy",
  metrics = c(top_3_categorical_accuracy)
)

The classic technique with freezing all layers except the last one, training the last layer, defrosting and retraining the entire model for several GPUs could not be implemented.

Training was followed without using tensorboard, limited to writing logs and saving models with informative names after each epoch:

callbacks

# Шаблон имени файла лога
log_file_tmpl <- file.path("logs", sprintf(
  "%s_%d_%dch_%s.csv",
  model_name,
  dim_size,
  channels,
  format(Sys.time(), "%Y%m%d%H%M%OS")
))
# Шаблон имени файла модели
model_file_tmpl <- file.path("models", sprintf(
  "%s_%d_%dch_{epoch:02d}_{val_loss:.2f}.h5",
  model_name,
  dim_size,
  channels
))

callbacks_list <- list(
  keras::callback_csv_logger(
    filename = log_file_tmpl
  ),
  keras::callback_early_stopping(
    monitor = "val_loss",
    min_delta = 1e-4,
    patience = 8,
    verbose = 1,
    mode = "min"
  ),
  keras::callback_reduce_lr_on_plateau(
    monitor = "val_loss",
    factor = 0.5, # уменьшаем lr в 2 раза
    patience = 4,
    verbose = 1,
    min_delta = 1e-4,
    mode = "min"
  ),
  keras::callback_model_checkpoint(
    filepath = model_file_tmpl,
    monitor = "val_loss",
    save_best_only = FALSE,
    save_weights_only = FALSE,
    mode = "min"
  )
)

8. Instead of a conclusion

A number of problems that we encountered have not yet been overcome:

в hard there is no ready-made function for automatically searching for the optimal learning rate (similar to lr_finder in library fast.ai); with some effort, third-party implementations can be ported to R, for example, this;
as a consequence of the previous paragraph, it was not possible to find the correct learning rate when using multiple GPUs;
there are not enough modern architectures of neural networks, especially those pre-trained on imagenet;
no one cycle policy and discriminative learning rates (cosine annealing at our request was implemented, Thank you skeydan).

What was useful to take away from this competition:

On relatively low-power hardware, you can work without pain with decent (a multiple of the size of RAM) amounts of data. Plastic bag data.table saves memory due to in-place modification of tables, which avoids copying them, and with the right use of its capabilities, it almost always demonstrates the highest speed among all scripting language tools known to us. Saving data in the database allows in many cases not to think at all about the need to squeeze the entire dataset into RAM.
Slow functions in R can be replaced with fast functions in C++ using the package rcpp. If in addition to use RcppThread or RcppParallel, we get cross-platform multi-threaded implementations, so the code at the R level does not need to be parallelized.
By package rcpp can be used without serious knowledge of C ++, the necessary minimum is set out here. Header files for a number of cool sish libraries like xtensor available on CRAN, that is, an infrastructure is being formed for the implementation of projects that integrate ready-made high-performance C ++ code into R. An additional convenience is syntax highlighting and a static C++ code analyzer in RStudio.
docpt allows you to run self-contained scripts with parameters. This is convenient for use on a remote server, incl. under docker. In RStudio, it is inconvenient to conduct many hours of experiments with training neural networks, and the installation of the IDE on the server itself is not always justified.
Docker provides portability of code and reproducibility of results between developers with different versions of OS and libraries, as well as ease of running on servers. You can run the entire pipeline for training with just one command.
Google Cloud is a budget way to experiment on expensive hardware, but you need to choose your configurations thoughtfully.
Measuring the speed of individual code fragments is very useful, especially when combining R and C ++, and with a package bench - also very easy.

Overall, this experience has been very helpful and we are continuing to work on resolving some of the issues that have been raised.

Source: habr.com

Quick Draw Doodle Recognition: how to make R, C++ and neural networks friends

Contents:

1. Efficient loading of data from CSV to the MonetDB database