Rによる媒介中心性を用いたキーワードクラスタリング

## 分析概要
* 軸キーワードとなるものを決める
* 軸キーワードが記載されている記事から、軸キーワード以外のキーワードデータを抽出
* アソシエーション分析を行い、取得したキーワードデータをネットワーク単位に分割
* 辺の媒介中心性により、ネットワークからコミュニティを抽出
* コミュニティ内で媒介中心性の高いノードをラベリング

![概要.png](https://qiita-image-store.s3.amazonaws.com/0/127228/24d11222-4546-c968-4002-f208085867e7.png)

## 前準備
* 軸キーワードは`乾燥肌`に設定

```r
      # ================== ライブラリ読み込み ==================
      library(arules)
      library(RMySQL)
      library(tcltk)
      library(igraph)
      library(RColorBrewer)
      library(RJDBC)
      library(rJava)
      # ================== KWセット ==================
      kw <- '乾燥肌'
```

## データインポート
* 美容記事に含まれる軸キーワード以外のキーワードデータを取得
    * 美容記事は1つのURLに対し、文章を段落ごとに分割したものにarticle_data_idを割り振っているデータセットを使用
    * yahooキーフレーズ抽出を利用し、article_data_idごとの記事の中で重要度の高いキーワードとその重要度を定量的にを算出
    * データ取得条件は①軸キーワードが記載されているURL上にあるキーワード②そのURL中にある軸キーワード以外のキーワード③重要度(rank)が40以上のキーワードで抽出

![データインポート.png](https://qiita-image-store.s3.amazonaws.com/0/127228/22a8e4bb-965b-ee09-993e-287a390fa227.png)

## トランザクションデータに変換
* 抽出したキーワードのデータ型をトランザクション型に変換

```r
      # ================== トランザクションデータに変換 ==================
      startT <- proc.time()
      id <- unique(data$article_data_id)  # 集計レコード件数取得
      tran_list <- list()  # 作業用リスト初期化
      for (i in id){
        temp_tran <- list(iconv(subset(data,article_data_id==i)[,`keyword`],from=`utf-8`,to=`cp932`))  # 一行毎に文字コード変換してリスト化
        tran_list <- c(tran_list,temp_tran)  # 連結
      }
      print(`データ変換.....完了`)
      endT <- proc.time()
      print(endT-startT)

      startT <- proc.time()
      tran <- as(tran_list,'transactions')  # リスト型 → トランザクション型
      print(`トランザクションデータ化.....完了`)
      endT <- proc.time()
      print(endT-startT)
```

![トランザクションデータ.png](https://qiita-image-store.s3.amazonaws.com/0/127228/f3ec6424-a11e-e878-a773-7c203adcf632.png)


## アソシエーション分析
* support値をparam_supportで定義しアソシエーション分析を行い、グラフオブジェクト化

```r
      # ================== アソシエーション分析 ==================
      param_support <- 0.0007
      startT <- proc.time()
      #rules <- apriori(tran,parameter = list(support = param_support))
      rules <- apriori(tran,parameter = list(support = param_support,confidence=0,minlen=2,maxlen=2))
      print(`アソシエーションデータ分析.....完了`)
      endT <- proc.time()
      print(endT-startT)


      # ================== 前処理/グラフオブジェクト作成 ==================
      startT <- proc.time()
      rules_tmp <- as(rules,`data.frame`)  # data.frame化
      rules_tmp$rules <- as.character(rules_tmp$rules)  # char化
      rules_tmp$rules <- gsub(` `, ``, rules_tmp$rules)  # スペースを取り除く
      rules_tmp$rules <- gsub(`\}`, ``, rules_tmp$rules)  # `}`を取り除く
      rules_tmp$rules <- gsub(`\{`, ``, rules_tmp$rules)  # `{`を取り除く
      rules_tmp2 <- strsplit(rules_tmp$rules, `=>`) #  _{ }_ 記号でオブジェクトを分割
      node.labels <- as.data.frame(matrix(0, nrow=length(rules_tmp2),ncol=2))  # data.frame型を定義
      for(k in 1:length(rules_tmp2)){
        node.labels[k,1] <-  rules_tmp2[[k]][1]
        node.labels[k,2] <-  rules_tmp2[[k]][2]
      }
      g <- graph.data.frame(node.labels,directed = TRUE)  # グラフオブジェクト化
      print(`グラフオブジェクト作成.....完了`)
      endT <- proc.time()
      print(endT-startT)
```

![アソシエーション・グラフオブジェクト.png](https://qiita-image-store.s3.amazonaws.com/0/127228/47b69286-8088-f9ed-4283-7aaef8cdaa74.png)


## 連結成分分割
* 媒介中心性の高いノードがあると適切な分割が出来ないため排除
* 意味のないキーワードをネットワークに含めないようにするため排除
* 排除後、グラフオブジェクトを再定義し分割

```r
      # ================== 媒介中心性の高いノードNGワードを排除 ==================
      x <- names(which(betweenness(g) >= 2000))  # 媒介性中心の高いノードを抽出
      #x <- unique(c(x,as.character(read.table(`NGword.txt`)$V1))) # NGワードを追加
      g <- graph.data.frame(subset(node.labels,!(V1 %in% x | V2 %in% x),directed = TRUE))  # グラフオブジェクトを再定義

      # ================== 連結成分分割 ==================
      dcg <- decompose.graph(g)  # 連結成分で分割
      # ※ネットワークが繋がっていないとクラスタリング過程でエラーが発生する場合がある
```

## コミュニティ抽出
* 辺の媒介中心性によるコミュニティ抽出

```r
      # ================== コミュニティ抽出 ==================
      #参考：http://www.slideshare.net/MitsunoriSato/tokyor32-network-analysis-24442516
      #参考：https://codeiq.jp/magazine/2013/06/2149/
      #参考：http://qiita.com/hmj-kd/items/3f2b45b32bc3a8204141

      #参考：コミュニティ抽出ロジックパターン
      #sp <- spinglass.community(dcg[[i]])  # スピングラス
      #sp <- leading.eigenvector.community(dcg[[i]])  # 固有ベクトル
      #sp <- edge.betweenness.community(dcg[[i]])  # 辺媒介性

      startT <- proc.time()
      sp.df.all <- c()  # 出力用の箱を用意
      for(i in 1:length(dcg)){
        sp <- edge.betweenness.community(dcg[[i]])  # 辺媒介性
        sp.df <- cbind(i,as.data.frame(sp$names),as.data.frame(sp$membership))  # データフレーム作成
        bwn_tmp <- data.frame(node=names(betweenness(dcg[[i]])),bwn=betweenness(dcg[[i]]),row.names = NULL)  # コミュニティ毎にノード媒介中心性を算出
        sp.df <- merge(x=sp.df,y=bwn_tmp,by.x = `sp$names`,by.y = `node`)
        sp.df.all <- rbind(sp.df.all,sp.df)  # 結果をマージ
      }
      colnames(sp.df.all) <- c(`node`,`i`,`community`,`bwn`)  #カラム名設定
      print(`コミュニティ抽出.....完了`)
      endT <- proc.time()
      print(endT-startT)


      # ================== 媒介中心性が10を超えるノードをマーク ==================
      sp.df.all$node <- ifelse(sp.df.all$bwn>=10,paste(`★`,sp.df.all$node,sep=``), as.character(sp.df.all$node))
      sp.df.all <- sp.df.all[order(sp.df.all$bwn, decreasing = TRUE ),]
```

![コミュミティ抽出・媒介中心性.png](https://qiita-image-store.s3.amazonaws.com/0/127228/7a46c4c6-d5d3-772c-20c0-2cb4ed5cf884.png)


## ファイル出力
* コミュニティごとにキーワードをまとめる
* 画像描画で使用するコミュニティ単位での色指定を示したDFを作成


```r
      # ================== ファイル出力 ==================
      # リスト形式に整形
      startT <- proc.time()
      output <- c()
      color_val <- c()
      num <- 1  #色設定用番号
      for(i in 1:length(unique(sp.df.all$i))){  # ネットワーク数分実行
        v1 <- i  # ネットワーク番号
        uni_commu <-unique(subset(sp.df.all,i==v1)$community)  #選択したネットワークにおけるユニークなコミュニティ
        for(j in uni_commu){
          # ファイル出力用DF作成
          v2 <- j  # コミュ番号
          temp_char <- paste(subset(sp.df.all, i==v1 & community==v2)$node,collapse=`,`)  # 指定したネットワーク、コミュ番号の要素を抽出
          temp_df <- data.frame(num,kw,i,j,temp_char)  # ラベリングしてデータフレーム化
          output <- rbind(output,temp_df)

          # 画像描画用色指定DF作成
          tmp_color <- data.frame(as.character(subset(sp.df.all, i==v1 & community==v2)$node),as.integer(num))
          colnames(tmp_color) <- c(`kw`,`color_num`)
          color_val <- rbind(color_val,tmp_color)

          num <- num + 1
        }
      }
      colnames(output) <- c(`No.`,`軸ワード`,`ネットワーク`,`コミュニティ`,`キーワード`)  #カラム名設定
      write.table(output,paste(kw,`/`,kw,`コミュニティ.txt`,sep=``),row.name=F,col.names=T,sep=`	`,quote=F,append=F)   # 昇順に並べて出力
      print(`ファイル出力.....完了`)
      endT <- proc.time()
      print(endT-startT)
```


![ファイル出力.png](https://qiita-image-store.s3.amazonaws.com/0/127228/fe24ff66-9750-f8ab-b5a4-113bd633930a.png)


## igraph可視化(コミュニティ表示)
* コミュニティごとに色分けしてグラフ描画


```r
#       # ================== igraph可視化(コミュニティ表示) ==================
       startT <- proc.time()
#       # 色設定
       color_val$kw <- as.character(color_val$kw)
       node_df <- data.frame(kw = V(g)$name)
       node_df <- cbind(node_df,data.frame(no = as.integer(row.names(node_df))))
       color_marge <- merge(node_df,color_val)
       sortlist <- order(color_marge$no)
       color_marge <- color_marge[sortlist,]
       V(g)$color <- rainbow(length(unique(color_marge$color_num)))[color_marge$color_num]
#
       png(filename=paste(kw,`/`,kw,`.png`,sep=``),width=1920,height=1200,bg=`white`)
       plot.igraph(g,  #ネットワークを描画
                   vertex.size=8,
                   vertex.label.cex=0.7,
                   vertex.label.color=`gray40`,
                   vertex.label.font=2, #ノードのラベルのスタイル 1: 普通, 2: 太字, 3: 斜体, 4: 太字斜体, 5: ギリシャ文字
                   vertex.frame.color=`white`, #ノードの枠の色
                   edge.color=`gray80`, #エッジの色
                   edge.width=1,
                   edge.width=E(g)$weight, #エッジ属性weightをエッジの太さとする
                   edge.arrow.size=0.1,
                   layout=layout.fruchterman.reingold)
       dev.off()
       print(`igraph可視化.....完了`)
       endT <- proc.time()
       print(endT-startT)
#
#       # 参考：レイアウトパターン http://www.inside-r.org/packages/cran/igraph/docs/layout
#       # 参考：グラフオブジェクト操作
#       #g.cl <- clusters(g)  #クラスタ化
#       #g.cl$csize  #コミュニティのサイズ
#       #sp.df <- cbind(as.data.frame(sp$names),as.data.frame(sp$membership))
#       #V(g)$color <- rainbow(length(g.cl$csize))[g.cl$membership + 1]
#
```

![乾燥肌.png](https://qiita-image-store.s3.amazonaws.com/0/127228/31a07bb2-11c4-003b-24c0-e7f598e19b67.png)

## igraph可視化(ノード媒介中心性)
* ノード媒介中心性が高いものを濃い色、値が低いものを薄い色でグラフ描画


```r
       # ================== igraph可視化(ノード媒介中心性) ==================
       startT <- proc.time()
       # 色設定
       class <- cut(betweenness(g),breaks=8)  # 数値をクラス分け（ここでは8分割）
       clscolor <- data.frame(class=levels(as.factor(class)),color=I(brewer.pal(nlevels(as.factor(class)),`YlOrRd`))) # ColorBrewerのパレットを設定して（ここではYlOrRd）カテゴリーと色の対応表を作る

       png(filename=paste(kw,`/`,kw,`_ノード.png`,sep=``),width=1920,height=1200,bg=`white`)
       plot(g,
            vertex.size=8,
            vertex.label.cex=0.7,
            vertex.color=clscolor$color[match(class,clscolor$class)],
            vertex.label.font=2, #ノードのラベルのスタイル 1: 普通, 2: 太字, 3: 斜体, 4: 太字斜体, 5: ギリシャ文字
            vertex.frame.color=`white`, #ノードの枠の色
            edge.color=`gray80`, #エッジの色
            edge.width=1,
            #edge.width=E(g)$weight, #エッジ属性weightをエッジの太さとする
            edge.arrow.size=0.1,
            layout=layout.fruchterman.reingold)
       dev.off()

        # ================== グラフファイルの保存 ==================
        # 色設定
        write.graph(g, paste(kw,`/`,kw,`.gml`,sep=``), format=c(`graphml`))
```

![乾燥肌_ノード.png](https://qiita-image-store.s3.amazonaws.com/0/127228/e8d8f4db-dc8e-d96d-b0b6-34d0e119ec23.png)


![igraph可視化(コミュニティ表示).png](https://qiita-image-store.s3.amazonaws.com/0/127228/3120cc1d-91bd-54f1-d870-f3e802c082b9.png)

## 注釈
* 文字コードはiconv関数で変換
iconv(文字列,from=`変換前の文字コード`,to=`変換後の文字コード`)

* トランザクションデータの中身を見る
as(tran, `data.frame`)

* apriori
アソシエーション分析の関数

* graph.data.frame
ネットワークマップデータに置き換える関数

* betweenness(g)
媒介中心性を求める関数

* decompose.graph
分断されたネットワークを連結成分単位に分割する

* edge.betweenness.community(g)
Girvan-Newman法（Girvan & Newman, 2002）
辺媒介性に基づくカットによる分割を通してコミュニティを検出

* summary(g)
対象のネットワークにどのような属性が含まれるか参照出来る
https://codeiq.jp/magazine/2013/06/2149/