京橋のバイオインフォマティシャンの日常

南国のビーチパラソルの下で、Rプログラムを打ってる日常を求めて、、Daily Life of Bioinformatician in Kyobashi of Osaka

R言語で、jsTree・jsTreeR パッケージを使った、 インタラクティブなツリーリスト表示をやってみた件

はじめに

Rで、インタラクティブに開閉できる、ツリー構造表示をやってみたくて、ちょっと関連パッケージを調べてみた。。

そうすると、jsTreeとjsTreeRというRパッケージがあることが分かった*1

jsTreeもjsTreeRも同じく、バックエンドはjsライブラリのjsTreeを使ってる。

jsTreeの方は、事前のデータ作成が簡単である。ただ、表示レイアウトはイマイチかも。一方、jsTreeRの方は、リスト作成が面倒だけど、細かくアイコンやグリッドなどの設定ができるという印象。

jsTreeを使ったツリーリスト表示

事前準備をする

#jsTreeパッケージのロード
#install.packages("jsTree")
library(jsTree)

#関連パッケージのロード
#install.packages("magrittr")
library(magrittr)
#install.packages("htmlwidgets")
library(htmlwidgets)
#install.packages("htmltools")
library(htmltools)

#データ・ロード
data(states)
data(ToothGrowth)

jsTreeを使った実行例(1)

#フォルダ構造の可視化
list <- list.files(full.names = TRUE, recursive = FALSE)
jsTree(list)

jsTree(list) %>%
  htmlwidgets::saveWidget(paste0("list_", format(Sys.time(), "%y%m%d"),".html"))

jsTreeを使った実行例(2)

head(states)
#  state.region     state.division state.name   variable   value
#1        South East South Central    Alabama Population 3615.00
#2        South East South Central    Alabama     Income 3624.00
#3        South East South Central    Alabama Illiteracy    2.10
#4        South East South Central    Alabama   Life.Exp   69.05
#5        South East South Central    Alabama     Murder   15.10
#6        South East South Central    Alabama    HS.Grad   41.30

#カラムを"/"区切りテキストに変換する
nested_text <- apply(states, 1, paste, collapse='/')
jsTree::jsTree(nested_text)

#htmlにて保存
jsTree::jsTree(nested_text) %>%
  htmlwidgets::saveWidget(paste0("nested_text_", format(Sys.time(), "%y%m%d"),".html"))

jsTreeを使った実行例(3)

#特定のフィールドにチェックを付けて表示
nodestate1 <- states$variable=='Area'
jsTree::jsTree(nested_text, nodestate=nodestate1)

#htmlにて保存
jsTree::jsTree(nested_text, nodestate=nodestate1) %>%
  htmlwidgets::saveWidget(paste0("nested_text_nodestate_", format(Sys.time(), "%y%m%d"),".html"))

jsTreeを使った実行例(4)

#ToothGrowthの場合
head(ToothGrowth)
#   len supp dose
#1  4.2   VC  0.5
#2 11.5   VC  0.5
#3  7.3   VC  0.5
#4  5.8   VC  0.5
#5  6.4   VC  0.5
#6 10.0   VC  0.5

#カラム順を変えて、実行
ToothGrowth_text <- apply(ToothGrowth[,c(2,3,1)], 1, paste, collapse='/')
jsTree::jsTree(ToothGrowth_text)

#htmlにて保存
jsTree::jsTree(ToothGrowth_text) %>%
  htmlwidgets::saveWidget(paste0("ToothGrowth_text_", format(Sys.time(), "%y%m%d"),".html"))

jsTreeRを使ったツリーリスト表示

事前準備をする

#jsTreeRパッケージのロード
#install.packages("jsTreeR")
library(jsTreeR)

#関連パッケージのロード
#install.packages("magrittr")
library(magrittr)
#install.packages("htmlwidgets")
library(htmlwidgets)
#install.packages("htmltools")
library(htmltools)

jsTreeRを使った実行例(1)

#ノードデータ作成(デフォルト)
nodes <- list(
  list( text = "RootA", type = "root",
        children = list(
          list( text = "ChildA1", type = "child" ),
          list( text = "ChildA2", type = "child" ))),
  list( text = "RootB", type = "root",
        children = list(
          list( text = "ChildB1", type = "child" ),
          list( text = "ChildB2", type = "child" ))))

