用R和Keras深度学习的例子

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

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

TensorFlow和Keras使用R接口作为选择(即  TensorFlowTheanoCNTK)结合详细的文档和大量的例子看起来更有吸引力。本文提出了一个解决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的这个大型库的版本尚未创建,通过网状调用它的函数看起来像一个非运动员的解决方案,所以我们将从可用的替代方案中进行选择。前三个最强大的图形包如下:

  1. EBImage:该软件包是使用S4类创建的,并放置在Bioconductor存储库中,这意味着软件包本身和文档的最高质量要求。不幸的是,享受这个软件产品的巨大可能性受到极低速度的阻碍。
  2. imager:这个包在性能方面看起来更有趣,因为它的主要工作是通过面向 CImg库的编译代码来执行的。其中的优点是,我们可以注意到“管道”运营商(以及magrittr的其他运营商)的支持以及与其包裹的紧密结合。它使用了 全面的,包括ggplot2,以及支持分裂应用结合的思想。只有一个难以理解的错误使得在某些电脑上阅读图片的功能无法操作,从而阻止了这封邮件的作者停止选择这个包。
  3. magickImageMagick的封装包,由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)。

结果:

GIF图像用于比较原始和预测蒙版:

使用低分辨率的图像(仅128x128)解释了小细节的缺失。当以更高的分辨率工作时,结果当然会更好。由于内存不足,您可以批量预测数千个观测值,然后将其保存在一个文件中。

结论

在本文中,研究表明,使用R的用户,也可以跟上时尚趋势,并成功训练深度神经网络。甚至Windows操作系统也无法阻止它!

原文链接:https://dzone.com/articles/deep-learning-with-r-and-keras-on-the-example-of-c

原文作者:Alex Maison

发表于

我来说两句

0 条评论
登录 后参与评论

相关文章

来自专栏简书专栏

Windows系统查看CUDA版本号

在按住Win键的情况下,按P键,呼唤出搜索框。 在搜索框中输入control panel,如下图所示:

1062
来自专栏ATYUN订阅号

TensorFlow:使用Cloud TPU在30分钟内训练出实时移动对象检测器

是否能够更快地训练和提供对象检测模型?我们已经听到了这种的反馈,在今天我们很高兴地宣布支持训练Cloud TPU上的对象检测模型,模型量化以及并添加了包括Ret...

1525
来自专栏人工智能LeadAI

深度学习训练时GPU温度过高?几个命令,为你的GPU迅速降温。

新买回来的不带水冷公版GPU,在满负载运行的时候,温度从室温马上飙升到85度,而且模型训练不是几分钟完事,很有可能要长期保持在高温状态下运行,让如此昂贵的GPU...

3877
来自专栏机器学习算法全栈工程师

史上最详细的XGBoost实战(上)

作者:章华燕 编辑:祝鑫泉 零 环境介绍: · Python版本:3.6.2 · 操作系统:Windows · 集成开发环境:PyCharm 一 安装Pyt...

4954
来自专栏AI科技大本营的专栏

深度学习训练时GPU温度过高?几个命令,为你的GPU迅速降温

图来自网络 作者 | 人工智豪(ID:Aihows) 新买回来的不带水冷公版GPU,在满负载运行的时候,温度从室温马上飙升到85度,而且模型训练不是几分钟完事,...

4559
来自专栏Python小屋

Python读取Excel文件统计演员参演电影

假设有个Excel 2007文件“电影导演演员.xlsx”,其中有三列分别为电影名称、导演和演员列表(同一个电影可能会有多个演员,每个演员姓名之间使用逗号分隔)...

3118
来自专栏新智元

强化学习练就18般武艺!伯克利开源DeepMimic

还记得今年4月伯克利BAIR实验室发布的那个会“18般武艺”的DeepMimic模型吗?他们使用强化学习技术,用动作捕捉片段训练模型,教会了AI智能体完成24种...

781
来自专栏机器之心

TensorFlow初学者指南:如何为机器学习项目创建合适的文件架构

选自MetaFlow 作者:Morgan 机器之心编译 参与:李亚洲、蒋思源 在这篇文章中,作者根据自己的经验为 TensorFlow 初学者给出了设计文件、文...

3676
来自专栏小石不识月

如何将机器学习模型转移到产品中

针对于特定问题(例如自然语言处理,即 NLP,或图像识别)的深度学习模型开发、训练和调参,需要耗费时间与资源。这通常还包括使用功能强大的处理器来训练大型数据集上...

2612
来自专栏PaddlePaddle

【场景文字识别】场景文字识别

1. STR任务简介 许多场景图像中包含着丰富的文本信息,对理解图像信息有着重要作用,能够极大地帮助人们认知和理解场景图像的内容。场景文字识别是在图像背景复杂、...

3367

扫码关注云+社区