用R和Keras深度学习的例子

花落花飞去

发布于 2017-12-20 14:42:52

4.2K0

发布于 2017-12-20 14:42:52

本译文自Alex Maison在https://dzone.com 发表的 Example of Deep Learning With R and Keras，文中版权、图像代码等数据均归作者所有。为了本土化，翻译内容略作修改。

同样是编程语言之一，R的用户长期被剥夺了参与深度学习运动的机会。随着MXNet的发布，情况开始发生变化，但是原始文档的频繁更新以及突破后向兼容性的变化仍然限制了该库的普及。

TensorFlow和Keras使用R接口作为选择（即 TensorFlow，Theano，CNTK）结合详细的文档和大量的例子看起来更有吸引力。本文提出了一个解决Carvana Image Masking Challenge中的图像分割问题的解决方案，其中您想了解如何将从16个不同角度拍摄的汽车分开。（您可以在这里了解获奖者）。神经网络部分完全在Keras上实现，图像处理由Magick（ImageMagick接口）回答，并行处理由并行+ doParallel + foreach （Windows）或并行+ doMC + foreach （Linux）的。

我们需要安装什么？

我们假设读者已经拥有来自Nvidia的具有≥4GB内存的GPU（它可以更少，但体验就不会那么有趣），并且还安装了CUDA和cuDNN库。对于Linux来说，安装后者很容易，对于Windows来说，更简单！（请参阅手册的CUDA和cuDNN 部分。）

此外，最好使用Python 3 安装Anaconda发行版。为了节省空间，可以使用Miniconda。如果突然发布的Python版本超过了Tensorflow支持的最新版本，则可以使用表单命令替换它conda install python = 3.6。此外，一切都将与通常的Python和虚拟环境一起工作。

使用的R软件包清单如下：

Windows的软件包列表：

library(keras)
library(magick)
library(abind)
library(reticulate)
library(parallel)
library(doParallel)
library(foreach)

Linux的软件包列表

library(keras)
library(magick)
library(abind)
library(reticulate)
library(parallel)
library(doMC)
library(foreach)