#アイコン設定
types <- list(
  root = list( icon = "glyphicon glyphicon-ok" ),
  child = list( icon = "glyphicon glyphicon-file" ))

jsTreeR::jstree( nodes, types = types, dragAndDrop = TRUE, search=T)

#htmlにて保存
jsTreeR::jstree( nodes, types = types, dragAndDrop = TRUE, search=T) %>%
  htmltools::save_html(paste0("jstreeR_01_", format(Sys.time(), "%y%m%d"),".html"))

jsTreeRを使った実行例(2)

#ノードデータ作成(デフォルト)with 'grid' option
nodes <- list(
  list(text = "Products", 
       state = list( opened = TRUE ),
       type = "A",
       children = list(
         list( text = "Fruit",
               state = list( opened = TRUE ),
               type = "B",
               children = list(
                 list( text = "Apple", data = list( price = 0.1, quantity = 20 )),
                 list( text = "Banana", data = list( price = 0.2, quantity = 31 ), type = "K"),
                 list( text = "Grapes", data = list( price = 1.99, quantity = 34 ), type = "I"),
                 list( text = "Mango", data = list( price = 0.5, quantity = 8 ), type = "J"),
                 list( text = "Melon", data = list( price = 0.8, quantity = 4), type = "f"),
                 list( text = "Pear", data = list( price = 0.1, quantity = 30 ), type = "G"),
                 list( text = "Strawberry", data = list( price = 0.15, quantity = 32 ), type = "H"))),
         list( text = "Vegetables",
               state = list( opened = TRUE ),
               type = "C",
               children = list( 
                 list( text = "Aubergine", data = list( price = 0.5, quantity = 8 ), type = "D"),
                 list( text = "Broccoli", data = list( price = 0.4, quantity = 22 ), type = "D"),
                 list(text = "Carrot", data = list( price = 0.1, quantity = 32 ), type = "D"),
                 list( text = "Cauliflower", data = list( price = 0.45, quantity = 18), type = "E"),
                 list( text = "Potato", data = list( price = 0.2, quantity = 38 ), type = "E"))))
       ))

#グリッド設定
grid <- list(
  columns = list(
    list( width = 200, header = "Name" ),
    list( width = 150, value = "price", header = "Price" ),
    list( width = 150, value = "quantity", header = "Qty" )),
  width = 500)

#アイコン設定
types <- list(
  A = list( icon = "glyphicon glyphicon-ok" ),
  B = list( icon = "glyphicon glyphicon-file" ),
  C = list( icon = "glyphicon glyphicon-leaf" ),
  D = list( icon = "glyphicon glyphicon-flash" ),
  E = list( icon = "glyphicon glyphicon-plus" ),
  f = list( icon = "glyphicon glyphicon-home" ),
  G = list( icon = "glyphicon glyphicon-arrow-right" ),
  H = list( icon = "glyphicon glyphicon-apple" ),
  I = list( icon = "glyphicon glyphicon-star" ),
  J = list( icon = "glyphicon glyphicon-eye-open"),
  K = list( icon = "glyphicon glyphicon-asterisk"))

#リスト可視化
jsTreeR::jstree(nodes, grid = grid, types = types, dragAndDrop = TRUE)

#htmlにて保存
jsTreeR::jstree(nodes, grid = grid, types = types, dragAndDrop = TRUE) %>%
  htmltools::save_html(paste0("jstreeR_02_", format(Sys.time(), "%y%m%d"),".html"))

組込アイコンの参照HP

getbootstrap.com

bootstrap3.cyberlab.info

jsTreeRを使った実行例(3) - 別の記述法でノードデータを作成するTips

後々、プログラムを回してノードデータ作成を行うなら、デフォルトよりも、こう書く方が良い。

