Bioconductor/BioImageDbsパッケージの使い方〜深層学習用の画像アレイデータを取得する〜

画像アレイデータを提供するexperimentHubパッケージ

BioImageDbsパッケージは、Rで可読なフォーマット(.Rds)で、 深層学習(DL)用の画像アレイデータ(4次元あるいは5次元)を 提供するexperimentHubパッケージである。

今回、BioImageDbsパッケージの使用方法を解説する。

BioImageDbsのインストール

まずは、Bioconductor関連のパッケージも含めて、インストールする。

#インストール
install.packages("BiocManager")
BiocManager::install("ExperimentHub")
BiocManager::install("BioImageDbs")
install.packages("magick")

#ロード
library(ExperimentHub)
library(BioImageDbs)

BioImageDbsのデータセット表示

2021-05-18のスナップショットには、23 個のレコードが登録されています。

3D電顕解析で得られた神経系のデータセット、タイムラプスの細胞時系列データなどがあります。

#事前セットアップ
eh <- ExperimentHub()

#BioImageの情報取得
query(eh, "BioImageDbs")

#ExperimentHub with 23 records
# snapshotDate(): 2021-05-18
# $dataprovider: CELL TRACKING CHALLENGE (http://celltracki...
# $species: Homo sapiens, Mus musculus, Drosophila melanoga...
# $rdataclass: List, magick-image
# additional mcols(): taxonomyid, genome, description,
#   coordinate_1_based, maintainer, rdatadateadded,
#   preparerclass, tags, rdatapath, sourceurl, sourcetype 
# retrieve records with, e.g., 'object[["EH6095"]]' 
#
#           title                                             
#  EH6095 | EM_id0001_Brain_CA1_hippocampus_region_5dTensor...
#  EH6096 | EM_id0001_Brain_CA1_hippocampus_region_5dTensor...
#  EH6097 | EM_id0002_Drosophila_brain_region_5dTensor.rds    
#  EH6098 | EM_id0002_Drosophila_brain_region_5dTensor_trai...
#  EH6099 | LM_id0001_DIC_C2DH_HeLa_4dTensor.rds              
#  ...      ...                                               
#  EH6113 | LM_id0003_Fluo_N2DH_GOWT1_5dTensor.rds            
#  EH6114 | EM_id0003_J558L_4dTensor.rds                      
#  EH6115 | EM_id0003_J558L_4dTensor_train_dataset.gif        
#  EH6116 | EM_id0004_PrHudata_4dTensor.rds                   
#  EH6117 | EM_id0004_PrHudata_4dTensor_train_dataset.gif

画像アレイデータのダウンロード

(1) EM_id0001_Brain_CA1_hippocampus_region

画像セグメンテーション用の2値化ラベル付き5次元アレイ。 電子顕微鏡（FIB-SEM）画像の3Dセグメンテーションデータセット（1065x2048x1536ボリューム、約5x5x5nmの解像度）で、 マウス脳のCA1海馬領域にあるミトコンドリアのバイナリーラベル付き画像を含む。

#EM_id0001の情報取得
qr <- query(eh, c("BioImageDbs", "EM_id0001"))

#タイトルの表示
mcols(qr)$title
#[1] "EM_id0001_Brain_CA1_hippocampus_region_5dTensor.rds"              
#[2] "EM_id0001_Brain_CA1_hippocampus_region_5dTensor_train_dataset.gif"

#詳細情報
qr[1]
#ExperimentHub with 1 record
# snapshotDate(): 2021-05-18
# names(): EH6095
# package(): BioImageDbs
# $dataprovider: https://www.epfl.ch/labs/cvlab/data/data-em/
# $species: Mus musculus
# $rdataclass: List
# $rdatadateadded: 2021-05-18
# $title: EM_id0001_Brain_CA1_hippocampus_region_5dTensor.rds
# $description: 5D arrays with the binary label for the ima...
# $taxonomyid: 10090
# $genome: NA
# $sourcetype: PNG
# $sourceurl: https://github.com/kumeS/BioImageDbs
# $sourcesize: NA
# $tags: c("3D images", "bioimage", "CellCulture",
#   "electron microscopy", "microscope", "scanning
#   electron microscopy", "segmentation", "Tissue") 
# retrieve record with 'object[["EH6095"]]' 

