EBImageといえばこれだったが、図に文字を描けるdrawtextが使えなくなっていたのでヒートマップにゴリ押しした結果がこちら。
library(EBImage) # システムファイルからサンプルデータを読み出す。 nuc <- readImage(system.file("images", "nuclei.tif", package="EBImage")) cel <- readImage(system.file("images", "cells.tif", package="EBImage")) img <- rgbImage(green=1.5*cel, blue=nuc) nmask <- thresh(nuc, 10, 10, 0.05) nmask <- opening(nmask, makeBrush(5, shape="disc")) nmask <- fillHull(nmask) nmask <- bwlabel(nmask) ctmask <- opening(cel>0.1, makeBrush(5, shape="disc")) cmask <- propagate(cel, nmask, ctmask) res <- paintObjects(cmask, img, col="#FF00FF") res <- paintObjects(nmask, res, col="#FFFF00") # hullFeatures は使えなくなっている。 # computeFeatures.moment で細胞の座標 # computeFeatures.shape で細胞の体積、というか面積が計算できる。 xy <- computeFeatures.moment(cmask@.Data[,,1])[,c("m.cx", "m.cy")] labels <- as.character(1:nrow(xy)) cols <- c(grey(seq(1, 0, length=100))) xlim <- nrow(nuc@.Data) ylim <- ncol(nuc@.Data) # ヒートマップでゴリ押し # 細胞境界はresに入っている。 par(mar=rep(0.5, 4)) image(seq(xlim), seq(ylim), res@.Data[,,2,1], col=cols, xlab="", ylab="", axes=FALSE, frame=FALSE) text(xy, labels, col="blue", xpd=TRUE)