#ノードデータ作成
#1段目
nodes00 <- list(list(text = "Products", state = list( opened = TRUE ), children = list()))
#2段目
nodes00[[1]]$children[[1]] <- list(text = "Fruit", state = list( opened = TRUE ), children = list())
nodes00[[1]]$children[[2]] <- list(text = "Vegetables", state = list( opened = TRUE ), children = list())
#3段目: Fruitの下位
nodes00[[1]]$children[[1]]$children[[1]] <- list( text = "Apple", data = list( price = 0.1, quantity = 20 ))
nodes00[[1]]$children[[1]]$children[[2]] <- list( text = "Banana", data = list( price = 0.2, quantity = 31 ))
nodes00[[1]]$children[[1]]$children[[3]] <- list( text = "Grapes", data = list( price = 1.99, quantity = 34 ))
nodes00[[1]]$children[[1]]$children[[4]] <- list( text = "Mango", data = list( price = 0.5, quantity = 8 ))
nodes00[[1]]$children[[1]]$children[[5]] <- list( text = "Melon", data = list( price = 0.8, quantity = 4))
nodes00[[1]]$children[[1]]$children[[6]] <- list( text = "Pear", data = list( price = 0.1, quantity = 30 ))
nodes00[[1]]$children[[1]]$children[[7]] <- list( text = "Strawberry", data = list( price = 0.15, quantity = 32 ))
#3段目: Vegetables
nodes00[[1]]$children[[2]]$children[[1]] <- list( text = "Aubergine", data = list( price = 0.5, quantity = 8 ))
nodes00[[1]]$children[[2]]$children[[2]] <- list( text = "Broccoli", data = list( price = 0.4, quantity = 22 ))
nodes00[[1]]$children[[2]]$children[[3]] <- list(text = "Carrot", data = list( price = 0.1, quantity = 32 ))
nodes00[[1]]$children[[2]]$children[[4]] <- list( text = "Cauliflower", data = list( price = 0.45, quantity = 18))
nodes00[[1]]$children[[2]]$children[[5]] <- list( text = "Potato", data = list( price = 0.2, quantity = 38 ))

#リスト可視化
jsTreeR::jstree(nodes00, grid = grid, dragAndDrop = TRUE)

#htmlにて保存
jsTreeR::jstree(nodes00, grid = grid, dragAndDrop = TRUE) %>%
  htmltools::save_html(paste0("jstreeR_03_", format(Sys.time(), "%y%m%d"),".html"))

補足

テーマの設定

#theme="default-dark"
jsTreeR::jstree(nodes00, grid = grid, dragAndDrop = TRUE, theme="default-dark")
#theme="proton"
jsTreeR::jstree(nodes00, grid = grid, dragAndDrop = TRUE, theme="proton")

参考資料

www.rdocumentation.org

www.rdocumentation.org

github.com

github.com

mbraak.github.io

*1:紛らわしい名前の付け方だよね。。。

R言語で、サイコロ・ゲームを一様分布に従う確率でシミュレーションしてみた件

サイコロゲーム - 序章

サイコロを振って、1から6のそれぞれの目が出る確率は、等しいと仮定する。

いわゆる、一様分布に従うと考える。

Rでは、一様分布に従う、1〜6までの整数値の乱数は、以下で表される。

as.integer( runif(1, min = 1, max = 7) )  

この乱数で、サイコロの振る舞いはシミュレーションできるので、ちょっとしたアニメーションを作ってみた。

デフォルト設定だと、6の目が出ずに、サイコロを10回振り切れれば、ゲーム・クリアという設定にしてみた。

#下記のSaikoroGame関数をコピペせずに、Gitからsourceする
source("https://gist.githubusercontent.com/kumeS/a4c708ed1a9b73e886313389980c4793/raw/b2f9dab698cb3332ff835fe8a8f7d9cd1fd40fcd/SaikoroGame.R")

#実行01: デフォ実行 + 保存
SaikoroGame()

実行結果(1)

https://kumes.github.io/Blog/SaikoroGame/Animation_SaikoroGame03.gif

#実行02: おまけ写真付き + 保存
SaikoroGame(Saikoro=T)

#save実行時(GIF動画作成)には、事前に、ImageMagickをインストール
#save機能は、Macのみ実行可能である
#SaikoroGame(save=T)
#SaikoroGame(Saikoro=T, save=T)

実行結果(2)

https://kumes.github.io/Blog/SaikoroGame/Animation_SaikoroGame05.gif

(GIF動画作成の場合)ImageMagickのインストール

ターミナルを起動して、brewコマンドで、ImageMagickをインストールする。

brew install imagemagick

過去の参考記事

skume.net

SaikoroGame 関数

#パッケージのインストール・ロード
if(!require("plotrix")){install.packages("plotrix")}
if(!require("EBImage")){install.packages("EBImage")}
if(!require("beepr")){install.packages("beepr")}

