cucumber flesh

Rを䞭心ずしたデヌタ分析・統蚈解析らぞんの話題をしおいくだけ

📈䌁業内で利甚されるサヌビス・ツヌルのア゜シ゚ヌション分析

先日、ビゞネスSNSずしお有名なWantedlyが、䌁業に察しお利甚しおいるサヌビスやツヌルに぀いおの調査を行った結果をcompany toolsずしお公開したした。

www.wantedly.com

このペヌゞでは぀のカテゎリヌに぀いお、Wantedlyに登録されおいるすべおの䌁業ではないですが、該圓するりェブサヌビスやアナログなツヌルを利甚しおいる䌁業の数や評䟡コメントを芋るこずができたす。

これはこれで倧倉面癜いのですが、いく぀か気になったこずがありたす。それは

  1. どういうツヌルが人気なの
  2. どういうツヌルを組み合わせお利甚しおいるの
  3. 䌁業の特城瀟員数や事業内容などずの関係はあるの

ずいうこずです。に぀いおはWantedlyの以䞋のカテゎリヌごずの集蚈ペヌゞをみればわかるのですが、どうせならRで図瀺しおみたくなりたす。たたに぀いおは「この商品を買った堎合はこの商品も買う」ずいった関連性を調べるためのア゜シ゚ヌション分析の手法が䜿えるような気がしたす。最埌の点に぀いおは、Wantedlyの募集ペヌゞにあるテキストをもずに䌁業を分類すれば良いかなず思いたしたが、瀟員数ずか事業内容のデヌタが取れそうになかったので保留䞭です。ずいうわけでずに぀いおRでやっおみたした。

💡人気のツヌル・サヌビスを可芖化する

たずはWantedlyで公開されおいる情報をもずにRで図を描いおみたいず思いたす。company toolsで蚭定されおいる次の぀のカテゎリヌに぀いお、各カテゎリヌごずに䞊䜍10䜍たでの人気のツヌル・サヌビスたずめおみたす。

 可芖化のためのRコヌドクリックで衚瀺

library(rvest)
library(ggplot2)
library(emoGG)
library(gridExtra)
library(viridis)
library(dplyr)
# ggplot2の芋た目を倉曎する蚭定
quartzFonts(YuGo = quartzFont(rep("YuGo-Medium", 
    4)))
theme_set(theme_classic(base_size = 12, base_family = "YuGo"))

base.url <- "https://www.wantedly.com/company_tools"

# コミュニケヌションツヌルのデヌタを取埗
df.com <- read_html(paste(base.url, "categories", 
    "communication", sep = "/")) %>% html_nodes(xpath = sprintf("//*[@id=\"company-tools\"]/div/div[2]/div/div/ul/div/li/div/span/a")) %>% 
    {
        data_frame(service = html_nodes(., 
            xpath = "div") %>% html_text(), 
            count = html_nodes(., xpath = "h2") %>% 
                html_text() %>% tidyr::extract_numeric(), 
            category = "コミュニケヌション") %>% 
            .[1:10, ]
    }

ggplot(df.com, aes(reorder(service, count), 
    count)) + geom_bar(stat = "identity", 
    aes(fill = count)) + scale_fill_viridis() + 
    geom_emoji(data = data.frame(x = 8:10, 
        y = df.com$count[1:3] %>% sort()), 
        aes(x = x, y = y), position = position_nudge(y = 10), 
        emoji = "1f451") + guides(fill = FALSE) + 
    xlab("サヌビス") + ylab("利甚しおいる䌁業数") + 
    ggtitle("人気のコミュニケヌションサヌビス") + 
    theme(axis.text.x = element_text(angle = 40, 
        hjust = 1))

䞊蚘のコヌドをすべおのカテゎリヌに察しお実行しお埗た図が以䞋のものになりたす。各カテゎリヌで䞊䜍皮に぀いおは👑冠を぀けおいたすちょっず文字が朰れおしたっおいたす...。

f:id:u_ribo:20160221023250p:plain

f:id:u_ribo:20160221023258p:plain

SlackやGoogle Analyticsを始め、AWSやGitHubが人気であるこずがわかりたすね。

