前回までの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へのデータベース処理をしていきます。


参考ページ


ご意見やご指摘など
- こうした方が良いやこういう便利な関数がある、間違いがあるなど、ご指摘をお待ちしております。
- 下記のいずれかでご連絡・ご報告いただけますと励みになります(なお、Gitに慣れていない人です)。
 Twitter, GitHub



Rコード

パッケージ読み込み

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      TRUE
knitr::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.conf
brew 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] 1
rm(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.") 
}

60. KVSの構築

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 = "*")

61. KVSの検索

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]]) %>%
  print
Source: 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
..            ...    ...

62. KVS内の反復処理

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)

63. オブジェクトを値に格納したKVS

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 music
redisClose()

64. MongoDBの構築

アーティスト情報(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] 921337

65. MongoDBの検索

MongoDBのインタラクティブシェルを用いて,“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
# インタラクティブシェルは省略

66. 検索件数の取得

MongoDBのインタラクティブシェルを用いて,活動場所が「Japan」となっているアーティスト数を求めよ.

SET_MONGO_QUERY <- list(
  QUERY = '{"area":"Japan"}'
)


mongo_obj$count(query = SET_MONGO_QUERY$QUERY)
[1] 22821
# インタラクティブシェルは省略

67. 複数のドキュメントの取得

特定の(指定した)別名を持つアーティストを検索せよ.

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

68. ソート

“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

69. Webアプリケーションの作成

ユーザから入力された検索条件に合致するアーティストの情報を表示する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)


所感



実行環境

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)