所有这些都安装了CRAN，但最好带上GitHub的Keras：（devtools:: install_github ("rstudio/keras"）。随后的install_keras ()命令运行将创建一个conda环境，并安装正确版本的Python Tensorflow和Keras。如果这个命令出于某种原因拒绝正常工作（例如，找不到所需的Python发行版）或者需要使用特定版本的库，则应该自己创建一个conda环境，在其中安装必要的软件包，然后R，指定环境正在使用该 use_condaenv () 命令。

以下是使用的参数列表：

input_size <- 128 # 提供给神经网络输入的图像的宽度和高度
epochs <- 30 # epochs 的数量
batch_size <- 16 # 批量大小
orig_width <- 1918 # 原始图像的宽度
orig_height <- 1280 # 源图像的高度
train_samples <- 5088 # 训练样本的大小
train_index <- sample (1: train_samples, round (train_samples * 0.8)) # 80%
val_index <- c (1: train_samples) [- train_index]
＃图片文件夹
images_dir <- "input / train /"
masks_dir <- "input / train_masks /"

使用图像：magick作为OpenCV的替代品

在解决图形数据的机器学习任务时，必须至少能够读取磁盘上的图像，并将其传送到数组形式的神经网络中。通常情况下，您还需要能够执行各种图像转换以实现增强 - 通过训练样本本身中存在的样本创建的人为示例添加训练样本。增强（几乎）总是能够提高模型的质量。展望未来，我们应该注意到，所有这些都需要以多线程的方式快速完成，即使是在CPU速度相对较快，显卡速度相对较慢的情况下，准备阶段也可能比实际学习更耗费资源神经网络。

在Python中，OpenCV传统上用于处理图像。R的这个大型库的版本尚未创建，通过网状调用它的函数看起来像一个非运动员的解决方案，所以我们将从可用的替代方案中进行选择。前三个最强大的图形包如下：

EBImage：该软件包是使用S4类创建的，并放置在Bioconductor存储库中，这意味着软件包本身和文档的最高质量要求。不幸的是，享受这个软件产品的巨大可能性受到极低速度的阻碍。
imager：这个包在性能方面看起来更有趣，因为它的主要工作是通过面向 CImg库的编译代码来执行的。其中的优点是，我们可以注意到“管道”运营商（以及magrittr的其他运营商）的支持以及与其包裹的紧密结合。它使用了全面的，包括ggplot2，以及支持分裂应用结合的思想。只有一个难以理解的错误使得在某些电脑上阅读图片的功能无法操作，从而阻止了这封邮件的作者停止选择这个包。
magick是ImageMagick的封装包，由rOpenSci社区成员积极开发。它结合了以前的软件包的所有优点，包括稳定性和杀手级功能（在我们的任务框架中无用），与OCR库Tesseract集成。下面给出了在不同数量的核上读取和转换图像时的速度测量结果。在这些缺点中，可以注意到深奥的语法; 例如，为了剪切或调整大小，您需要传递一个形式为“100x150 + 50”的字符串，而不是通常的高度和宽度参数。而且由于我们的预处理辅助函数将被这些值参数化，所以你将不得不使用丑陋的 paste0 (...) 或者 sprint (...) 设计

我们将重现 Peter-a Giannakopoulos 的Kaggle Carvana Image Masking Challenge的解决方案。

您需要成对读取文件 - 图像和相应的蒙版 - 并对图像和蒙版应用相同的变换（旋转，移位，反射，缩放变化）。我们以一种功能的形式实现阅读，这将立即将图像缩小到所需的大小：

imagesRead  < -  function（image\_file，
                       mask\_file，
                       target\_width  =  128，
                       target\_height  =  128）{
    img  < -  image\_read（image\_file）
    img  < -  image\_scale（img，paste0（target\_width，“ x”，target\_height，“ ！”））
    mask  < -  image\_read（mask\_file）
    mask  < -  image\_scale（mask，paste0（target\_width，“ x”，target\_height，“ ！”））
    list（img  =  img，mask =  mask）
}

将蒙版应用于图像的功能的结果：

img  < -  “ input / train / 0cdf5b5d0ce1_01.jpg”
mask  < -  “ input / train_masks / 0cdf5b5d0ce1_01_mask.png”
x_y_imgs  < -  imagesRead（img，
                       mask，
                       target_width  =  400，
                       target_height  =  400）
image_composite（x_y_imgs $ img，
                x_y_imgs $ mask，
                operator  =  “ blend”，
                compose_args  =  “ 60”）％>％
    image_write（path  =  “ pics / pic1.jpg”，format  =  “ jpg”）

第一种增强将改变亮度（饱和度），饱和度（持续时间）和色调（色调）。由于显而易见的原因，它适用于彩色图像，但不适用于黑白蒙版：

randomBSH <- function(img,
                      u = 0,
                      brightness_shift_lim = c(90, 110), # percentage
                      saturation_shift_lim = c(95, 105), # of current value
                      hue_shift_lim = c(80, 120)) {
    if (rnorm(1) < u) return(img)
    brightness_shift <- runif(1, 
                              brightness_shift_lim[1], 
                              brightness_shift_lim[2])
    saturation_shift <- runif(1, 
                              saturation_shift_lim[1], 
                              saturation_shift_lim[2])
    hue_shift <- runif(1, 
                       hue_shift_lim[1], 
                       hue_shift_lim[2])
    img <- image_modulate(img, 
                          brightness = brightness_shift, 
                          saturation =  saturation_shift, 
                          hue = hue_shift)
    img
}

该转换以50％的概率应用（如果原始图像的一半将被返回(rnorm (1) <u) return (img)）; 三个参数中的每一个的变化值在以原始值的百分比指定的值的范围内随机地选择。

此外，有50％的概率，我们将使用图像和蒙版的水平反射：

randomHorizontalFlip <- function(img, 
                                 mask,
                                 u = 0) {
    if (rnorm(1) < u) return(list(img = img, mask = mask))
    list(img = image_flop(img), mask = image_flop(mask))
}

结果：

img <- "input/train/0cdf5b5d0ce1_01.jpg"
mask <- "input/train_masks/0cdf5b5d0ce1_01_mask.png"
x_y_imgs <- imagesRead(img, mask,
                       target_width = 400, 
                       target_height = 400)
x_y_imgs$img <- randomBSH(x_y_imgs$img)
x_y_imgs <- randomHorizontalFlip(x_y_imgs$img,
                                 x_y_imgs$mask)
image_composite(x_y_imgs$img, 
                x_y_imgs$mask, 
                operator = "blend", 
                compose_args = "60") %>%
    image_write(path = "pics/pic2.jpg", format = "jpg")

其余的转变并不是根本的，因此，进行下一步详谈，最后一个阶段是把图片转换成数组：

img2arr <- function(image, 
                    target_width = 128,
                    target_height = 128) {
    result <- aperm(as.numeric(image[[1]])[, , 1:3], c(2, 1, 3)) # transpose
    dim(result) <- c(1, target_width, target_height, 3)
    return(result)
}
mask2arr <- function(mask,
                     target_width = 128,
                     target_height = 128) {
    result <- t(as.numeric(mask[[1]])[, , 1]) # transpose
    dim(result) <- c(1, target_width, target_height, 1)
    return(result)
}

为了使图像线保留矩阵中的行，转置是必要的; 图像是逐行形成的（当扫描光束在管中移动时），而R中的矩阵填充为列（列主要或Fortran风格;相比之下，在numpy中，您可以在列之间切换主要和主要格式）。你可以没有它，但是有它更清楚。

在Windows和Linux中并行执行R代码

R中的并行计算的一般概念可以在Package'Parallel ' 手册，doParallel和foreach 入门，以及doMC和foreach入门中找到。该算法如下。用所需数量的内核启动集群：

cl  < -  makePSOCKcluster（4）＃doParallel

SOCK集群是一个通用的解决方案，允许使用多台PC的CPU。不幸的是，我们用迭代器和神经网络训练的例子在Windows下工作，所以拒绝在Linux下工作。在Linux中，您可以使用替代 doMC 软件包，它使用源进程的分支创建集群。剩下的步骤不需要完成。

doParallel和doMC都作为并行和foreach功能之间的中介。

使用时 makePSOCKcluster ()，需要在集群中加载必要的软件包和函数：

加载包和函数：

clusterEvalQ(cl, {
    library(magick)     
    library(abind)     
    library(reticulate)
    imagesRead <- function(image_file,
                           mask_file,
                           target_width = 128, 
                           target_height = 128) {
        img <- image_read(image_file)
        img <- image_scale(img, paste0(target_width, "x", target_height, "!"))
        mask <- image_read(mask_file)
        mask <- image_scale(mask, paste0(target_width, "x", target_height, "!"))
        return(list(img = img, mask = mask))
    }
    randomBSH <- function(img,
                          u = 0,
                          brightness_shift_lim = c(90, 110), # percentage
                          saturation_shift_lim = c(95, 105), # of current value
                          hue_shift_lim = c(80, 120)) {
        if (rnorm(1) < u) return(img)
        brightness_shift <- runif(1, 
                                  brightness_shift_lim[1], 
                                  brightness_shift_lim[2])
        saturation_shift <- runif(1, 
                                  saturation_shift_lim[1], 
                                  saturation_shift_lim[2])
        hue_shift <- runif(1, 
                           hue_shift_lim[1], 
                           hue_shift_lim[2])
        img <- image_modulate(img, 
                              brightness = brightness_shift, 
                              saturation =  saturation_shift, 
                              hue = hue_shift)
        img
    }
    randomHorizontalFlip <- function(img, 
                                   mask,
                                   u = 0) {
      if (rnorm(1) < u) return(list(img = img, mask = mask))
      list(img = image_flop(img), mask = image_flop(mask))
  }
    img2arr <- function(image, 
                        target_width = 128,
                        target_height = 128) {
        result <- aperm(as.numeric(image[[1]])[, , 1:3], c(2, 1, 3)) # transpose
        dim(result) <- c(1, target_width, target_height, 3)
        return(result)
    }
    mask2arr <- function(mask,
                         target_width = 128,
                         target_height = 128) {
        result <- t(as.numeric(mask[[1]])[, , 1]) # transpose
        dim(result) <- c(1, target_width, target_height, 1)
        return(result)
    }
})

我们将该群集注册为一个用于foreach的并行后端：

registerDoParallel（cl）

之后，您可以以并行模式运行代码：

imgs <- list.files("input/train/", 
                   pattern = ".jpg",
                   full.names = TRUE)[1:16]
masks <- list.files("input/train_masks/", 
                    pattern = ".png", 
                    full.names = TRUE)[1:16]
x_y_batch <- foreach(i = 1:16) %dopar% {
            x_y_imgs <- imagesRead(image_file = batch_images_list[i],
                                   mask_file = batch_masks_list[i])
            # augmentation
            x_y_imgs$img <- randomBSH(x_y_imgs$img)
            x_y_imgs <- randomHorizontalFlip(x_y_imgs$img,
                                             x_y_imgs$mask)
            # return as arrays
            x_y_arr <- list(x = img2arr(x_y_imgs$img),
                            y = mask2arr(x_y_imgs$mask))
        }
str(x_y_batch)
# List of 16
#  $ :List of 2
#   ..$ x: num [1, 1:128, 1:128, 1:3] 0.953 0.957 0.953 0.949 0.949 ...
#   ..$ y: num [1, 1:128, 1:128, 1] 0 0 0 0 0 0 0 0 0 0 ...
#  $ :List of 2
#   ..$ x: num [1, 1:128, 1:128, 1:3] 0.949 0.957 0.953 0.949 0.949 ...
#   ..$ y: num [1, 1:128, 1:128, 1] 0 0 0 0 0 0 0 0 0 0 ...
# ....

最后，不要忘记停止集群：

stopCluster（cl）

在microbenchmark软件包的帮助下，我们将检查使用多个内核/线程的好处。在具有4 GB内存的GPU上，可以使用16对图像的批处理，所以建议使用2,4,8或16个流（时间以秒为单位）：

在16条河流上，不可能检查，但很明显，当从一条流向四条河流时，速度增加约3倍 - 这是非常令人鼓舞的。

网状和迭代器

要处理不适合内存的数据，我们使用reticulate 包中的迭代器。一般情况也是函数闭包; 也就是说，被调用的函数会与调用环境一起返回另一个函数。

train_generator：

train_generator  < -  function（images_dir，
                            samples_index，
                            masks_dir，
                            batch_size）{
    images_iter  < -  list.files（images_dir，
                              pattern  =  “. jpg”，
                              full.names  =  TRUE）[ samples_index ] ＃为当前时期
    images_all  < -  list.files（images_dir，
                             pattern  =  “. jpg”，
                             full.names  =  TRUE）[ samples_index ]   ＃为下一个纪元
    masks_iter  < -  list.files（masks_dir，
                             pattern  =  “. gif”，
                             full.names  =  TRUE）[ samples_index ] ＃为当前时期
    masks_all  < -  list.files（masks_dir，
                            pattern  =  “. gif”，
                            full.names  =  TRUE）[ samples_index ] ＃为下一个纪元
    function（）{
        ＃开始新纪元
        if（length（images_iter）<  batch_size）{
            images_iter  <<  -  images_all
            masks_iter  <<  -  masks_all
        }
        batch_ind  < -  sample（1 ：length（images_iter），batch_size）
        batch_images_list  < -  images_iter [ batch_ind ]
        images_iter  <<  -  images_iter [ - batch_ind ]
        batch_masks_list  < -  masks_iter [ batch_ind ]
        masks_iter  <<  -  masks_iter [ - batch_ind ]
        x_y_batch  < -  foreach（i  =  1 ：batch_size）％dopar％ {
            x_y_imgs  < -  imagesRead（image_file  =  batch_images_list [ i ]，
                                   mask_file  =  batch_masks_list [ i ]）
            ＃增加
            x_y_imgs $ img  < -  randomBSH（x_y_imgs $ img）
            x_y_imgs  < -  randomHorizontalFlip（x_y_imgs $ img，
                                             x_y_imgs $ mask）
            ＃返回数组
            x_y_arr  < -  list（x  =  img2arr（x_y_imgs $ img），
                            y  =  mask2arr（x_y_imgs $ mask））
        }
        x_y_batch  < -  purrr :: transpose（x_y_batch）
        x_batch  < -  do.call（abind，c（x_y_batch $ x，list（along  =  1）））
        y_batch  < -  do.call（abind，c（x_y_batch $ y，list（along  =  1）））
         result <- list（keras_array（x_batch），
                       keras_array（y_batch））
        return(result)
    }
}

val_generator:

val_generator <- function(images_dir, 
                          samples_index,
                          masks_dir, 
                          batch_size) {
    images_iter <- list.files(images_dir, 
                              pattern = ".jpg", 
                              full.names = TRUE)[samples_index] # for current epoch
    images_all <- list.files(images_dir, 
                             pattern = ".jpg",
                             full.names = TRUE)[samples_index]  # for next epoch
    masks_iter <- list.files(masks_dir, 
                             pattern = ".gif",
                             full.names = TRUE)[samples_index] # for current epoch
    masks_all <- list.files(masks_dir, 
                            pattern = "gif",
                            full.names = TRUE)[samples_index] # for next epoch
    function() {
        # start new epoch
        if (length(images_iter) < batch_size) {
            images_iter <<- images_all
            masks_iter <<- masks_all
        }
        batch_ind <- sample(1:length(images_iter), batch_size)
        batch_images_list <- images_iter[batch_ind]
        images_iter <<- images_iter[-batch_ind]
        batch_masks_list <- masks_iter[batch_ind]
        masks_iter <<- masks_iter[-batch_ind]
        x_y_batch <- foreach(i = 1:batch_size) %dopar% {
            x_y_imgs <- imagesRead(image_file = batch_images_list[i],
                                   mask_file = batch_masks_list[i])
            # without augmentation
            # return as arrays
            x_y_arr <- list(x = img2arr(x_y_imgs$img),
                            y = mask2arr(x_y_imgs$mask))
        }
        x_y_batch <- purrr::transpose(x_y_batch)
        x_batch <- do.call(abind, c(x_y_batch$x, list(along = 1)))
        y_batch <- do.call(abind, c(x_y_batch$y, list(along = 1)))
        result <- list(keras_array(x_batch), 
                       keras_array(y_batch))
        return(result)
    }
}

在这里，在调用的环境中，存储在每个时期减少的处理文件的列表，以及在每个后续时期开始时使用的完整列表的副本。在这个实现中，您不必担心无意中混合文件 - 每个批次都是通过随机抽样获得的。

如上所示， x_y_batch 是16个列表的列表，每个列表是两个数组的列表。该 purrr:: transpose () 函数将内嵌的列表翻出来，我们得到两个列表的列表，每个列表是16个数组的列表。 and () 将指定维度的数组组合在一起，同时 do.call () 将任意数量的参数传递给内部函数。其他参数（ along = 1）以非常奇怪的方式设置： do.call (and, c (x_y_batch $ x, list (along = 1)))。

它仍然把这些功能转化为Keras可以理解的对象py_iterator ()：

train_iterator  < -  py_iterator（train_generator（images_dir  =  images_dir，
                                              masks_dir  =  masks_dir，
                                              samples_index  =  train_index，
                                              batch_size  =  batch_size））
val_iterator  < -  py_iterator（val_generator（images_dir  =  images_dir，
                                          masks_dir  =  masks_dir，
                                          samples_index  =  val_index，
                                          batch_size  =  batch_size））

调用 iter_next (train_iterator) 将返回一个迭代的结果，这在调试阶段很有用。

细分与损失函数

分割的任务可以被认为是一个每像素的分类：它预测每个像素是否属于一个特定的类。对于两个班的情况，结果将是一个面具; 如果有两个以上的类别，掩码的数量将等于类数减1（单热编码的模拟）。在我们的班级比赛中，只有两个（机器和背景），质量的度量是骰子系数。他计算这个：

K <- backend()
dice_coef <- function(y_true, y_pred, smooth = 1.0) {
    y_true_f <- K$flatten(y_true)
    y_pred_f <- K$flatten(y_pred)
    intersection <- K$sum(y_true_f * y_pred_f)
    result <- (2 * intersection + smooth) / 
        (K$sum(y_true_f) + K$sum(y_pred_f) + smooth)
    return(result)
}

我们将优化损失函数，这是交叉熵和1 - 的总和 dice_coef：

bce_dice_loss <- function(y_true, y_pred) {
    result <- loss_binary_crossentropy(y_true, y_pred) +
        (1 - dice_coef(y_true, y_pred))
    return(result)
}

U-Net架构

U-Net是解决分割问题的经典体系结构。这是一个示意图：

资源

以下是图片128x128的实现。

U-Net 128：

get_unet_128 <- function(input_shape = c(128, 128, 3),
                         num_classes = 1) {
    inputs <- layer_input(shape = input_shape)
    # 128
    down1 <- inputs %>%
        layer_conv_2d(filters = 64, kernel_size = c(3, 3), padding = "same") %>%
        layer_batch_normalization() %>%
        layer_activation("relu") %>%
        layer_conv_2d(filters = 64, kernel_size = c(3, 3), padding = "same") %>%
        layer_batch_normalization() %>%
        layer_activation("relu") 
    down1_pool <- down1 %>%
        layer_max_pooling_2d(pool_size = c(2, 2), strides = c(2, 2))
        # 64
    down2 <- down1_pool %>%
        layer_conv_2d(filters = 128, kernel_size = c(3, 3), padding = "same") %>%
        layer_batch_normalization() %>%
        layer_activation("relu") %>%
        layer_conv_2d(filters = 128, kernel_size = c(3, 3), padding = "same") %>%
        layer_batch_normalization() %>%
        layer_activation("relu") 
    down2_pool <- down2 %>%
        layer_max_pooling_2d(pool_size = c(2, 2), strides = c(2, 2))
        # 32
    down3 <- down2_pool %>%
        layer_conv_2d(filters = 256, kernel_size = c(3, 3), padding = "same") %>%
        layer_batch_normalization() %>%
        layer_activation("relu") %>%
        layer_conv_2d(filters = 256, kernel_size = c(3, 3), padding = "same") %>%
        layer_batch_normalization() %>%
        layer_activation("relu") 
    down3_pool <- down3 %>%
        layer_max_pooling_2d(pool_size = c(2, 2), strides = c(2, 2))
        # 16
    down4 <- down3_pool %>%
        layer_conv_2d(filters = 512, kernel_size = c(3, 3), padding = "same") %>%
        layer_batch_normalization() %>%
        layer_activation("relu") %>%
        layer_conv_2d(filters = 512, kernel_size = c(3, 3), padding = "same") %>%
        layer_batch_normalization() %>%
        layer_activation("relu") 
    down4_pool <- down4 %>%
        layer_max_pooling_2d(pool_size = c(2, 2), strides = c(2, 2))
        # 8
    center <- down4_pool %>%
        layer_conv_2d(filters = 1024, kernel_size = c(3, 3), padding = "same") %>%
        layer_batch_normalization() %>%
        layer_activation("relu") %>%
        layer_conv_2d(filters = 1024, kernel_size = c(3, 3), padding = "same") %>%
        layer_batch_normalization() %>%
        layer_activation("relu") 
        # center
    up4 <- center %>%
        layer_upsampling_2d(size = c(2, 2)) %>%
        {layer_concatenate(inputs = list(down4, .), axis = 3)} %>%
        layer_conv_2d(filters = 512, kernel_size = c(3, 3), padding = "same") %>%
        layer_batch_normalization() %>%
        layer_activation("relu") %>%
        layer_conv_2d(filters = 512, kernel_size = c(3, 3), padding = "same") %>%
        layer_batch_normalization() %>%
        layer_activation("relu") %>%
        layer_conv_2d(filters = 512, kernel_size = c(3, 3), padding = "same") %>%
        layer_batch_normalization() %>%
        layer_activation("relu")
        # 16
    up3 <- up4 %>%
        layer_upsampling_2d(size = c(2, 2)) %>%
        {layer_concatenate(inputs = list(down3, .), axis = 3)} %>%
        layer_conv_2d(filters = 256, kernel_size = c(3, 3), padding = "same") %>%
        layer_batch_normalization() %>%
        layer_activation("relu") %>%
        layer_conv_2d(filters = 256, kernel_size = c(3, 3), padding = "same") %>%
        layer_batch_normalization() %>%
        layer_activation("relu") %>%
        layer_conv_2d(filters = 256, kernel_size = c(3, 3), padding = "same") %>%
        layer_batch_normalization() %>%
        layer_activation("relu")
        # 32
    up2 <- up3 %>%
        layer_upsampling_2d(size = c(2, 2)) %>%
        {layer_concatenate(inputs = list(down2, .), axis = 3)} %>%
        layer_conv_2d(filters = 128, kernel_size = c(3, 3), padding = "same") %>%
        layer_batch_normalization() %>%
        layer_activation("relu") %>%
        layer_conv_2d(filters = 128, kernel_size = c(3, 3), padding = "same") %>%
        layer_batch_normalization() %>%
        layer_activation("relu") %>%
        layer_conv_2d(filters = 128, kernel_size = c(3, 3), padding = "same") %>%
        layer_batch_normalization() %>%
        layer_activation("relu")
        # 64
    up1 <- up2 %>%
        layer_upsampling_2d(size = c(2, 2)) %>%
        {layer_concatenate(inputs = list(down1, .), axis = 3)} %>%
        layer_conv_2d(filters = 64, kernel_size = c(3, 3), padding = "same") %>%
        layer_batch_normalization() %>%
        layer_activation("relu") %>%
        layer_conv_2d(filters = 64, kernel_size = c(3, 3), padding = "same") %>%
        layer_batch_normalization() %>%
        layer_activation("relu") %>%
        layer_conv_2d(filters = 64, kernel_size = c(3, 3), padding = "same") %>%
        layer_batch_normalization() %>%
        layer_activation("relu")
        # 128
    classify <- layer_conv_2d(up1,
                              filters = num_classes, 
                              kernel_size = c(1, 1),
                              activation = "sigmoid")
    model <- keras_model(
        inputs = inputs,
        outputs = classify
    )
    model %>% compile(
        optimizer = optimizer_rmsprop(lr = 0.0001),
        loss = bce_dice_loss,
        metrics = c(dice_coef)
    )
    return(model)
}
model <- get_unet_128()

大括号中 {layer_concatenate (inputs = list (down4,.), Axis = 3)} 的内容需要以所需参数的形式来替代对象，而不是像第一个那样 otherwise%>% 。您可以建议对此架构进行许多修改; 使用， layer_conv_2d_transpose 而不是 layer_upsampling_2d使用单独的卷积， layer_separable_conv_2d 而不是通常的，并试验过滤器号码和优化器设置。还有一些分辨率高达1024x1024的选项，也可以轻松移植到R.

在我们的模型中，有很多参数：

# Total params: 34,540,737
# Trainable params: 34,527,041
# Non-trainable params: 13,696

模型训练

一切都很简单。运行tensorboard：

tensorboard（ “logs_r”）

作为替代方案，该 tfruns 软件包已经上市，该软件包在RStudio IDE中增加了一个模拟量Tensorboard，可以简化学习神经网络的工作。

指定回调 - 和。我们将使用早期停车，降低进入高原时的训练速度，并节省最佳模型的重量：

callbacks_list <- list(
    callback_tensorboard("logs_r"),
    callback_early_stopping(monitor = "val_python_function",
                            min_delta = 1e-4,
                            patience = 8,
                            verbose = 1,
                            mode = "max"),
    callback_reduce_lr_on_plateau(monitor = "val_python_function",
                                  factor = 0.1,
                                  patience = 4,
                                  verbose = 1,
                                  epsilon = 1e-4,
                                  mode = "max"),
    callback_model_checkpoint(filepath = "weights_r/unet128_{epoch:02d}.h5",
                              monitor = "val_python_function",
                              save_best_only = TRUE,
                              save_weights_only = TRUE, 
                              mode = "max" )
  )

我们开始训练并等待。在GTX 1050ti上，一个epochs大概需要十分钟的时间：

model %>% fit_generator(
  train_iterator,
  steps_per_epoch = as.integer(length(train_index) / batch_size), 
  epochs = epochs, 
  validation_data = val_iterator,
  validation_steps = as.integer(length(val_index) / batch_size),
  verbose = 1,
  callbacks = callbacks_list
)

基于模型的预测

扰流板使用游程编码提供预测代码的演示版本：

test_dir <- "input/test/"
test_samples <- 100064
test_index <- sample(1:test_samples, 1000) 
load_model_weights_hdf5(model, "weights_r/unet128_08.h5") # best model
imageRead <- function(image_file,
                      target_width = 128, 
                      target_height = 128) {
    img <- image_read(image_file)
    img <- image_scale(img, paste0(target_width, "x", target_height, "!"))
}
img2arr <- function(image, 
                    target_width = 128,
                    target_height = 128) {
    result <- aperm(as.numeric(image[[1]])[, , 1:3], c(2, 1, 3)) # transpose
    dim(result) <- c(1, target_width, target_height, 3)
    return(result)
}
arr2img <- function(arr,
                    target_width = 1918,
                    target_height = 1280) {
    img <- image_read(arr)
    img <- image_scale(img, paste0(target_width, "x", target_height, "!"))
}
qrle <- function(mask) {
    img <- t(mask)
    dim(img) <- c(128, 128, 1)
    img <- arr2img(img)
    arr <- as.numeric(img[[1]])[, , 2]
    vect <- ifelse(as.vector(arr) >= 0.5, 1, 0)
    turnpoints <- c(vect, 0) - c(0, vect)  
    starts <- which(turnpoints == 1)  
    ends <- which(turnpoints == -1)  
    paste(c(rbind(starts, ends - starts)), collapse = " ") 
}
cl <- makePSOCKcluster(4) 
clusterEvalQ(cl, {
    library(magick)     
    library(abind)     
    library(reticulate)
    imageRead <- function(image_file,
                          target_width = 128, 
                          target_height = 128) {
        img <- image_read(image_file)
        img <- image_scale(img, paste0(target_width, "x", target_height, "!"))
    }
    img2arr <- function(image, 
                        target_width = 128,
                        target_height = 128) {
        result <- aperm(as.numeric(image[[1]])[, , 1:3], c(2, 1, 3)) # transpose
        dim(result) <- c(1, target_width, target_height, 3)
        return(result)
    }
    qrle <- function(mask) {
        img <- t(mask)
        dim(img) <- c(128, 128, 1)
        img <- arr2img(img)
        arr <- as.numeric(img[[1]])[, , 2]
        vect <- ifelse(as.vector(arr) >= 0.5, 1, 0)
        turnpoints <- c(vect, 0) - c(0, vect)  
        starts <- which(turnpoints == 1)  
        ends <- which(turnpoints == -1)  
        paste(c(rbind(starts, ends - starts)), collapse = " ") 
    }
})
registerDoParallel(cl)
test_generator <- function(images_dir, 
                           samples_index,
                           batch_size) {
    images_iter <- list.files(images_dir, 
                              pattern = ".jpg", 
                              full.names = TRUE)[samples_index] 
    function() {
        batch_ind <- sample(1:length(images_iter), batch_size)
        batch_images_list <- images_iter[batch_ind]
        images_iter <<- images_iter[-batch_ind]
        x_batch <- foreach(i = 1:batch_size) %dopar% {
            img <- imageRead(image_file = batch_images_list[i])
            # return as array
            arr <- img2arr(img)
        }
        x_batch <- do.call(abind, c(x_batch, list(along = 1)))
        result <- list(keras_array(x_batch))
    }
}
test_iterator <- py_iterator(test_generator(images_dir = test_dir,
                                            samples_index = test_index,
                                            batch_size = batch_size))
preds <- predict_generator(model, test_iterator, steps = 10)
preds <- foreach(i = 1:160) %dopar% {
    result <- qrle(preds[i, , , ])
}
preds <- do.call(rbind, preds)

这个代码除了功能外没有什么新东西 qrle，它提供了比赛组织者所要求的格式（谢谢skoffer-y）。

结果：