グラム染色をしている。
グラム染色をしたあとで顕微鏡で観察し、写真をとる。
適当に画像を分割して菌体が観察できている視野を水増ししてdeep learning の学習データ用になんとかする。
こんな感じの画像が撮れる。
これは大腸菌を分離してグラム染色したものである。グラム染色的には陰性で、桿菌である。
この画像のうち、顕微鏡で覗いた感が満載の黒丸の内部の領域を100pix四方くらいの適当なサイズでたくさん切り出したい。
黒い部分は色データ的には低い値がはいっているので、x軸(y軸)の適当なところで線を引くとこんな感じになる。
ここで適当な閾値以上の値が連続している長さをrle 関数で取得し、x軸とy軸で最長になる箇所が交差するところを中心座標として、そこから適当に何枚か取ってくる。
黄色の点で囲まれた箇所をとってくるが、黒丸にかぶる部分はこれまた適当に、切り出した画像の何割が真っ黒か閾値を設定して除外する。
すると、こんな画像が取れるが
菌がいないこんな画像ももちろん取れる。
これをEBimageを使って、菌が適当な数いるものだけ検出しようとするのだが
画像処理の閾値の設定が面倒なので保留。
こんな感じで2000*3000くらいのスマホ画像から128*128の画像を200枚くらい切り出してデータを水増しできる。
library(png) library(jpeg) library(EBImage) files <- "上の画像のURLで読み込めるぞ" pix <- 128 # 切り出しサイズ n <- 9 # 中心からどれくらいずらすか z <- readImage(files) Z <- z[,,1]+z[,,2]+z[,,3] r <- mapply(function(x) apply(Z<0.3, x, rle), 1:2) # 円の中心を出す s1 <- sapply(mapply(function(y) mapply(function(x) max(x$length[!x$values]), y), r), which.max) # 中心座標 x0 <- s1[1]; y0 <- s1[2] x1 <- x0 + (-n:n)*pix x1 <- x1[0<x1 & x1<nrow(Z)] y1 <- y0 + (-n:n)*pix y1 <- y1[0<y1 & y1<ncol(Z)] # プロット cols <- grey(seq(0, 1, length=1000)) par(mar=rep(0, 4)) image(seq(nrow(z)), seq(ncol(Z)), Z, col=cols) for(i in 1:(length(x1)-1)){ for(j in 1:(length(y1)-1)){ points(x1[i], y1[j], pch=16, col="yellow", cex=1) } } # ファイル切り出し outdir <- "/gram/fig/" pb <- txtProgressBar(max=length(files), style=3) for(f in seq(files)){ setTxtProgressBar(pb, f) count <- 1 z <- readImage(files[f]) Z <- z[,,1]+z[,,2]+z[,,3] r <- mapply(function(x) apply(Z<0.3, x, rle), 1:2) s1 <- sapply(mapply(function(y) mapply(function(x) max(x$length[!x$values]), y), r), which.max) x0 <- s1[1]; y0 <- s1[2] x1 <- x0 + (-n:n)*pix x1 <- x1[0<x1 & x1<nrow(Z)] y1 <- y0 + (-n:n)*pix y1 <- y1[0<y1 & y1<ncol(Z)] for(i in 1:(length(x1)-1)){ for(j in 1:(length(y1)-1)){ tmpz <- z[x1[i]:x1[i+1]-1, y1[j]:y1[j+1]-1,] if(sum(tmpz[,,1] < 0.01)/length(tmpz[,,1]) < 0.01){ filename <- paste(c(rep("0", 6-length(strsplit(as.character(count), "")[[1]])), count, ".jpg"), sep="", collapse="") filename <- paste(gsub(".JPG", "", gsub("DSC_", "", files[f])), filename, sep="_") filename <- paste(outdir, filename, sep="") writeImage(tmpz, filename) count <- count + 1 } } } } # EBimageによる処理 nuc <- readImage("上の小さい「こんな画像」のURL") nuc <- flip(nuc) # プロットの体裁用に反転させておく nmask <- thresh(nuc, 10, 10, 0.008) # 閾値をいじる必要がある nmask <- opening(nmask, makeBrush(5, shape="diamond")) 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("こちらはローカルに持っていないと読み込めない") 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)
