前回までのrPubsページ
- 第1章:準備運動
- 第2章:UNIXコマンドの基礎
- 第3章:正規表現
- 第4章:形態素解析
- 第5章:構文解析
- 第6章:データベース
前回引き続き、言語処理100本ノック（2015年版）を解きます。
（下記の『前書き（言語処理100本ノックについて）』は前回と同じです）
前書き（言語処理100本ノックについて）
- 本稿では、東北大学の乾・岡崎研究室で公開されている言語処理100本ノック（2015年版）を、R言語で解いていきます。
- 改訂前の言語処理100本ノックも同様に上記研究室のサイトにあります。
前書き（Rに関して）
- Rの構文や関数についての説明は一切ありませんので、あらかじめご了承ください。
- 本稿では、{base}にある文字列処理ではなく、{stringr}（1.0.0以上）とパイプ処理を極力用いております（{stringi}も処理に応じて活用していきます）。課題によってはパイプ処理でこなすのに向かない状況もありますので、あらかじめご了承ください。
- 今回は上記に加え、{rredis}と{mongolite}を用いて、RedisとMongoへのデータベース処理をしていきます。
参考ページ
{stringr}と{stringi}
hadley/stringr
RPubs - このパッケージがすごい2014: stringr
stringiで輝く☆テキストショリスト
stringr 1.0.0を使ってみる {stringr}/{stringi}とbaseの文字列処理について
{rredis}
bwlewis/rredis
{mongolite}
jeroenooms/mongolite
Getting started with MongoDB in R
Redisについて
Redis
redisドキュメント日本語訳
MongoDBについて
MongoDB
SQL脳に優しいMongoDBクエリー入門
MongoDBのインデックス
MongoDB Index基本
ご意見やご指摘など
- こうした方が良いやこういう便利な関数がある、間違いがあるなど、ご指摘をお待ちしております。
- 下記のいずれかでご連絡・ご報告いただけますと励みになります（なお、Gitに慣れていない人です）。
Twitter, GitHub
SET_LOAD_LIB <- c("knitr", "readr", "dplyr", "stringr", "stringi", "lazyeval", "jsonlite", "foreach", "iterators", "pforeach", "rredis", "mongolite", "shiny", "DT")
sapply(X = SET_LOAD_LIB, FUN = library, character.only = TRUE, logical.return = TRUE)## knitr readr dplyr stringr stringi lazyeval jsonlite
## TRUE TRUE TRUE TRUE TRUE TRUE TRUE
## foreach iterators pforeach rredis mongolite shiny DT
## TRUE TRUE TRUE TRUE TRUE TRUE TRUEknitr::opts_chunk$set(comment = NA)# {RcppRedis}のページより
# https://github.com/eddelbuettel/rcppredis
# On OS X, the header file hiredis.h has been seen to be installed directly in /usr/local/include whereas we generally assume a location within a hiredis directory, eg /usr/local/include/hiredis/hiredis.h. This gist shows a successfull OS X installation via homebrew.
brew install hiredis
brew install redis
To have launchd start redis at login:
ln -sfv /usr/local/opt/redis/*.plist ~/Library/LaunchAgents
Then to load redis now:
launchctl load ~/Library/LaunchAgents/homebrew.mxcl.redis.plist
Or, if you don't want/need launchctl, you can just run:
redis-server /usr/local/etc/redis.confbrew install mongodb
To have launchd start mongodb at login:
ln -sfv /usr/local/opt/mongodb/*.plist ~/Library/LaunchAgents
Then to load mongodb now:
launchctl load ~/Library/LaunchAgents/homebrew.mxcl.mongodb.plist
Or, if you don't want/need launchctl, you can just run:
mongod --config /usr/local/etc/mongod.conf# 第7章の入力データURL（固定）
TASK_INPUT_URL <- "http://www.cl.ecei.tohoku.ac.jp/nlp100/data/artist.json.gz"
# Redisの接続確認
rredis::redisConnect(host = "localhost", nodelay = FALSE)
rredis::redisInfo()$redis_version
[1] "2.8.19"
$redis_git_sha1
[1] "00000000"
$redis_git_dirty
[1] "0"
$redis_build_id
[1] "70633d1af7244f5e"
$redis_mode
[1] "standalone"
$os
[1] "Darwin 14.4.0 x86_64"
$arch_bits
[1] "64"
$multiplexing_api
[1] "kqueue"
$gcc_version
[1] "4.2.1"
$process_id
[1] "19675"
$run_id
[1] "231c326e0d6880a01778540aae36c91ba60c49d0"
$tcp_port
[1] "6379"
$uptime_in_seconds
[1] "759267"
$uptime_in_days
[1] "8"
$hz
[1] "10"
$lru_clock
[1] "12624821"
$config_file
[1] "/usr/local/etc/redis.conf"
$connected_clients
[1] "6"
$client_longest_output_list
[1] "0"
$client_biggest_input_buf
[1] "0"
$blocked_clients
[1] "0"
$used_memory
[1] "38936288"
$used_memory_human
[1] "37.13M"
$used_memory_rss
[1] "638976"
$used_memory_peak
[1] "547300528"
$used_memory_peak_human
[1] "521.95M"
$used_memory_lua
[1] "35840"
$mem_fragmentation_ratio
[1] "0.02"
$mem_allocator
[1] "libc"
$loading
[1] "0"
$rdb_changes_since_last_save
[1] "0"
$rdb_bgsave_in_progress
[1] "0"
$rdb_last_save_time
[1] "1438624299"
$rdb_last_bgsave_status
[1] "ok"
$rdb_last_bgsave_time_sec
[1] "0"
$rdb_current_bgsave_time_sec
[1] "-1"
$aof_enabled
[1] "0"
$aof_rewrite_in_progress
[1] "0"
$aof_rewrite_scheduled
[1] "0"
$aof_last_rewrite_time_sec
[1] "-1"
$aof_current_rewrite_time_sec
[1] "-1"
$aof_last_bgrewrite_status
[1] "ok"
$aof_last_write_status
[1] "ok"
$total_connections_received
[1] "109"
$total_commands_processed
[1] "1940994"
$instantaneous_ops_per_sec
[1] "0"
$total_net_input_bytes
[1] "497332393"
$total_net_output_bytes
[1] "100555231"
$instantaneous_input_kbps
[1] "0.00"
$instantaneous_output_kbps
[1] "0.00"
$rejected_connections
[1] "0"
$sync_full
[1] "0"
$sync_partial_ok
[1] "0"
$sync_partial_err
[1] "0"
$expired_keys
[1] "0"
$evicted_keys
[1] "0"
$keyspace_hits
[1] "465721"
$keyspace_misses
[1] "17"
$pubsub_channels
[1] "0"
$pubsub_patterns
[1] "0"
$latest_fork_usec
[1] "610"
$role
[1] "master"
$connected_slaves
[1] "0"
$master_repl_offset
[1] "0"
$repl_backlog_active
[1] "0"
$repl_backlog_size
[1] "1048576"
$repl_backlog_first_byte_offset
[1] "0"
$repl_backlog_histlen
[1] "0"
$used_cpu_sys
[1] "526.81"
$used_cpu_user
[1] "241.37"
$used_cpu_sys_children
[1] "28.33"
$used_cpu_user_children
[1] "148.89"
$db0
[1] "keys=89341,expires=0,avg_ttl=0"rredis::redisClose()
# rredis::redisFlushDB()
# Mongoの接続確認
mongo_obj <- mongolite::mongo(collection = "test")
mongo_obj$info()$server$ok[1] 1rm(mongo_obj)
# ファイル取得
download.file(
url = TASK_INPUT_URL, destfile = basename(TASK_INPUT_URL),
method = "wget", quiet = FALSE
)
if (!file.exists(file = basename(TASK_INPUT_URL))) {
stop("File not found.")
}Key-Value-Store (KVS) を用い，アーティスト名（name）から活動場所（area）を検索するためのデータベースを構築せよ．
setJSON2Redis <- function (
json, key_name
) {
parsed_json <- jsonlite::fromJSON(txt = json)
rredis::redisHMSet(
key = parsed_json[[key_name]],
values = parsed_json[names(parsed_json) != key_name]
)
return(parsed_json[[key_name]])
}
SET_KEY_NAME <- "name"
SET_PARALLE <- list(IS_PARALLEL = TRUE, CORE = 3)
SET_REDIS_PARAM <- list(
HOST = "localhost"
)
# JSONを一行ずつパースしてRedisに登録（とても遅い）
rredis::redisConnect(host = SET_REDIS_PARAM$HOST, nodelay = FALSE)
# redis_insert <- pforeach::pforeach(
# json = iterators::ireadLines(con = basename(TASK_INPUT_URL), n = 1),
# .c = c,
# .export = "setJSON2Redis",
# .parallel = SET_PARALLE$IS_PARALLEL, .cores = SET_PARALLE$CORE
# )({
# setJSON2Redis(json = json, key_name = SET_KEY_NAME)
# })
# 事前に登録したおいたとして、そのデータのキーを取得して利用
redis_insert <- redisKeys(pattern = "*")60で構築したデータベースを用い，特定の（指定された）アーティストの活動場所を取得せよ．
# 特定のフィールドの値を取得して、NULLだったらレコードから除外
fetchFields <- function(
keys, fetch_field
) {
return(
dplyr::data_frame(key = keys) %>%
dplyr::rowwise(.) %>%
dplyr::do(.,
dplyr::data_frame(
key = .$key,
field = list(
rredis::redisHGet(key = .$key, field = SET_FETCH_FIELD)
)
)
) %>%
dplyr::filter(field != "NULL") %>%
dplyr::rename_(.dots = setNames(object = "field", nm = SET_FETCH_FIELD))
)
}
SET_FETCH_FIELD <- "area"
SET_SEARCH_KEY_NUM <- 100000
artist_area <- fetchFields(
keys = redis_insert[seq(from = 1, to = SET_SEARCH_KEY_NUM)], fetch_field = SET_FETCH_FIELD
) %>%
dplyr::mutate(area = area[[1]]) %>%
printSource: local data frame [34,902 x 2]
key area
1 Star Academy 5 France
2 Eaux France
3 Axel Willner France
4 Bakfietsboys France
5 Bruno Zambrini France
6 Tamar Braxton France
7 Ramon Muntaner France
8 佐久間淳二 France
9 sin France
10 Alex Biro France
.. ... ...60で構築したデータベースを用い，活動場所が「Japan」となっているアーティスト数を求めよ．
SET_QUERY <- "Japan"
artist_area %>%
dplyr::filter(area == SET_QUERY) %>%
dplyr::group_by(area) %>%
dplyr::summarize(count = n())Source: local data frame [0 x 2]
Variables not shown: area (chr), count (int)KVSを用い，アーティスト名（name）からタグと被タグ数（タグ付けされた回数）のリストを検索するためのデータベースを構築せよ．さらに，ここで構築したデータベースを用い，アーティスト名からタグと被タグ数を検索せよ．
SET_FETCH_FIELD <- "tags"
insert_tags <- fetchFields(
keys = redis_insert[seq(from = 1, to = SET_SEARCH_KEY_NUM)], fetch_field = SET_FETCH_FIELD
) %>%
dplyr::do(.,
dplyr::data_frame(
key = .$key,
is_insert = rredis::redisHMSet(
key = .$key[1], values = .$tags[[1]]
)
)
) %>%
dplyr::filter(is_insert == "OK") %>%
dplyr::select(key)Warning in charToRaw(values[[j]]): 引数は長さ 1 の文字ベクトルである必要があります
最初の要素以外は全て無視されます artist_tags <- do.call(
"rbind",
lapply(X = insert_tags$key, FUN = function (search_key) {
return(
data.frame(
search_key,
fetchFields(
keys = search_key, fetch_field = SET_FETCH_FIELD
)$tag[[1]]
)
)
})
)
head(x = artist_tags, n = 10) search_key count value
1 Bakfietsboys 1 netherlands
2 Bakfietsboys 1 punk
3 Alex Biro 1 alex
4 Alex Biro 1 biro
5 Alex Biro 1 canadian
6 Alex Biro 1 pop
7 Alex Biro 1 rock
8 Alex Biro 1 alternative
9 The Sundays 1 likedis auto
10 Parker Jones 1 production musicredisClose()アーティスト情報（artist.json.gz）をデータベースに登録せよ．さらに，次のフィールドでインデックスを作成せよ: name, aliases.name, tags.value, rating.value
SET_MONGO_PROF <- list(
DB_NAME = "nlp_exercise", TABLE_NAME = "artist",
INDEX_NAMES = c("name", "aliases.name", "tags.value", "rating.value"),
PAGE_SIZE = 100000
)
mongo_obj <- mongolite::mongo(
collection = SET_MONGO_PROF$TABLE_NAME,
db = SET_MONGO_PROF$DB_NAME,
verbose = FALSE
)
# mongo_obj$drop()
# ストリーミングでパースして得たデータフレームをまとめて登録
jsonlite::stream_in(
con = gzfile(
description = basename(TASK_INPUT_URL),
open = "rb", encoding = "UTF-8"
),
handler = function(df){
mongo_obj$insert(data = df, pagesize = SET_MONGO_PROF$PAGE_SIZE)
},
pagesize = SET_MONGO_PROF$PAGE_SIZE,
verbose = FALSE
)
for (set_index in SET_MONGO_PROF$INDEX_NAMES){
mongo_obj$index(add = set_index)
}
# レコード数
mongo_obj$count()[1] 921337MongoDBのインタラクティブシェルを用いて，“Queen”というアーティストに関する情報を取得せよ．さらに，これと同様の処理を行うプログラムを実装せよ．
SET_MONGO_QUERY <- list(
QUERY = '{"name" : "Queen"}',
FIELD = '{"_id" : 0, "tags" : 0, "gid" : 0}'
)
mongo_obj$find(
query = SET_MONGO_QUERY$QUERY,
fields = SET_MONGO_QUERY$FIELD,
limit = 0
) begin.year begin.date begin.month name area sort_name ended
1 NA NA NA Queen Japan Queen TRUE
2 1970 27 6 Queen United Kingdom Queen TRUE
3 NA NA NA Queen <NA> Queen TRUE
type id aliases gender rating.count rating.value
1 Character 701492 Queen, Queen Female NA NA
2 Group 192 女王, 女王 <NA> 24 92
3 <NA> 992994 NULL <NA> NA NA# インタラクティブシェルは省略MongoDBのインタラクティブシェルを用いて，活動場所が「Japan」となっているアーティスト数を求めよ．
SET_MONGO_QUERY <- list(
QUERY = '{"area":"Japan"}'
)
mongo_obj$count(query = SET_MONGO_QUERY$QUERY)[1] 22821# インタラクティブシェルは省略特定の（指定した）別名を持つアーティストを検索せよ．
SET_MONGO_QUERY <- list(
QUERY = '{"aliases.name" : "Queen"}'
)
mongo_obj$find(query = SET_MONGO_QUERY$QUERY) name area sort_name ended gid
1 Queen Japan Queen TRUE 420ca290-76c5-41af-999e-564d7c71f1a7
type id aliases gender tags
1 Character 701492 Queen, Queen Female 1, 1, kamen rider w, related-akb48“dance”というタグを付与されたアーティストの中でレーティングの投票数が多いアーティスト・トップ10を求めよ．
SET_MONGO_QUERY <- list(
QUERY = '{"tags.value" : "dance"}',
FIELD = '{"name":1, "rating.value":1}',
SORT = '{"rating.value":-1}'
)
mongo_obj$find(
query = SET_MONGO_QUERY$QUERY,
fields = SET_MONGO_QUERY$FIELD,
sort = SET_MONGO_QUERY$SORT,
limit = 10
) _id name
1 55, c2, 1d, 5b, 1a, 39, 45, 8c, 80, 47, 8a, ea SSHäuptling
2 55, c2, 1d, 5b, 1a, 39, 45, 8c, 80, 47, e0, c7 Boy George
3 55, c2, 1d, 7a, 1a, 39, 45, 8c, 80, 49, 07, f4 Toni Basil
4 55, c2, 1d, 7b, 1a, 39, 45, 8c, 80, 49, a6, e9 Milk Inc.
5 55, c2, 1d, 9d, 1a, 39, 45, 8c, 80, 4b, 1f, 47 digitalTRAFFIC
6 55, c2, 1d, 9e, 1a, 39, 45, 8c, 80, 4b, 77, 23 Bag Raiders
7 55, c2, 1d, bf, 1a, 39, 45, 8c, 80, 4c, 06, 70 Syncopaths
8 55, c2, 1d, bf, 1a, 39, 45, 8c, 80, 4c, a3, 76 Kristina Supergenius
9 55, c2, 1d, bf, 1a, 39, 45, 8c, 80, 4c, a7, 42 MaRina
10 55, c2, 1d, bf, 1a, 39, 45, 8c, 80, 4c, b0, dd Sliptide
value
1 100
2 100
3 100
4 100
5 100
6 100
7 100
8 100
9 100
10 100ユーザから入力された検索条件に合致するアーティストの情報を表示するWebアプリケーションを作成せよ．アーティスト名，アーティストの別名，タグ等で検索条件を指定し，アーティスト情報のリストをレーティングの高い順などで整列して表示せよ．
# {shiny}で「ui.R」側で「アーティスト名」、「アーティストの別名」、「タグ等」を入力
# 「server.R」で検索して返す
ui <- shiny::fluidPage(
shiny::navbarPage(
title = "NLP-100-Drill-Exercises-v2015",
shiny::tabPanel(
title = "07-Database",
shiny::titlePanel("EX69"),
shiny::fixedRow(
shiny::fixedRow(
shiny::column(
width = 3,
shiny::textInput(
inputId = "artist_name", label = "アーティスト名", value = "Queen"
),
shiny::textInput(
inputId = "artist_alias", label = "アーティストの別名", value = "Queen"
),
shiny::textInput(
inputId = "tag", label = "タグ", value = ""
),
shiny::submitButton(text = "検索する")
),
shiny::hr(),
shiny::fixedRow(
shiny::column(
width = 10, DT::dataTableOutput(outputId = "artist")
)
)
)
)
)
)
)
server <- function(input, output) {
reactQuery <- shiny::reactive({
return (
data.frame(
name = input$artist_name,
aliases.name = input$artist_alias,
tags.value = input$tag,
stringsAsFactors = FALSE
)
)
})
output$artist <- DT::renderDataTable({
search_query <- reactQuery()
query_json <- jsonlite::toJSON(
x = search_query[, sapply(X = search_query, FUN = stringr::str_length) > 0, drop = FALSE]
)
query_json <- stringr::str_sub(
string = query_json,
start = 2, end = stringr::str_length(string = query_json) - 1
)
search_res <- mongo_obj$find(
query = query_json,
fields = '{"name":1, "aliases.name":1, "area":1, "tags.value":1, "rating.value":1}',
sort = '{"rating.value" : -1}'
)
if (length(search_res$aliases) == 0) {
search_res$aliases <- NA
}
if (length(search_res$rating) == 0) {
search_res$rating <- NA
}
if (length(search_res$tags) == 0) {
search_res$tags <- NA
}
to_table <- search_res[, -1, drop = FALSE] %>%
dplyr::rowwise(.) %>%
dplyr::mutate(
aliases = stringr::str_c(unlist(.$aliases), collapse = ","),
tags = stringr::str_c(unlist(.$tags), collapse = ","),
rating = stringr::str_c(unlist(.$rating), collapse = ",")
) %>% data.frame(., stringsAsFactors = FALSE)
return(to_table)
})
}
# ShinyAppの起動
# RPubs上ではインタラクティブドキュメントが非対応なので、できないのでコメントアウト
# shiny::shinyApp(ui = ui, server = server)言語処理100本ノック(2015年版)のデータベースの章をやってみました。
Rは文字列のような可変長データを扱うのに適したデータ構造でないので、MongoDBのようなドキュメント指向型データベースと組み合わせるのが良さそうではないか、と思いました。
Redisに関して{rredis}を使いましたが、他にも{RcppRedis}もあります。low-levelな関数群ですので、Redisのコマンドに慣れている方はこちらが使いやすいと思います。
– {RcppRedis}
eddelbuettel/rcppredis
MongoDBに関して{mongolite}を使いましたが、他にも{rmongodb}や{RMongo}があります。他に触ってみるなら、{rmongodb}がlow-levelな関数とそれらをラップする関数群が適度に揃っており、ちょうどいいかもしません。
– {rmongodb}
Introduction to the rmongodb Package
rmongodb Cheat Sheet
RからMongoDBに格納されたデータを扱う
– {RMongo}
tc/RMongo
RでMongoでデータフレーム
{rmongodb}と{RMongo}について
RからMongoDBにアクセスする2つのライブラリ
R and MongoDB
Redisへのデータの挿入に時間がかかってしまっているので、もう少し工夫ができたと思います（Redisは一行ずつ処理しているのに対して、Mongoへの書き込みは複数行を同時にしている）。
個人的には、もう少しRに寄った処理がしたかったです。
library(devtools)
devtools::session_info()Session info -------------------------------------------------------------- setting value
version R version 3.2.1 (2015-06-18)
system x86_64, darwin13.4.0
ui X11
language (EN)
collate ja_JP.UTF-8
tz Asia/Tokyo Packages ------------------------------------------------------------------ package * version date
assertthat 0.1 2013-12-06
codetools 0.2-11 2015-03-10
curl 0.9 2015-06-19
DBI 0.3.1 2014-09-24
devtools * 1.8.0 2015-05-09
digest 0.6.8 2014-12-31
doParallel 1.0.8 2014-02-28
doRNG 1.6 2014-03-07
dplyr * 0.4.2.9002 2015-07-25
DT * 0.1.30 2015-07-25
evaluate 0.7 2015-04-21
foreach * 1.4.2 2014-04-11
formatR 1.2 2015-04-21
git2r 0.10.1 2015-05-07
htmltools 0.2.6 2014-09-08
htmlwidgets 0.5.1 2015-07-25
httpuv 1.3.2 2014-10-23
iterators * 1.0.7 2014-04-11
jsonlite * 0.9.16 2015-04-11
knitr * 1.10.5 2015-05-06
lazyeval * 0.1.10.9000 2015-07-25
magrittr 1.5 2014-11-22
memoise 0.2.1 2014-04-22
mime 0.3 2015-03-29
mongolite * 0.5 2015-07-31
pforeach * 1.3 2015-07-25
pkgmaker 0.22 2014-05-14
R6 2.0.1 2014-10-29
Rcpp 0.12.0 2015-07-26
readr * 0.1.1.9000 2015-07-25
registry 0.2 2012-01-24
rmarkdown 0.7 2015-06-13
rngtools 1.2.4 2014-03-06
rredis * 1.7.0 2015-07-26
rstudioapi 0.3.1 2015-04-07
rversions 1.0.1 2015-06-06
shiny * 0.12.1 2015-06-12
stringi * 0.5-5 2015-06-29
stringr * 1.0.0.9000 2015-07-25
xml2 0.1.1 2015-06-02
xtable 1.7-4 2014-09-12
yaml 2.1.13 2014-06-12
source
CRAN (R 3.2.0)
CRAN (R 3.2.0)
CRAN (R 3.2.0)
CRAN (R 3.2.0)
CRAN (R 3.2.0)
CRAN (R 3.2.0)
CRAN (R 3.2.0)
CRAN (R 3.2.0)
Github (hadley/dplyr@75e8303)
Github (rstudio/DT@b8412eb)
CRAN (R 3.2.0)
CRAN (R 3.2.0)
CRAN (R 3.2.0)
CRAN (R 3.2.0)
CRAN (R 3.2.0)
Github (ramnathv/htmlwidgets@e153784)
CRAN (R 3.2.0)
CRAN (R 3.2.0)
CRAN (R 3.2.0)
CRAN (R 3.2.0)
Github (hadley/lazyeval@ecb8dc0)
CRAN (R 3.2.0)
CRAN (R 3.2.0)
CRAN (R 3.2.0)
Github (jeroenooms/mongolite@517d11a)
Github (hoxo-m/pforeach@2c44f3b)
CRAN (R 3.2.0)
CRAN (R 3.2.0)
Github (RcppCore/Rcpp@6ae91cc)
Github (hadley/readr@f4a3956)
CRAN (R 3.2.0)
CRAN (R 3.2.0)
CRAN (R 3.2.0)
Github (bwlewis/rredis@3a9ff40)
CRAN (R 3.2.0)
CRAN (R 3.2.0)
CRAN (R 3.2.0)
CRAN (R 3.2.0)
Github (hadley/stringr@380c88f)
CRAN (R 3.2.0)
CRAN (R 3.2.0)
CRAN (R 3.2.0)