細胞を使った実験をしていると、溶液中にどれくらいの細胞があるかを数えなければならないことがある。それで、プレパラートみたいなものの上に10μlくらい細胞の入った溶液を乗っけて、顕微鏡観察下でバードウォッチングの如くカチャカチャ数を数える。
プレパラートには1mm幅の線が入っていて、プレパラートの厚さが0.1mmだから倍したら1mlあたりの細胞数がわかるという原理である。
これ、一回とかならやる気になるのだけれも、これが数百とかあったら100万くらいするセルカウンターを買ったほうが早い疑惑がある。統計、情報解析的には画像処理の技術を用いて細胞を数えることができる。
科学研究機器・消耗品のBMS 培養細胞の位相差顕微鏡写真比較の画像をEBImageを使ってやってみる。
画像が多くなればfile.choose関数でGUIっぽく画像ファイルを選びに行ったり、list.files関数でディレクトリ内の画像をすべて選択してfor loopしてもいい。
library(png) library(jpeg) library(EBImage) # これはURLからも読み込みできる nuc <- readImage("http://www.bmsci.com/system/cell/pro_img/onecell/deta_2.jpg") nuc <- flip(nuc) # プロットの体裁用に反転させておく nmask <- thresh(nuc[,,2], 10, 10, 0.01) # 閾値をいじる必要がある nmask <- opening(nmask, makeBrush(5, shape="disc")) nmask <- fillHull(nmask) nmask <- bwlabel(nmask) xy <- computeFeatures.moment(nmask@.Data[,,2])[,c("m.cx", "m.cy")] labels <- as.character(1:nrow(xy)) mat <- ifelse(nmask@.Data[,,2] > 0, 1, 0) #mat <- mat[, rev(seq(ncol(mat)))] cols <- c(0, grey(0.3)) xlim <- nrow(nuc@.Data) ylim <- ncol(nuc@.Data) # ヒートマップでゴリ押し par(mfrow=c(1, 2)) par(mar=rep(0.5, 4)) image(seq(xlim), seq(ylim), mat, col=cols, xlab="", ylab="", tck=0) text(xy, labels, col=5, xpd=TRUE) pic <- readJPEG("deta_2.jpg") # こちらはURLで読み込めなかった image(seq(xlim), seq(ylim), mat, col="white", xlab="", ylab="", axes=FALSE, frame=FALSE) rasterImage(pic, 0, 0, ncol(pic), nrow(pic)) text(xy, labels, col="red", xpd=TRUE)