🌐 利甚されおいるサヌビスの関連を芋る

さお続いおの内容に぀いお実行しおいきたす。冒頭でも述べたように、今回のようなデヌタ圢匏は䌁業が利甚しおいるサヌビスをトランザクションデヌタずみなしたア゜シ゚ヌション分析を行うこずができそうです。たずは分析に必芁なデヌタを改めお収集するずころから始めたす。ア゜シ゚ヌション分析の詳现に぀いおはここでは深く觊れないので、末尟の参考ペヌゞをご芧になるこずをお勧めしたす。

察象の䌁業リストを甚意する

もっずも人気があるサヌビスが、「Google Drive」で263瀟が利甚しおいる、ずのこずですが、company toolsのペヌゞで衚瀺されるのはこれらのうちの䞀郚です。たた、ペヌゞ読み蟌みの床に衚瀺される䌁業が異なるので、すべおの䌁業を察象にはしおいたせん。䜕回もアクセスしおWantedlyのサヌバヌに負荷をかけるのも申し蚳ないので極力少ないセッションから必芁な情報を埗るようにしたす。床のアクセスで衚瀺された䌁業を今回の分析の察象ずするためにリストを䜜成したす。

 察象の䌁業リストを甚意するためのRコヌドクリックで衚瀺

library(pforeach)
library(dplyr)
df.company <- read_html(base.url) %>% html_nodes(xpath = "//*[@id=\"company-tools\"]/div/div/div/div/ul/div/li/div/div/div[2]/a") %>% 
    {
        data_frame(url = html_attr(., name = "href") %>% 
            paste0("https://www.wantedly.com", 
                .), company = html_text(.)) %>% 
            unique()
    }
df.company %>% nrow()

ずいうわけで83の䌁業が利甚しおいるツヌル・サヌビスの結果を分析に利甚したす。党䜓の割くらいなので偏りがあるかもしれたせん。

トランザクションデヌタの䜜成ず分析の実行

{arules}パッケヌゞを利甚したす。

 トランザクションデヌタの䜜成クリックで衚瀺

library(pforeach)
library(arules)

df.res <- npforeach(i = 1:nrow(df.company), 
    .c = rbind)({
    Sys.sleep(3)
    read_html(df.company$url[i]) %>% html_nodes(xpath = "//*[@id=\"company-tools-company\"]/div/div/div/ul/li/div/a/div") %>% 
        {
            dplyr::data_frame(id = i, item = paste0(html_nodes(., 
                "div") %>% html_text(trim = TRUE), 
                "=", html_nodes(., "h3") %>% 
                  html_text(trim = TRUE)))
        }
})
# ツヌルカテゎリヌの日本語を修正
df.res %<>% dplyr::mutate(item = gsub("コミュニケヌションツヌル", 
    "communication", item), item = gsub("情報共有・蓄積ツヌル", 
    "knowledge", item), item = gsub("プロゞェクト管理ツヌル", 
    "project_management", item), item = gsub("採甚・育成サヌビス", 
    "human_resource", item), item = gsub("営業ツヌル", 
    "sales", item), item = gsub("マヌケティングツヌル", 
    "marketing", item), item = gsub("開発・テクノロゞヌツヌル", 
    "development", item), item = gsub("デザむンツヌル", 
    "design", item), item = gsub("カスタマヌサポヌトツヌル", 
    "customer_support", item))
res.trans <- df.res %>% as.data.frame() %$% 
    split(item, id) %>% as(., "transactions")

生成されたトランザクションデヌタを確認したす。

res.trans
## transactions in sparse format with
##  83 transactions (rows) and
##  129 items (columns)

# 䌁業id = 1の内容を衚瀺
LIST(res.trans[1])
## $`1`
##  [1] "communication=Slack"                "design=GIMP"                        "design=Illustrator"                 "design=Inkscape"
##  [5] "design=Photoshop"                   "design=Pinterest"                   "development=AWS"                    "development=CircleCI"
##  [9] "development=DeployGate"             "development=GitHub"                 "development=Mackerel"               "development=New Relic"
## [13] "development=wercker"                "human_resource=Green"               "human_resource=Linkedin"           "human_resource=Wantedly Admin"
## [17] "knowledge=esa.io"                   "marketing=@press"                   "marketing=Google Analytics"         "marketing=Google Search Console"
## [21] "marketing=Hootsuite"                "marketing=Mailchimp"                "marketing=Mixpanel"                 "marketing=Optimizely"
## [25] "marketing=PR TIMES"                 "marketing=Repro"                    "project_management=asana"      "project_management=GitHub"
## [29] "project_management=pivotal tracker" "project_management=Trello"

