Lesson 8 骨髓抹片單核球物件識別挑戰

下載資料

• 請你先到資料科學競賽網站選擇第八個任務，登入後下載4份資料，包含之前任務沒有的「supplement.zip」，裡面放著骨髓抹片的1000倍顯微鏡影像。

– 與之前所有任務相同，這個任務的資料下載是需要經過申請的，請你找助教申請帳號。

讀取資料

• 最開始我們還是需要先將「train.csv」、「test.csv」以及「sample_submission.csv」讀進來：

library(data.table)

train_dat <- fread('train.csv', data.table = FALSE)
test_dat <- fread('test.csv', data.table = FALSE)
submit_dat <- fread('sample_submission.csv', data.table = FALSE)

• 如果你是使用伺服器版的Rstudio，那直接上傳上傳「supplement.zip」就能得到資料夾「image」了。或是你可以先解壓縮放到你的project的資料夾下

熟悉資料型態

• 先讓我們看看訓練資料的格式：

head(train_dat)

##             obj_name  col_left col_right   row_bot     row_top img_id
## 1             Blasts 0.3877827 0.4932385 0.1347430 0.008709886  U0007
## 2            Myeloid 0.5005113 0.6077853 0.1269871 0.022282680  U0007
## 3           Monocyte 0.7023318 0.7841510 0.2181187 0.107597387  U0007
## 4           Monocyte 0.7641507 0.8568791 0.1754614 0.082390769  U0007
## 5           Monocyte 0.8896067 0.9732441 0.1386209 0.039733416  U0007
## 6 Unable to identify 0.8496063 0.9277890 0.1967900 0.103719446  U0007

• 讓我們先載入展示圖片的函數：

library(OpenImageR)
library(imager)

boxtext <- function(x, y, labels = NA, col.text = NULL, col.bg = NA, 
                    border.bg = NA, adj = NULL, pos = NULL, offset = 0, 
                    padding = c(0.5, 0.5), cex = 1, font = graphics::par('font')){
  
  ## The Character expansion factro to be used:
  theCex <- graphics::par('cex')*cex
  
  ## Is y provided:
  if (missing(y)) y <- x
  
  ## Recycle coords if necessary:    
  if (length(x) != length(y)){
    lx <- length(x)
    ly <- length(y)
    if (lx > ly){
      y <- rep(y, ceiling(lx/ly))[1:lx]           
    } else {
      x <- rep(x, ceiling(ly/lx))[1:ly]
    }       
  }
  
  ## Width and height of text
  textHeight <- graphics::strheight(labels, cex = theCex, font = font)
  textWidth <- graphics::strwidth(labels, cex = theCex, font = font)
  
  ## Width of one character:
  charWidth <- graphics::strwidth("e", cex = theCex, font = font)
  
  ## Is 'adj' of length 1 or 2?
  if (!is.null(adj)){
    if (length(adj == 1)){
      adj <- c(adj[1], 0.5)            
    }        
  } else {
    adj <- c(0.5, 0.5)
  }
  
  ## Is 'pos' specified?
  if (!is.null(pos)){
    if (pos == 1){
      adj <- c(0.5, 1)
      offsetVec <- c(0, -offset*charWidth)
    } else if (pos == 2){
      adj <- c(1, 0.5)
      offsetVec <- c(-offset*charWidth, 0)
    } else if (pos == 3){
      adj <- c(0.5, 0)
      offsetVec <- c(0, offset*charWidth)
    } else if (pos == 4){
      adj <- c(0, 0.5)
      offsetVec <- c(offset*charWidth, 0)
    } else {
      stop('Invalid argument pos')
    }       
  } else {
    offsetVec <- c(0, 0)
  }
  
  ## Padding for boxes:
  if (length(padding) == 1){
    padding <- c(padding[1], padding[1])
  }
  
  ## Midpoints for text:
  xMid <- x + (-adj[1] + 1/2)*textWidth + offsetVec[1]
  yMid <- y + (-adj[2] + 1/2)*textHeight + offsetVec[2]
  
  ## Draw rectangles:
  rectWidth <- textWidth + 2*padding[1]*charWidth
  rectHeight <- textHeight - 2*padding[2]*charWidth    
  graphics::rect(xleft = xMid - rectWidth/2, 
                 ybottom = yMid - rectHeight/2, 
                 xright = xMid + rectWidth/2, 
                 ytop = yMid + rectHeight/2,
                 col = col.bg, border = border.bg)
  
  ## Place the text:
  graphics::text(xMid, yMid, labels, col = col.text, cex = theCex, font = font, 
                 adj = c(0.5, 0.5))    
  
  ## Return value:
  if (length(xMid) == 1){
    invisible(c(xMid - rectWidth/2, xMid + rectWidth/2, yMid - rectHeight/2,
                yMid + rectHeight/2))
  } else {
    invisible(cbind(xMid - rectWidth/2, xMid + rectWidth/2, yMid - rectHeight/2,
                    yMid + rectHeight/2))
  }    
}

Show_img <- function (img, box_info = NULL, show_prob = TRUE,
                      col_bbox_list = rainbow(8, alpha = 0.5),
                      selections = c("Erythroid", "Blasts", "Myeloid", "Lymphoid", "Plasma cells", "Monocyte", "Megakaryocyte", "Unable to identify"),
                      text_cex = 1.5, plot_xlim = c(0.04, 0.96), plot_ylim = c(0.96, 0.04)) {
  
  par(mar = rep(0, 4))
  plot(NA, xlim = plot_xlim, ylim = plot_ylim, xaxt = "n", yaxt = "n", bty = "n")
  img = (img - min(img))/(max(img) - min(img))
  img = as.raster(img)
  rasterImage(img, 0, 1, 1, 0, interpolate=FALSE)
  
  if (!is.null(box_info)) {
    if (mean(c('obj_name', 'col_left', 'col_right', 'row_bot', 'row_top') %in% colnames(box_info)) == 1) {
      if (nrow(box_info) > 0) {
        if (!'prob' %in% colnames(box_info)) {box_info[,'prob'] <- 1L}
        box_info <- box_info[order(box_info[,'prob']),]
        for (i in 1:nrow(box_info)) {
          col_label <- col_bbox_list[which(selections %in% box_info[i,'obj_name'])]
          if (length(col_label) != 1) {col_label <- '#00000080'}
          size <- max(box_info[i,'col_right'] - box_info[i,'col_left'], 0.2)
          rect(xleft = box_info[i,'col_left'], xright = box_info[i,'col_right'],
               ybottom = box_info[i,'row_bot'], ytop = box_info[i,'row_top'],
               col = '#FFFFFF00', border = col_label, lwd = 5*sqrt(size))
          if (text_cex > 0) {
            if (show_prob) {current_label <- paste0(box_info[i,'obj_name'], '(', round(box_info[i,'prob'] * 100),'%)')} else {current_label <- box_info[i,1]}
            boxtext(x = box_info[i,'col_left'], y = box_info[i,'row_top'], labels = current_label, 
                    col.bg = col_label, col.text = 'white', adj = c(0, 0.6), font = 2, cex = text_cex*sqrt(size))
          }
        }
      }
    }
  }
  
}

• 將其中一張影像讀進來看看，並且使用相對應的物件框：

selected_img <- 'U0007'

sub_box_info <- train_dat[train_dat[,'img_id'] %in% selected_img,]
img <- readImage(paste0('image/', selected_img, '.jpg'))

Show_img(img = img, box_info = sub_box_info)