#アレイデータのダウンロード
ImageData <- qr[[1]]

#アレイデータの詳細表示
str(ImageData$Train)
#List of 2
# $ Train_Original   : num [1, 1:1024, 1:768, 1:165, 1] 0.4 0.518 0.471 0.537 0.51 ...
# $ Train_GroundTruth: num [1, 1:1024, 1:768, 1:165, 1] 0 0 0 0 0 0 0 0 0 0 ...

str(ImageData$Test)
#List of 2
# $ Test_Original   : num [1, 1:1024, 1:768, 1:165, 1] 0.569 0.514 0.475 0.482 0.533 ...
# $ Test_GroundTruth: num [1, 1:1024, 1:768, 1:165, 1] 0 0 0 0 0 0 0 0 0 0 ...

#動画データ(.gif)の表示
magick::image_read(qr[[2]])

ここで、qr[]でメタデータにアクセスできる。

また、qr[[]]で実データにアクセスできる。

(2) LM_id0001_DIC_C2DH_HeLa

2D画像セグメンテーション用のHeLa細胞の4次元アレイデータである。 オリジナルデータとマルチラベルが付与された教師画像データのセットである。 データセットの画像は、対物レンズにPlan-Apochromat 63x/1.4（oil）を使用したZeiss LSM 510 Metaで撮影された。

#LM_id0001の情報取得
qr <- query(eh, c("BioImageDbs", "LM_id0001"))

#タイトルの表示
mcols(qr)$title
#[1] "LM_id0001_DIC_C2DH_HeLa_4dTensor.rds"                     
#[2] "LM_id0001_DIC_C2DH_HeLa_4dTensor_train_dataset.gif"       
#[3] "LM_id0001_DIC_C2DH_HeLa_4dTensor_Binary.rds"              
#[4] "LM_id0001_DIC_C2DH_HeLa_4dTensor_Binary_train_dataset.gif"
#[5] "LM_id0001_DIC_C2DH_HeLa_5dTensor.rds" 

#詳細情報
qr[1]
#ExperimentHub with 1 record
# snapshotDate(): 2021-05-18
# names(): EH6099
# package(): BioImageDbs
# $dataprovider: CELL TRACKING CHALLENGE (http://celltrackingchallenge.net/2d-datasets/)
# $species: Homo sapiens
# $rdataclass: List
# $rdatadateadded: 2021-05-18
# $title: LM_id0001_DIC_C2DH_HeLa_4dTensor.rds
# $description: 4D arrays with the multi-labels for the image segmentation. Human HeLa ...
# $taxonomyid: 9606
# $genome: NA
# $sourcetype: PNG
# $sourceurl: https://github.com/kumeS/BioImageDbs
# $sourcesize: NA
# $tags: c("bioimage", "cell tracking", "CellCulture", "microscope",
#   "segmentation", "Tissue") 
# retrieve record with 'object[["EH6099"]]' 

#アレイデータのダウンロード
ImageData <- qr[[1]]

#アレイデータの詳細表示
str(ImageData$Train)
#List of 2
# $ Train_Original   : num [1:84, 1:512, 1:512, 1] 0.518 0.455 0.455 0.447 0.439 ...
# $ Train_GroundTruth: num [1:84, 1:512, 1:512, 1] 0 0 0 0 0 0 0 0 0 0 ...

str(ImageData$Test)
#List of 2
# $ Test_Original   : num [1:84, 1:512, 1:512, 1] 0.604 0.467 0.459 0.435 0.408 ...
# $ Test_GroundTruth: num [1:84, 1:512, 1:512, 1] 0 0.671 0.671 0.851 0.851 ...

#詳細情報
qr[2]
#ExperimentHub with 1 record
# snapshotDate(): 2021-05-18
# names(): EH6100
# package(): BioImageDbs
# $dataprovider: CELL TRACKING CHALLENGE (http://celltrackingchallenge.net/2d-datasets/)
# $species: Homo sapiens
# $rdataclass: magick-image
# $rdatadateadded: 2021-05-18
# $title: LM_id0001_DIC_C2DH_HeLa_4dTensor_train_dataset.gif
# $description: A animation file (.gif) of the train dataset of LM_id0001_DIC_C2DH_HeLa...
# $taxonomyid: 9606
# $genome: NA
# $sourcetype: PNG
# $sourceurl: https://github.com/kumeS/BioImageDbs
# $sourcesize: NA
# $tags: c("animation", "bioimage", "cell tracking", "CellCulture",
#   "microscope", "segmentation", "Tissue") 
# retrieve record with 'object[["EH6100"]]' 