library(plotrix)
library(EBImage)
library(beepr)

#環境変数を消す
rm(list=ls())

#関数の作成
SaikoroGame <- function(N=6, save=F, Saikoro=F, Sound=F){
#変数の準備
a = c(1:10)

#オプション設定
par(mfrow = c(1,1), family="HiraKakuProN-W3",
    cex=1, mgp=c(2.5, 1, 0), mai=c(0.5, 0.5, 0.5, 0.5), xpd=F)

#空枠の作成
plot(a, a, type="n", axes=F, xlab=NA, ylab=NA, xlim=c(0,11), ylim=c(0,11),
     main=paste0("「サイコロ ", N, " が出たらダメよ」ゲーム"), xaxs="i", yaxs="i")

#区切り線の作成
abline(h=a); abline(h=c(0, 11))
abline(v=a); abline(v=c(0, 11))

if(Saikoro){
ff <- as.raster(EBImage::readImage("https://kumes.github.io/Blog/SaikoroGame/Dice.png", type = "png"))
par(xpd=T)
rasterImage(ff,
            xleft=-0.5, xright=1, 
            ybottom=10, ytop=12)  
par(xpd=F)
}

#試行回数、回数を記載
text(a+0.5, 10.5, labels=paste0(a, "回目"), cex=0.75)
text(0.5, a-0.5, labels=rev(paste0("試行 ", a)), cex=0.75)

#試行回数
n <- 0

#ゲーム実行
repeat{
n <- n + 1
x <- 0
Fin <- FALSE

repeat{
if(save){
  DPI <- ifelse(Saikoro, 100, 300)
  quartz.save(file = paste0("./SaikoroGame_", formatC(n, width=2, flag=0), "_", 
                                       formatC(x, width=2, flag=0), ".png"), 
                         type = "png", dpi = DPI)}
Sys.sleep(1)
#回数
x <- x + 1

#1〜6までの一様分布
b <- as.integer( runif(1, min = 1, max = 7) )  

if(b != N){
  text(x + 0.5, 10.5 - n, labels = b )
  Sys.sleep(0.5); if(Sound){beepr::beep(2)}
  if(save){
    DPI <- ifelse(Saikoro, 100, 300)
    quartz.save(file = paste0("./SaikoroGame_", formatC(n, width=2, flag=0), "_", 
                                       formatC(x, width=2, flag=0), ".png"), 
                         type = "png", dpi = DPI)}
}else{
  text(x + 0.5, 10.5 - n, labels = b )
  if(save){
    DPI <- ifelse(Saikoro, 100, 300)
    quartz.save(file = paste0("./SaikoroGame_", formatC(n, width=2, flag=0), "_", 
                                       formatC(x, width=2, flag=0), "_a.png"), 
                         type = "png", dpi = DPI)}
  Sys.sleep(0.5)
  text(x + 0.5, 10.5 - n, labels = "X", col="red", cex=1.25 )
  if(Sound){beepr::beep(9)}
  if(save){
    DPI <- ifelse(Saikoro, 100, 300)
    quartz.save(file = paste0("./SaikoroGame_", formatC(n, width=2, flag=0), "_", 
                                       formatC(x, width=2, flag=0), "_b.png"), 
                         type = "png", dpi = DPI)}
  break
}
if(x == 10){
  if(Saikoro){
  v <- as.character(as.integer( runif(1, min = 1, max = 11)))
  switch (v,
    "1" = eval(parse(text = paste0('url <- "https://upload.wikimedia.org/wikipedia/commons/c/c4/Suwa-ko_firework_20080815_02.jpg"; type <- "jpg"'))),
    "2" = eval(parse(text = paste0('url <- "https://upload.wikimedia.org/wikipedia/commons/3/3e/MtFuji_FujiCity.jpg"; type <- "jpg"'))),
    "3" = eval(parse(text = paste0('url <- "https://upload.wikimedia.org/wikipedia/commons/5/52/Supermario_Kungsbacka.jpg"; type <- "jpg"'))),
    "4" = eval(parse(text = paste0('url <- "https://upload.wikimedia.org/wikipedia/commons/f/f5/Korean.food-Bibimbap-02.jpg"; type <- "jpg"'))),
    "5" = eval(parse(text = paste0('url <- "https://upload.wikimedia.org/wikipedia/commons/7/75/Ayiin_2020-01-03.jpg"; type <- "jpg"'))),
    "6" = eval(parse(text = paste0('url <- "https://upload.wikimedia.org/wikipedia/commons/2/2b/Lysozyme.png"; type <- "png"'))),
    "7" = eval(parse(text = paste0('url <- "https://upload.wikimedia.org/wikipedia/commons/a/ae/Aomori_Bay_Asamushi_Onsen_Japan02bs5.jpg"; type <- "jpg"'))),
    "8" = eval(parse(text = paste0('url <- "https://upload.wikimedia.org/wikipedia/commons/6/68/Staphylococcus_aureus%2C_50%2C000x%2C_USDA%2C_ARS%2C_EMU.jpg"; type <- "jpg"'))),
    "9" = eval(parse(text = paste0('url <- "https://upload.wikimedia.org/wikipedia/commons/5/57/Red_Fuji_southern_wind_clear_morning.jpg"; type <- "jpg"'))),
    "10" = eval(parse(text = paste0('url <- "https://upload.wikimedia.org/wikipedia/commons/9/97/The_Earth_seen_from_Apollo_17.jpg"; type <- "jpg"')))
  )
  
  ff <- as.raster(EBImage::readImage(url, type = type))  
  rasterImage(ff, 
            xleft=0, xright=11, 
            ybottom=0, ytop=11)
  if(save){
    DPI <- ifelse(Saikoro, 100, 300)
    quartz.save(file = paste0("./SaikoroGame_", formatC(n, width=2, flag=0), "_", 
                                       formatC(x+1, width=2, flag=0), "_a.png"), 
                         type = "png", dpi = DPI)}
  }
  Sys.sleep(1)
  plotrix::boxed.labels(5.5, 5,  "クリアー!!!", col="red",
                      cex=3, bg = "white", xpad = 1.5, ypad = 1.5)
  if(Sound){beepr::beep(8)}
  
  if(save){
    DPI <- ifelse(Saikoro, 100, 300)
    quartz.save(file = paste0("./SaikoroGame_", formatC(n, width=2, flag=0), "_", 
                                       formatC(x+1, width=2, flag=0), "_b.png"), 
                         type = "png", dpi = DPI)}
  options(show.error.messages = F)
  Fin <- TRUE
  break
}}
if(Fin){break}
if(n == 10){
  if(Saikoro){
  url <- "https://upload.wikimedia.org/wikipedia/commons/a/ad/Seikima-II_20100704_Japan_Expo_60.jpg"
  type <- "jpg"
  ff <- as.raster(EBImage::readImage(url, type = type))  
  rasterImage(ff, 
            xleft=0, xright=11, 
            ybottom=0, ytop=11)}
  if(save){
    DPI <- ifelse(Saikoro, 100, 300)
    quartz.save(file = paste0("./SaikoroGame_", formatC(n, width=2, flag=0), "_", 
                                       formatC(x+1, width=2, flag=0), ".png"), 
                         type = "png", dpi = DPI)}
  Sys.sleep(0.5)
  plotrix::boxed.labels(5.5, 2.5,  "クリアーならず!!", col="blue",
                      cex=3, bg = "white", xpad = 1.25, ypad = 1.5)
  Sys.sleep(0.5)
  if(Sound){beepr::beep(9); beepr::beep(9); beepr::beep(9)}
  if(save){
    DPI <- ifelse(Saikoro, 100, 300)
    quartz.save(file = paste0("./SaikoroGame_", formatC(n, width=2, flag=0), "_", 
                                       formatC(x+2, width=2, flag=0), ".png"), 
                         type = "png", dpi = DPI)}
  break
}}
if(save){
message(paste0("Current directory: ", getwd()))
len <- length(list.files(pattern="Animation_SaikoroGame"))
message(paste0("Save start !!: ", formatC(len+1, width=2, flag=0)))
Sys.sleep(0.2)
system(paste0("convert -delay 100 -loop 10 ./SaikoroGame_*.png ./Animation_SaikoroGame", formatC(len+1, width=2, flag=0), ".gif"))
Sys.sleep(0.2)
system("rm -rf ./SaikoroGame_*.png")
message("Save finished !!")
}else{message("Finished !!")}
}

