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)
- 我們可以看看sample_submission中的範例，在預測時妳可以給出一個預測機率，從而了解到模型的肯定程度：
selected_img <- 'U0059'
sub_box_info <- submit_dat[submit_dat[,'img_id'] %in% selected_img,]
img <- readImage(paste0('image/', selected_img, '.jpg'))
Show_img(img = img, box_info = sub_box_info)
- 要注意的是，sample_submission中的範例經過特別的框位移及變更標籤的處理，並且也沒有完整的框數目，請你不要認為這份資料的答案是正確的。
Yolo v3
資料處理
- 我們需要知道這個研究中，每個物件框對應於物件種類的關係：
obj_ids <- 1:8
names(obj_ids) <- c("Erythroid", "Blasts", "Myeloid", "Lymphoid", "Plasma cells", "Monocyte", "Megakaryocyte", "Unable to identify")
box_info <- train_dat
box_info[,'obj_id'] <- obj_ids[box_info[,'obj_name']]
box_info[,'bbox_center_row'] <- (box_info[,'row_bot'] + box_info[,'row_top']) / 2
box_info[,'bbox_center_col'] <- (box_info[,'col_right'] + box_info[,'col_left']) / 2
box_info[,'bbox_width'] <- box_info[,'col_right'] - box_info[,'col_left']
box_info[,'bbox_height'] <- box_info[,'row_bot'] - box_info[,'row_top']
plot(box_info[,'bbox_width'] * 2048, box_info[,'bbox_height'] * 1920, col = rainbow(8, alpha = 0.5)[box_info[,'obj_id']],
xlab = 'width', ylab = 'height', log = 'xy', pch = 19, cex = 0.7)
legend('bottomright', names(obj_ids), col = rainbow(8, alpha = 0.5), pch = 19)
- 你應你應該有注意到紫色的點(Megakaryocyte)特別的遠，這是因為這種細胞特別的大，讓我們選擇找一張有這種細胞的圖來看看：
selected_img <- 'U0072'
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)