#動画データ(.gif)の表示
magick::image_read(qr[[2]])

【Rでの文字列処理シリーズ（その４）】文字列の近似的文字列マッチング

はじめに

文字列処理・テキスト処理とは、プログラミングを行うなかで、文字列・テキストに対する色々な操作のことを指します。それら処理をうまく使いこなすことで、文字列を自由に処理できるようになります。文字列処理の活用事例は、キーワード抽出、テキスト分類、テキストマイニングの前処理など、多岐に渡ります。 今回の「Rでの文字列処理」シリーズで扱う、文字列処理のライブラリ・関数群やプログラムコードは、R環境上で無料で提供されている、オープン・ソフトウェアを用います。

この記事では、主に、baseやstringr、stringdistとかのパッケージを扱い、Rでの文字列処理についていろいろと試してまとめてみました。主題としては、文字列距離を使って、近似的文字列をマッティングする方法を紹介します。

テキスト処理の関連記事

skume.net

skume.net

skume.net

skume.net

skume.net

skume.net

下準備について

########################
#シリーズ共通
########################
#必要なパッケージの読み込み
require(readr)
require(stringr)
require(stringdist)

近似的文字列マッティング

agrep ＆ agrepl 関数

agrep/agrepl関数は、近似的文字列マッティング（あいまい一致)を提供する。

これらの関数は、一般化レーベンシュタイン編集距離(generalized Levenshtein edit distance) *1 を用いて、文字列 x（第2引数）の各要素内で、pattern（第1引数）に近似的にマッチするものを検索する。

ここでは、T/Fで結果が出力される、agrepl関数を扱う。

#対象パターンの文字列
ex0 <- "abcd"

#検索対象
ex1 <- c("a", "ab", "abc", "abd", "abcd", "cdab", "edcba", "abcdefg")

#基本出力
base::agrepl(pattern=ex0, x=ex1, max.distance = 0.1)
#[1] FALSE FALSE  TRUE  TRUE  TRUE FALSE FALSE  TRUE

#域値を変えた出力結果
#max.distance = 0
ex1[base::agrepl(pattern=ex0, x=ex1, max.distance = 0)]
#[1] "abcd"    "abcdefg"

#max.distance = 0.1
ex1[base::agrepl(pattern=ex0, x=ex1, max.distance = 0.1)]
#[1] "abc"     "abd"     "abcd"    "abcdefg"

#max.distance = 0.3
ex1[base::agrepl(pattern=ex0, x=ex1, max.distance = 0.3)]
#[1] "ab"      "abc"     "abd"     "abcd"    "cdab"    "abcdefg"

adist 関数

adist関数は、文字ベクトル間の近似的な文字列距離を計算する。 これで出力される距離は、一般化Levenshtein（編集）距離である。

# Approximate String Distances
adist(ex0,  ex1)
#     [,1] [,2] [,3] [,4] [,5] [,6] [,7] [,8]
#[1,]    3    2    1    1    0    4    4    3

stringdist / stringdistmatrix関数で、文字列間の距離指標を計算する

stringdist::amatchとstringdist::ainという近似文字列マッチングの関数もあるのだが、 どうも使い勝手が悪くて、stringdist/stringdistmatrix関数を使用する方が良さそうに思う。

現在、stringdistがサポートしている距離指標は、以下の通りである。

手法名	概要
osa	最適文字列アラインメント（制限付きダメラウ・レーベンシュタイン距離）
lv	Levenshtein距離（Rネイティブの adist と同様）
dl	Full Damerau-Levenshtein 距離
hamming	ハミング距離（aとbの文字数が同じであること）
lcs	最長共通部分文字列の距離
qgram	q-gram距離
cosine	q-gramプロファイル間のコサイン距離
jaccard	q-gramプロファイル間のJaccard距離
jw	Jaro距離、あるいはJaro-Winkler 距離
soundex	soundexエンコーディングに基づく距離