補足

6以外が10回出続ける確率

ちなみに、6以外が10回出続ける確率は、

(5/6)^10

 0.1615056

アガリの確率は、結構高い。

list.files実行について

なぜだか、ファイル数の長さである、変数 len にファイル数と一致する数値が入らなかった。

今回は、その前に、何かしらの実行(ex. message(paste0("Current directory: ", getwd())))を入れてあげるとうまく解決した。

参考資料

takenaka-akio.org

【Rでの文字列処理シリーズ(その3)】文字列/テキストの検出・検索: 完全一致、部分一致、拡張正規表現、曖昧一致判定

はじめに

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

この記事では、R言語のプログラミングでのテキストマイニング、文字列の検出・検索、テキストの検出・検索について、いろいろと試してみました。 主に、base、stringrのパッケージを扱っています。

テキスト処理の関連記事

skume.net

skume.net

skume.net

skume.net

skume.net

skume.net

下準備について

まずは、関連パッケージとテキストデータを準備します。

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

#テストファイルのダウンロード
utils::download.file(url="https://raw.githubusercontent.com/kumeS/Blog/master/TXT_proc/test.txt",
                     destfile="test.txt")

【1】完全一致で、その文字列を含むかどうかのの判定

比較演算子 == !=

完全一致の基本は、比較演算子 ==!= を用いて、文字列の一致有無を判定する方法です。