# トランザクションデヌタ党䜓の芁玄
summary(res.trans) %>% .@itemSummary
## marketing=Google Analytics     knowledge=Google Drive        communication=Slack         design=Illustrator           design=Photoshop                    (Other) 
##                         50                         48                         46                         44                         44                        892 

# 盞察頻床での項目サヌビス、ツヌルの䞊䜍を確認
itemFrequency(res.trans, type = "absolute") %>% head()
## communication=Chatwork         communication=co-meeting             communication=direct communication=Facebook messenger     communication=Google Hangout 
##                     29                                1                                1                               20                               25 
##  communication=Hipchat 
##                      4 

# 各組み合わせの発生する割合に぀いお䞀郚を衚瀺
#   同時に発生するこずない組み合わせの affinity は 0
affinity(res.trans)[1:5, 1:5]
##                                  communication=Chatwork communication=co-meeting communication=direct communication=Facebook messenger communication=Google Hangout
## communication=Chatwork                        0.0000000                     0.00                 0.00                        0.3243243                    0.2857143
## communication=co-meeting                      0.0000000                     0.00                 1.00                        0.0500000                    0.0000000
## communication=direct                          0.0000000                     1.00                 0.00                        0.0500000                    0.0000000
## communication=Facebook messenger              0.3243243                     0.05                 0.05                        0.0000000                    0.3235294
## communication=Google Hangout                  0.2857143                     0.00                 0.00                        0.3235294                    0.0000000

ではいよいよapriori()関数を䜿っお、Aprioriアルゎリズムによるア゜シ゚ヌション分析を実行したす。Aprioriアルゎリズムはア゜シ゚ヌション分析の原型ずしお広く利甚されるアルゎリズムずなっおいたす。

# 支持床 supportず確信床 confidence を調敎
(rules <- res.trans %>% apriori(parameter = list(support = 0.3, confidence = 0.5, target = "rules"),
                               control    = list(verbose = FALSE)))
## set of 71 rules

# 確信床が高い順に䞊び替え
rules <- sort(rules, decreasing = TRUE, by = "confidence")

apriori()の結果を出力するにはinspect()を䜿いたす。すでに確信床の高い順に䞊び替えおいるので、䞀郚だけを衚瀺するようにしたす。

# apriori()の結果を䞀郚を出力
#   条件 lhs, 結論 rhs, 支持床, 確信床, リフトの順
inspect(rules[1:10])
##    lhs                                                                       rhs                  support   confidence lift    
## 61 {design=Photoshop,marketing=Google Analytics}                          => {design=Illustrator} 0.3975904 0.9705882  1.830882
## 58 {design=Photoshop,knowledge=Google Drive}                              => {design=Illustrator} 0.3734940 0.9687500  1.827415
## 54 {communication=Slack,design=Illustrator}                               => {design=Photoshop}   0.3132530 0.9629630  1.816498
## 71 {design=Photoshop,knowledge=Google Drive,marketing=Google Analytics}   => {design=Illustrator} 0.3132530 0.9629630  1.816498
## 57 {design=Illustrator,knowledge=Google Drive}                            => {design=Photoshop}   0.3734940 0.9393939  1.772039
## 7  {development=GitHub}                                                   => {development=AWS}    0.3493976 0.9354839  1.941129
## 33 {design=Illustrator}                                                   => {design=Photoshop}   0.4939759 0.9318182  1.757748
## 34 {design=Photoshop}                                                     => {design=Illustrator} 0.4939759 0.9318182  1.757748
## 55 {communication=Slack,design=Photoshop}                                 => {design=Illustrator} 0.3132530 0.9285714  1.751623
## 70 {design=Illustrator,knowledge=Google Drive,marketing=Google Analytics} => {design=Photoshop}   0.3132530 0.9285714  1.751623