詳細は、ここで確認できる。

search.r-project.org

とりあえず、いつくかの手法で近似的文字列マッティングを実行してみる。

ここでは、表形式で結果が出力されるstringdistmatrix関数を扱う。 使い方は、stringdistとほぼ同じ。

#対象パターンの文字列
ex0 <- "abcd"

#検索対象
ex2 <- c("a", "ab", "abc", "abd", "cdab", "edcba", "abcdefg")

#Optimal string aligment (osa)
stringdist::stringdistmatrix(a=ex0, b=ex2, method="osa", nthread=2, useNames="strings")
#     a ab abc abd cdab edcba abcdefg
#abcd 3  2   1   1    4     4       3

#Levenshtein distance
stringdist::stringdistmatrix(a=ex0, b=ex2, method="lv", nthread=2, useNames="strings")
#     a ab abc abd cdab edcba abcdefg
#abcd 3  2   1   1    4     4       3

#Full Damerau-Levenshtein distance
stringdist::stringdistmatrix(a=ex0, b=ex2, method="dl", nthread=2, useNames="strings")
#     a ab abc abd cdab edcba abcdefg
#abcd 3  2   1   1    4     4       3

#Longest common substring distance
stringdist::stringdistmatrix(a=ex0, b=ex2, method="lcs", nthread=2, useNames="strings")
#     a ab abc abd cdab edcba abcdefg
#abcd 3  2   1   1    4     7       3

#q-gram distance (q=1)
stringdist::stringdistmatrix(a=ex0, b=ex2, method="qgram", nthread=2, q=1, useNames="strings")
#     a ab abc abd cdab edcba abcdefg
#abcd 3  2   1   1    0     1       3

#q-gram distance (q=2)
stringdist::stringdistmatrix(a=ex0, b=ex2, method="qgram", nthread=2, q=2, useNames="strings")
#     a ab abc abd cdab edcba abcdefg
#abcd 3  2   1   3    2     7       3

#q-gram distance (q=3)
stringdist::stringdistmatrix(a=ex0, b=ex2, method="qgram", nthread=2, q=3, useNames="strings")
#     a ab abc abd cdab edcba abcdefg
#abcd 2  2   1   3    4     5       3

#cosine distance between q-gram profiles (q=1)
stringdist::stringdistmatrix(a=ex0, b=ex2, method="cosine", nthread=2, q=1, useNames="strings")
#       a        ab       abc       abd cdab     edcba   abcdefg
#abcd 0.5 0.2928932 0.1339746 0.1339746    0 0.1055728 0.2440711

#cosine distance between q-gram profiles (q=2)
stringdist::stringdistmatrix(a=ex0, b=ex2, method="cosine", nthread=2, q=2, useNames="strings")
#       a        ab       abc       abd      cdab edcba   abcdefg
#abcd NaN 0.4226497 0.1835034 0.5917517 0.3333333     1 0.2928932

#cosine distance between q-gram profiles (q=3)
stringdist::stringdistmatrix(a=ex0, b=ex2, method="cosine", nthread=2, q=3, useNames="strings")
#       a  ab       abc abd cdab edcba   abcdefg
#abcd NaN NaN 0.2928932   1    1     1 0.3675445

#Jaccard distance between q-gram profiles (q=1)
stringdist::stringdistmatrix(a=ex0, b=ex2, method="cosine", nthread=2, q=1, useNames="strings")
#       a        ab       abc       abd cdab     edcba   abcdefg
#abcd 0.5 0.2928932 0.1339746 0.1339746    0 0.1055728 0.2440711

#Jaccard distance between q-gram profiles (q=2)
stringdist::stringdistmatrix(a=ex0, b=ex2, method="cosine", nthread=2, q=2, useNames="strings")
#       a        ab       abc       abd      cdab edcba   abcdefg
#abcd NaN 0.4226497 0.1835034 0.5917517 0.3333333     1 0.2928932

#Jaccard distance between q-gram profiles (q=3)
stringdist::stringdistmatrix(a=ex0, b=ex2, method="cosine", nthread=2, q=3, useNames="strings")
#       a  ab       abc abd cdab edcba   abcdefg
#abcd NaN NaN 0.2928932   1    1     1 0.3675445