#入力データフレーム
c <- data.frame(readr::read_tsv(file="./test.txt", col_names=F))
c

#完全一致で、文字列を含むかどうかの判定
#比較演算子を使う場合、その文字列(右辺)を含むかの判定
c == "abc"
#        X1
#[1,] FALSE
#[2,] FALSE
#[3,] FALSE
#[4,] FALSE
#[5,] FALSE
#[6,] FALSE

c == "abc ABC abc"
#        X1
#[1,]  TRUE
#[2,] FALSE
#[3,] FALSE
#[4,] FALSE
#[5,] FALSE
#[6,] FALSE

#その文字列(右辺)を含まないか?
c != "abc ABC abc"
#        X1
#[1,] FALSE
#[2,]  TRUE
#[3,]  TRUE
#[4,]  TRUE
#[5,]  TRUE
#[6,]  TRUE

base::match、stringr::str_match、演算子 %in%

次に、base::match、stringr::str_match、演算子 %in% を使って、完全一致の判定を行います。

#base::matchを使った場合
base::match(c$X1, table="abc")
#[1] NA NA NA NA NA NA

base::match(c$X1, table="abc ABC abc")
#[1]  1 NA NA NA NA NA

#stringr::str_matchを使った場合
stringr::str_match(c$X1, pattern="abc ABC abc")

# %in% を使った場合
c$X1 %in% "abc"
#[1] FALSE FALSE FALSE FALSE FALSE FALSE

c$X1 %in% "abc ABC abc"
#[1]  TRUE FALSE FALSE FALSE FALSE FALSE

【2】部分一致で、その文字列を含むかどうかの判定

charmatch関数、pmatch関数

まずは、charmatch関数、pmatch関数を使った、部分文字列の一致判定の実行例を示します。どうも文字列の先頭との部分一致を判定しているみたいです。

実行の挙動は、直観的に使いにくいかもしれません・・・

#基本的な実行例(1)
charmatch("m",   c("mean", "median", "mode"))
#[1] 0
# => 複数ヒットの場合、「0」を返す

base::charmatch("mo", table=c("mean", "median", "mode"))
#[1] 3
## => modeの「3」を返ってくる

base::charmatch("ode", table=c("mean", "median", "mode"))
#[1] NA
# => 先頭の文字が含まれないと、「NA」を返す

#基本的な実行例(2)
base::pmatch("m",   c("mean", "median", "mode"))
#[1] NA
base::pmatch("mo",   c("mean", "median", "mode"))
#[1] 3

#デフォルトは、1対1で対応づける
base::pmatch(c("", "ab", "ab"), c("abc", "ab"))
#[1] NA  2  1
#「duplicates.ok = T」で、1対多での対応づけをOKにする
base::pmatch(c("", "ab", "ab"), c("abc", "ab"), duplicates.ok = T)
#[1] NA  2  2

grep関数、grepl関数、stringr::str_detect関数