次のような出力も可胜です。

# 条件に䞀臎するルヌルがいく぀あるか
subset(rules, subset = rhs %in% "design=Illustrator") %>% 
  inspect() %>% head()
##    lhs                                                                     rhs                  support   confidence lift    
## 61 {design=Photoshop,marketing=Google Analytics}                        => {design=Illustrator} 0.3975904 0.9705882  1.830882
## 58 {design=Photoshop,knowledge=Google Drive}                            => {design=Illustrator} 0.3734940 0.9687500  1.827415
## 71 {design=Photoshop,knowledge=Google Drive,marketing=Google Analytics} => {design=Illustrator} 0.3132530 0.9629630  1.816498
## ...

eclat(res.trans, parameter = list(support = 0.6)) %>% 
  sort(decreasing = TRUE, by = "support") %>% 
  inspect()
## ...
##   items                        support  
## 1 {marketing=Google Analytics} 0.6024096
# どういうサヌビスを利甚しおいる堎合に䜵せおGitHubも利甚しおいるか
rules.lhs.gh <- res.trans %>% apriori(
               appearance = list(default = "lhs",rhs = "development=GitHub"),
               control = list(verbose = FALSE)) %>% 
  sort(decreasing = TRUE, by = "support")

inspect(rules.lhs.gh[1:5])
##    lhs                                                                rhs                  support   confidence lift    
## 27 {communication=Slack,development=AWS}                           => {development=GitHub} 0.2771084 0.8214286  2.199309
## 26 {development=AWS,project_management=GitHub}                     => {development=GitHub} 0.2409639 0.8695652  2.328191
## 73 {communication=Slack,development=AWS,project_management=GitHub} => {development=GitHub} 0.2289157 0.9500000  2.543548
## 3  {development=New Relic}                                         => {development=GitHub} 0.2048193 0.8947368  2.395586
## 19 {development=AWS,development=New Relic}                         => {development=GitHub} 0.2048193 0.8947368  2.395586

分析結果を抂芳するために図瀺しおみたしょう。{arulesViz}パッケヌゞはarules::apriori()によっお生成されたrulesクラスオブゞェクトをプロットするためのパッケヌゞです。

 可芖化のためのRコヌドクリックで衚瀺

library(arulesViz)
plot(rules, method = "grouped")
sort(rules, by = "lift") %>% 
  plot(method = "graph", control = list(type = "items"))

f:id:u_ribo:20160221023323p:plain

f:id:u_ribo:20160221023328p:plain

あれこれ考察できそうですが、もうちょっず勉匷しおからの内容を含めお再床挑戊したいですね。

🔖 参考

💻 実行環境

devtools::session_info() %>% {
    print(.$platform)
    .$packages %>% dplyr::filter(`*` == "*") %>% 
        knitr::kable(format = "markdown")
}
##  setting  value                       
##  version  R version 3.2.3 (2015-12-10)
##  system   x86_64, darwin13.4.0        
##  ui       X11                         
##  language En                          
##  collate  en_US.UTF-8                 
##  tz       Asia/Tokyo                  
##  date     2016-02-21
package * version date source
arules * 1.3-1 2015-12-14 CRAN (R 3.2.3)
arulesViz * 1.1-0 2015-12-13 CRAN (R 3.2.3)
dplyr * 0.4.3.9000 2015-10-28 Github ()
emoGG * 0.0.1 2015-11-28 Github ()
ggplot2 * 2.0.0 2015-12-18 CRAN (R 3.2.3)
gridExtra * 2.0.0 2015-07-14 CRAN (R 3.1.3)
magrittr * 1.5 2016-01-13 Github ()
Matrix * 1.2-3 2015-11-28 CRAN (R 3.2.3)
remoji * 0.1.0 2016-01-19 Github ()
rvest * 0.3.1 2015-11-11 CRAN (R 3.2.2)
viridis * 0.3.2 2016-01-03 Github ()
xml2 * 0.1.2 2015-09-01 CRAN (R 3.2.0)