#Jaro-Winkler distance
stringdist::stringdistmatrix(a=ex0, b=ex2, method="jw", nthread=2, useNames="strings")
#        a        ab        abc        abd cdab     edcba   abcdefg
#abcd 0.25 0.1666667 0.08333333 0.08333333    1 0.5166667 0.1428571

#  Distance based on soundex encoding
stringdist::stringdistmatrix(a=ex0, b=ex2, method="soundex", nthread=2, useNames="strings")
#     a ab abc abd cdab edcba abcdefg
#abcd 1  1   1   1    1     1       0

あとがき

どうも、osaとかlvとかの整数値の結果よりも、 cosine類似度かJaccard距離、Jaro-Winkler距離で計算して、 小数点以下の数値結果が返ってくる方が何だか計算したっ感じになるのは私だけだろうか。

参考資料

www.karada-good.net

www.okadajp.org

http://finzi.psych.upenn.edu/library/stringdist/html/amatch.htmlfinzi.psych.upenn.edu

https://journal.r-project.org/archive/2014-1/loo.pdfjournal.r-project.org

*1:ある文字列を別文字列に変換するのに必要な挿入、削除、置換の最小の重み付けされた数

【Rのジミ〜な小技シリーズ】Rコンソールにカラーテキストを表示するTips

はじめに

R言語で、message()関数を使うと、赤い文字列がコンソールに表示されるけど、 もっとほかの色で、コンソール表示ができれば良いのにとか思ったりしないでしょうか？？

今回、こういう細かい悩みを解決する記事を書いてみました。

base::message()関数

messageはデフォルトで使えて、通常、赤文字で出力される。

message(1)
message("Hello world!")

Crayon - stylish terminal output in R

Crayonは、Colored terminal output on terminalsを可能にしてくれるパッケージである。

さっそく、インストールしてみる。

Crayonのインストール

devtools::install_github("gaborcsardi/crayon")
library(crayon)

実行

実行時には、message()あるいはcat()を使う。

#ブラック
cat(black("Hello world!"))
#ブルー
cat(blue("Hello world!"))
#ミドリ
cat(green("Hello world!"))
#マジェンダ
cat(magenta("Hello world!"))
#シアン
cat(cyan("Hello world!"))

#背景ブラック、文字白
cat(bgBlack(white("Hello world!")))
#背景赤、文字白
cat(bgRed(white("Hello world!")))
#背景ミドリ、文字白
cat(bgGreen(white("Hello world!")))
#背景イエロー、文字白
cat(bgYellow(white("Hello world!")))
#背景ブルー、文字白
cat(bgBlue(white("Hello world!")))
#背景マジェンダ、文字白
cat(bgMagenta(white("Hello world!")))
#背景シアン、文字白
cat(bgCyan(white("Hello world!")))

textcolor: Colourise text for display in the terminal.

GerminaRパッケージ内のtextcolorでも、カラーテキスト出力がサポートされている。

GerminaRのインストール

install.packages("GerminaR")
library(GerminaR)

メモ: intiパッケージにも同じ関数がある。

実行

textcolor関数で使えるカラーパレットは、 black, blue, brown, cyan, dark gray, green, light blue, light cyan, light gray, light green, light purple, light red, purple, red, white, yellow らしいです。

実行時には、message()あるいはcat()で出力させる。

ただ、背景色はうまく表示されない。。

#ブルー
message(textcolor("Hello world!", fg = "blue"))
cat(textcolor("Hello world!", fg = "blue"))

#ダークグレイ
message(textcolor("Hello world!", fg = "dark gray"))
cat(textcolor("Hello world!", fg = "dark gray"))

#パープル
message(textcolor("Hello world!", fg = "purple"))
cat(textcolor("Hello world!", fg = "purple"))

#ブラウン
message(textcolor("Hello world!", fg = "brown"))
cat(textcolor("Hello world!", fg = "brown"))

【Rのジミ〜な小技シリーズ】

skume.net

skume.net

skume.net

skume.net

skume.net

skume.net

skume.net

skume.net

skume.net

参考資料

stackoverflow.com

rdrr.io

rdrr.io