次に、grep関数、grepl関数、stringr::str_detect関数を使った事例を紹介する。こっちの方が使い勝手が良いと思われます。

c$X1
#[1] "abc ABC abc" "ABC abc ABC" "def DEF def"
#[4] "DEF def DEF" "abc.ABC.abc" "ABC.abc.ABC"

base::grep(pattern="abc", c$X1)
#[1] 1 2 5 6

base::grepl(pattern="abc", c$X1)
#[1]  TRUE  TRUE FALSE FALSE  TRUE  TRUE

c$X1[base::grepl(pattern="abc", c$X1)]
#[1] "abc ABC abc" "ABC abc ABC" "abc.ABC.abc"
#[4] "ABC.abc.ABC"

stringr::str_detect(c$X1, pattern="abc")
#[1]  TRUE  TRUE FALSE FALSE  TRUE  TRUE

#上記の逆論理値を返す
stringr::str_detect(c$X1, pattern="abc", negate = T)
#[1] FALSE FALSE  TRUE  TRUE FALSE FALSE

【3】文字列部分一致の曖昧判定

base::grepl関数

拡張正規表現を使った、文字列部分一致の曖昧判定について、いろいろな事例を扱ってみる。一通り覚えると、結構使えます。

まずは、base::grepl / stringr::str_detect + 拡張正規表現 を使います。

#「A〜C」の3文字からなる文字列を含むかどうか
base::grepl(pattern="[A-C][A-C][A-C]", c$X1)
#[1]  TRUE  TRUE FALSE FALSE  TRUE  TRUE

#「A〜C」、任意文字、「A〜C」の3文字からなる文字列を含むかどうか
base::grepl(pattern="[A-C].[A-C]", c$X1)
#[1]  TRUE  TRUE FALSE FALSE  TRUE  TRUE

#任意文字、任意文字、任意文字の3文字からなる文字列を含むかどうか
base::grepl(pattern="...", c$X1)
#[1] TRUE TRUE TRUE TRUE TRUE TRUE
(メモ) 正規表現の違い
任意文字 .
.(ピリオド)を文字指定 [.]

続いて、新たな文字列サンプルで試してみます。

#新たな文字列
test0 <- c("123", "12345", "Q1", "Q12", "QQ123")
test0
#[1] "123"   "12345" "Q1"    "Q12"   "QQ123"

#「0〜9」からなる文字列を3連続で含むかどうか
base::grepl(pattern="[0-9][0-9][0-9]", test0)
#[1]  TRUE  TRUE FALSE FALSE  TRUE

#先頭「Q」から始まって、数字2文字からなる文字列を含むかどうか
base::grepl(pattern="^Q[1-9][0-9]", test0)
#[1] FALSE FALSE FALSE  TRUE FALSE

#語尾が「0-9」「3-5」で終わる、数字2文字からなる文字列を含むかどうか
base::grepl(pattern="[0-9][3-5]$", test0)
#[1]  TRUE  TRUE FALSE FALSE  TRUE
(メモ) よく使う正規表現
先頭文字指定 先頭に ^ マーク
末尾文字指定 最後に $ マーク

次に、少し複雑な内容をやってみます。

TRUE / FALSEだと長ったらしいので、該当文字列のみを抽出しています。

#少し応用編
test1 <- c("あ", "ア", "M", "m", "1", " ", "  ", "㍍", "〒", "*", "+", "漢")

#平仮名 [あ-ん] を抽出する
test1[base::grepl(pattern="[あ-ん]", test1)]
#[1] "あ"

#片仮名 [ア-ン] を抽出する
test1[base::grepl(pattern="[ア-ン]", test1)]
#[1] "ア"

#大文字・小文字アルファベットを抽出する
test1[base::grepl(pattern="[a-z]|[A-Z]", test1)]
#[1] "M" "m"
#OR
test1[base::grepl(pattern="[[:alpha:]]", test1)]
#[1] "M" "m"

#小文字アルファベットを抽出する
test1[base::grepl(pattern="[a-z]", test1)]
#[1] "m"
#OR
test1[base::grepl(pattern="[[:lower:]]", test1)]
#[1] "m"

#数値を抽出する
test1[base::grepl(pattern="[0-9]", test1)]
#[1] "1"
#OR
test1[base::grepl(pattern="[[:digit:]]", test1)]
#[1] "1"

#アルファベット OR 数値を抽出する
test1[base::grepl(pattern="[a-z]|[A-Z]|[0-9]", test1)]
#[1] "M" "m" "1"
#OR
test1[base::grepl(pattern="\\w", test1)]
#[1] "M" "m" "1"
test1[base::grepl(pattern="[[:alnum:]]", test1)]
#[1] "M" "m" "1"

#空白文字、タブをを抽出する: やや分かりづらい
test1[base::grepl(pattern=" |  ", test1)]
#[1] " "  "  "
#OR
test1[base::grepl(pattern="[[:blank:]]", test1)]
#[1] " "  "  "

#印字可能な文字列を抽出する
test1[base::grepl(pattern="[[:print:]]", test1)]
#[1] "あ" "ア" "M"  "m"  "1"  " "  "  " "㍍" "〒" "*"  "+"  "漢"

#グラフィカル文字列を抽出する
test1[base::grepl(pattern="[[:graph:]]", test1)]
#[1] "あ" "ア" "M"  "m"  "1"  "㍍" "〒" "*"  "+"  "漢"

#パンクチュエーション文字列を抽出する
test1[base::grepl(pattern="[[:punct:]]", test1)]
#[1] "㍍" "〒" "*"  "+" 

stringr::str_detect関数

次に、stringr::str_detect関数での実行例を示します。

#平仮名 [あ-ん] を抽出する
test1[stringr::str_detect(test1, pattern="\\p{Hiragana}")]
#[1] "あ"
#OR
test1[stringr::str_detect(test1, pattern="[あ-ん]")]
#[1] "あ"

#片仮名 [ア-ン] を抽出する
test1[stringr::str_detect(test1, pattern="\\p{Katakana}")]
#[1] "ア" "㍍"
#OR
test1[stringr::str_detect(test1, pattern="[ア-ン]")]
#[1] "ア"

#漢字 を抽出する
test1[stringr::str_detect(test1, pattern="\\p{Han}")]
#[1] "漢"

stringr::str_detect関数では、\\p{Katakana}で、が抽出できるのが素敵です。

まとめ

文字列の検出は、実際テキスト処理とかでよく使います。

個人的には、grepl関数でT/F結果で返すのが「テッパン」だと思います。

補足

データフレーム全体に対して、文字列の置換を行う場合のTips

data.frame関数、lapply関数、gsub関数を組み合わせて行う。

以下には、データフレームのDatオブジェクトの各列の%を``に置換する場合の実施例を示す。

Dat <- data.frame(lapply(Dat, 
                         function(x){gsub(pattern="%", replacement = "", x)}),
                  stringsAsFactors = FALSE)

TRUE/FALSEをカウントする

lengthをよく使ってたけど、sumでもT/Fのカウントができるみたい。

文字列サンプル
test0 <- c("123", "12345", "Q1", "Q12", "QQ123")

#(例)「0〜9」からなる文字列を3連続で含むかどうか
count <- base::grepl(pattern="[0-9][0-9][0-9]", test0)
count
#[1]  TRUE  TRUE FALSE FALSE  TRUE

#lengthで、TRUEのカウント
length(count[count])
#[1] 3

#lengthで、FALSEのカウント
length(count[!count])
#[1] 2

#sumで、TRUEのカウント
sum(count)
#[1] 3

#sumで、FALSEのカウント
sum(!count)
#[1] 2

【応用編】文字列の検出: character(0)、numeric(0)を検出する

character(0)numeric(0)の処理は結構悩ましいので、メモしておく。

#前準備
a <- character(0)
b <- numeric(0)

#character(0)検出の方法
identical(a, character(0))
#[1] TRUE

#失敗例
character(0) == 0
#logical(0)

#numeric(0)検出の方法
identical(b, numeric(0))
#[1] TRUE

#失敗例
numeric(0) == 0
#logical(0)

#character(0)あるいはnumeric(0)の条件で検出する
Hantei <- function(x){
  ch <- identical(x, character(0))
  nu <- identical(x, numeric(0))
  return(any(c(ch, nu)))
}

#判定結果
Hantei(a)
#[1] TRUE
Hantei(b)
#[1] TRUE
Hantei("Baka")
#[1] FALSE

参考資料

mikuhatsune.hatenadiary.com

www.karada-good.net

www.okadajp.org