編集距離を使って名寄せをしたい (Bradley−Terryモデルで力士の強さを推定)

編集距離で名寄せ (相撲の結果から強さを推定する)
========================================================

## はじめに

力士の強さを定量化したいです。戦闘力。いいですよね。興奮します。

以前、[相撲の対戦結果データを作成](http://gg-hogehoge.hatenablog.com/entry/2014/12/03/201944)しました。

[相撲の星取表](http://gans01.fc2web.com/H2/H24-1.html)をRで扱える形式にしてみた、という内容です。

このデータの中では、一部の四股名が略称で入っています。

詳細は後述しますが、例えば「日馬富士」が「日馬富」とされていることがあるのです。

集計が出来なくて困っていました。前処理が必要です。今回は、編集距離で名寄せする方法を紹介しつつ、最後に力士の戦闘力を出します。

## 編集距離で名寄せ

編集距離を使ってみます。文字列の近さを測る指標の1つです。

たとえば、「hoge」と「huge」の間の編集距離は1です。

hogeのoをuに"編集"すればhugeになるからです。

詳細は、[このサイトを見る](http://synapse-diary.com/?p=2697)とわかると思います。

Rでは, MiscPsychoというパッケージを利用すれば、編集距離の計算ができるらしいです。

...R-3.2.2の場合はCRANからインストール出来ませんでした。

ソースをダウンロードして頑張ってインストールしました。


```r
# install.packages("MiscPsycho_1.6.tar", reposz = NULL, type = "source")

library("MiscPsycho")

## stringMatchを使えばいいらしいです。
stringMatch("hoge", "huge", normalize = "NO")
```

```
## [1] 1
```

```r
## normalize = "NO"としないと、文字数で規格化された距離が出力されます。
stringMatch("hoge", "huge")
```

```
## [1] 0.75
```

この編集距離を利用して、四股名と四股名の略称を紐つけてみます。

### (2015年11月8日追記)

非標準のMiscPsycho::stringMatchではなく、標準ライブラリであるutils::adistを使う方がいい、というご指摘を@kos59125 さんより頂きました。

```r
utils::adist("hoge", "huge")
```
```
     [,1]
[1,]    1
```
なるほど。こちらのほうがいいです。ありがとうございます。

## 相撲のデータで名寄せ

実際のデータに使ってみましょう。

[星取表をパースして作ったデータ](https://raw.githubusercontent.com/gghatano/sumo_data/master/winLoseDataTable.dat.no_juryou)があります。

星取表とは、[こんな感じ](http://gans01.fc2web.com/H2/H26-1.html)です。相撲でよく見る、結果まとめ表です。

クロス表形式なので、縦方向にバラしています。


```r
library("readr")
library("dplyr")
library("xtable")
dat = read_csv("winLoseDataTable.dat.no_juryou", col_names = FALSE) 

## 名前をつける
names(dat) = c("tournament", "class", "name", "room_old", "opponent", "result")

## 実験用に、平成24年初場所のデータを使う
dat = 
  dat %>% filter(tournament == "H24-1")

## 内容確認
dat %>% head %>% 
  xtable %>% print(type="html")
```

<!-- html table generated in R 3.2.2 by xtable 1.7-4 package -->
<!-- Sun Nov  8 17:16:43 2015 -->
<table border=1>
<tr> <th>  </th> <th> tournament </th> <th> class </th> <th> name </th> <th> room_old </th> <th> opponent </th> <th> result </th>  </tr>
  <tr> <td align="right"> 1 </td> <td> H24-1 </td> <td> 横綱 </td> <td> 白鵬 </td> <td> 宮城野26 </td> <td> 若荒雄 </td> <td> W </td> </tr>
  <tr> <td align="right"> 2 </td> <td> H24-1 </td> <td> 横綱 </td> <td> 白鵬 </td> <td> 宮城野26 </td> <td> 豪風 </td> <td> W </td> </tr>
  <tr> <td align="right"> 3 </td> <td> H24-1 </td> <td> 横綱 </td> <td> 白鵬 </td> <td> 宮城野26 </td> <td> 安美錦 </td> <td> W </td> </tr>
  <tr> <td align="right"> 4 </td> <td> H24-1 </td> <td> 横綱 </td> <td> 白鵬 </td> <td> 宮城野26 </td> <td> 隠岐海 </td> <td> W </td> </tr>
  <tr> <td align="right"> 5 </td> <td> H24-1 </td> <td> 横綱 </td> <td> 白鵬 </td> <td> 宮城野26 </td> <td> 雅山 </td> <td> W </td> </tr>
  <tr> <td align="right"> 6 </td> <td> H24-1 </td> <td> 横綱 </td> <td> 白鵬 </td> <td> 宮城野26 </td> <td> 豪栄道 </td> <td> W </td> </tr>
   </table>

データの項目の意味は、

場所名、階級、名前、部屋と年齢、対戦相手、結果

です。

1行目は、

H24年の初場所の初戦で、横綱白鵬(宮城野部屋26歳)が若荒雄にWin

という意味です。

対戦相手の項目が厄介です。四股名の略称が入っているのです。

例えば、日馬富士。

```r
## 名前
dat %>% filter(name == "日馬富士") %>% head %>%
  xtable %>% print(type="html")
```

<!-- html table generated in R 3.2.2 by xtable 1.7-4 package -->
<!-- Sun Nov  8 17:16:43 2015 -->
<table border=1>
<tr> <th>  </th> <th> tournament </th> <th> class </th> <th> name </th> <th> room_old </th> <th> opponent </th> <th> result </th>  </tr>
  <tr> <td align="right"> 1 </td> <td> H24-1 </td> <td> 大関 </td> <td> 日馬富士 </td> <td> 伊勢濱27 </td> <td> 隠岐海 </td> <td> W </td> </tr>
  <tr> <td align="right"> 2 </td> <td> H24-1 </td> <td> 大関 </td> <td> 日馬富士 </td> <td> 伊勢濱27 </td> <td> 豊ノ島 </td> <td> W </td> </tr>
  <tr> <td align="right"> 3 </td> <td> H24-1 </td> <td> 大関 </td> <td> 日馬富士 </td> <td> 伊勢濱27 </td> <td> 若荒雄 </td> <td> W </td> </tr>
  <tr> <td align="right"> 4 </td> <td> H24-1 </td> <td> 大関 </td> <td> 日馬富士 </td> <td> 伊勢濱27 </td> <td> 豪風 </td> <td> W </td> </tr>
  <tr> <td align="right"> 5 </td> <td> H24-1 </td> <td> 大関 </td> <td> 日馬富士 </td> <td> 伊勢濱27 </td> <td> 北太樹 </td> <td> W </td> </tr>
  <tr> <td align="right"> 6 </td> <td> H24-1 </td> <td> 大関 </td> <td> 日馬富士 </td> <td> 伊勢濱27 </td> <td> 鶴竜 </td> <td> L </td> </tr>
   </table>

```r
## 対戦相手
dat %>% filter(opponent == "日馬富") %>% head %>%
  xtable %>% print(type="html")
```

<!-- html table generated in R 3.2.2 by xtable 1.7-4 package -->
<!-- Sun Nov  8 17:16:43 2015 -->
<table border=1>
<tr> <th>  </th> <th> tournament </th> <th> class </th> <th> name </th> <th> room_old </th> <th> opponent </th> <th> result </th>  </tr>
  <tr> <td align="right"> 1 </td> <td> H24-1 </td> <td> 横綱 </td> <td> 白鵬 </td> <td> 宮城野26 </td> <td> 日馬富 </td> <td> L </td> </tr>
  <tr> <td align="right"> 2 </td> <td> H24-1 </td> <td> 大関 </td> <td> 把瑠都 </td> <td> 尾上27 </td> <td> 日馬富 </td> <td> W </td> </tr>
  <tr> <td align="right"> 3 </td> <td> H24-1 </td> <td> 大関 </td> <td> 琴欧洲 </td> <td> 佐渡嶽28 </td> <td> 日馬富 </td> <td> L </td> </tr>
  <tr> <td align="right"> 4 </td> <td> H24-1 </td> <td> 関脇 </td> <td> 鶴竜 </td> <td> 井筒26 </td> <td> 日馬富 </td> <td> W </td> </tr>
  <tr> <td align="right"> 5 </td> <td> H24-1 </td> <td> 小結 </td> <td> 雅山 </td> <td> 藤島34 </td> <td> 日馬富 </td> <td> L </td> </tr>
  <tr> <td align="right"> 6 </td> <td> H24-1 </td> <td> 前頭1 </td> <td> 豪風 </td> <td> 尾車32 </td> <td> 日馬富 </td> <td> L </td> </tr>
   </table>

4文字以上の四股名だと、対戦相手名(opponent)列に略称が格納されているのです。

困りました。場合によっては集計できません。

ここで、編集距離を使いましょう。

四股名と略称とでは、大きくは変わらないはずです。

四股名からの編集距離が最も小さいものが、略称になると考えられます。

なので、以下の手順で四股名と略称を紐つけます。

1. 四股名、略称名のベクトルを作る

2. 全組み合わせで編集距離を計算する

3. 四股名ごとに、最も編集距離が近いものを略称と判定する

やってみます。

```r
## name列の要素
dat_name = dat %>% select(name) %>% unique
## opponent列の要素
dat_opponent = dat %>% select(opponent) %>% unique

## それぞれの長さ
dat_name %>% dim
```

```
[1] 42  1
```

```r
dat_opponent %>% dim
```

```
[1] 46  1
```
```r
## 紐つけたい2つの名前列(nameとopponent)をクロス結合して
## 名前の全組み合わせで編集距離を計算
dat_stringmatch =
  dat_name %>% 
  merge(dat_opponent) 
## 本当はdplyr::mutate(dist = stringMatch(name, opponent))としたかった
## 動かないので、無理矢理mapplyする
dist_col = mapply(FUN = function(x,y){return (stringMatch(x,y, normalize = "NO"))}, dat_stringmatch$name, dat_stringmatch$opponent)
dat_stringmatch$dist = dist_col
   
## 距離の最小値を求める
dat_mindist = 
  dat_stringmatch %>% 
  group_by(name) %>% 
  summarise(dist = min(dist))

## 編集距離が最小のものを抜き出す
## 最小値と名前で結合すればいいはず
dat_stringmatch %>% 
  merge(dat_mindist, by = c("name", "dist")) %>% 
  select(name, opponent) %>%
  xtable %>% print(type="html")
```

<!-- html table generated in R 3.2.2 by xtable 1.7-4 package -->
<!-- Sun Nov  8 17:16:44 2015 -->
<table border=1>
<tr> <th>  </th> <th> name </th> <th> opponent </th>  </tr>
  <tr> <td align="right"> 1 </td> <td> 阿覧 </td> <td> 阿覧 </td> </tr>
  <tr> <td align="right"> 2 </td> <td> 旭秀鵬 </td> <td> 旭秀鵬 </td> </tr>
  <tr> <td align="right"> 3 </td> <td> 旭天鵬 </td> <td> 旭天鵬 </td> </tr>
  <tr> <td align="right"> 4 </td> <td> 安美錦 </td> <td> 安美錦 </td> </tr>
  <tr> <td align="right"> 5 </td> <td> 隠岐の海 </td> <td> 隠岐海 </td> </tr>
  <tr> <td align="right"> 6 </td> <td> 嘉風 </td> <td> 嘉風 </td> </tr>
  <tr> <td align="right"> 7 </td> <td> 臥牙丸 </td> <td> 臥牙丸 </td> </tr>
  <tr> <td align="right"> 8 </td> <td> 雅山 </td> <td> 雅山 </td> </tr>
  <tr> <td align="right"> 9 </td> <td> 魁聖 </td> <td> 魁聖 </td> </tr>
  <tr> <td align="right"> 10 </td> <td> 稀勢の里 </td> <td> 稀勢里 </td> </tr>
  <tr> <td align="right"> 11 </td> <td> 琴欧洲 </td> <td> 琴欧洲 </td> </tr>
  <tr> <td align="right"> 12 </td> <td> 琴奨菊 </td> <td> 琴奨菊 </td> </tr>
  <tr> <td align="right"> 13 </td> <td> 高安 </td> <td> 高安 </td> </tr>
  <tr> <td align="right"> 14 </td> <td> 豪栄道 </td> <td> 豪栄道 </td> </tr>
  <tr> <td align="right"> 15 </td> <td> 豪風 </td> <td> 豪風 </td> </tr>
  <tr> <td align="right"> 16 </td> <td> 佐田の富士 </td> <td> 佐田富 </td> </tr>
  <tr> <td align="right"> 17 </td> <td> 時天空 </td> <td> 時天空 </td> </tr>
  <tr> <td align="right"> 18 </td> <td> 若荒雄 </td> <td> 若荒雄 </td> </tr>
  <tr> <td align="right"> 19 </td> <td> 松鳳山 </td> <td> 松鳳山 </td> </tr>
  <tr> <td align="right"> 20 </td> <td> 千代の国 </td> <td> 千代国 </td> </tr>
  <tr> <td align="right"> 21 </td> <td> 大道 </td> <td> 大道 </td> </tr>
  <tr> <td align="right"> 22 </td> <td> 朝赤龍 </td> <td> 朝赤龍 </td> </tr>
  <tr> <td align="right"> 23 </td> <td> 鶴竜 </td> <td> 鶴竜 </td> </tr>
  <tr> <td align="right"> 24 </td> <td> 天鎧鵬 </td> <td> 天鎧鵬 </td> </tr>
  <tr> <td align="right"> 25 </td> <td> 土佐豊 </td> <td> 土佐豊 </td> </tr>
  <tr> <td align="right"> 26 </td> <td> 栃ノ心 </td> <td> 栃ノ心 </td> </tr>
  <tr> <td align="right"> 27 </td> <td> 栃乃若 </td> <td> 栃乃若 </td> </tr>
  <tr> <td align="right"> 28 </td> <td> 栃煌山 </td> <td> 栃煌山 </td> </tr>
  <tr> <td align="right"> 29 </td> <td> 日馬富士 </td> <td> 日馬富 </td> </tr>
  <tr> <td align="right"> 30 </td> <td> 把瑠都 </td> <td> 把瑠都 </td> </tr>
  <tr> <td align="right"> 31 </td> <td> 白鵬 </td> <td> 白鵬 </td> </tr>
  <tr> <td align="right"> 32 </td> <td> 富士東 </td> <td> 富士東 </td> </tr>
  <tr> <td align="right"> 33 </td> <td> 碧山 </td> <td> 碧山 </td> </tr>
  <tr> <td align="right"> 34 </td> <td> 芳東 </td> <td> 芳東 </td> </tr>
  <tr> <td align="right"> 35 </td> <td> 豊ノ島 </td> <td> 豊ノ島 </td> </tr>
  <tr> <td align="right"> 36 </td> <td> 豊響 </td> <td> 豊響 </td> </tr>
  <tr> <td align="right"> 37 </td> <td> 豊真将 </td> <td> 豊真将 </td> </tr>
  <tr> <td align="right"> 38 </td> <td> 北太樹 </td> <td> 北太樹 </td> </tr>
  <tr> <td align="right"> 39 </td> <td> 妙義龍 </td> <td> 妙義龍 </td> </tr>
  <tr> <td align="right"> 40 </td> <td> 隆の山 </td> <td> 隆の山 </td> </tr>
  <tr> <td align="right"> 41 </td> <td> 磋牙司 </td> <td> 磋牙司 </td> </tr>
  <tr> <td align="right"> 42 </td> <td> 鳰の湖 </td> <td> 鳰の湖 </td> </tr>
   </table>

おお!!!!!!!!できてます!!!!!

佐田の富士が佐田富に。稀勢の里が稀勢里に。日馬富士が日馬富に紐付いています。

これで、略称から元の四股名が得られました!!!

やった!!! 元データと結合すればお仕事終了です。


```r
dat_opponent_name = 
  dat_stringmatch %>% 
  merge(dat_mindist, by = c("name", "dist")) %>% 
  mutate(opponent_name=name) %>% 
  select(opponent_name, opponent)

dat_result = 
  dat %>% 
  merge(dat_opponent_name, by = "opponent") %>%
  select(tournament, class, name, room_old, opponent_name, result)
```

## Bradley-Terryモデルで強さ推定

今まで、できなかったことをやります。

対戦相手の名前が正しく作れたため、例えば[Bradley-Terryモデル](http://dev.classmethod.jp/machine-learning/r-bradley-terry-model-1/)に投げつけることで強さの推定ができます。


```r
library(BradleyTerry2)
```

```
## Loading required package: lme4
## Loading required package: Matrix
```

```r
dat_winlose = 
  dat_result %>% 
  group_by(name, opponent_name) %>% 
  summarise(wins = sum(result == "W"), loses = sum(result=="L")) %>% 
  mutate(winner = ifelse(wins == 1, name, opponent_name))  %>%
  mutate(loser = ifelse(wins == 0, name, opponent_name))  %>%
  group_by(winner, loser, add=FALSE) %>%
  summarise(wins = sum(wins), loses = 0)

sumoBT = BTm(outcome = cbind(wins, loses), 
             player1 = winner, player2 = loser,
             data = dat_winlose)

## BT
sumoBTdf = BTabilities(sumoBT) %>% as.data.frame %>% 
  mutate(name = row.names(.)) %>%
  arrange(desc(ability))

## 勝数を集計
dat_winlose_result =
  dat_winlose %>% group_by(winner) %>% 
  summarise(wins = sum(wins)) %>% 
  mutate(name = winner) %>% select(-winner)
  
## BTモデルで推定された強さと勝数を較べてみます
sumoBTdf %>% 
  merge(dat_winlose_result, by = "name") %>% 
  arrange(desc(ability)) %>%
  xtable %>% print(type="html")
```

<!-- html table generated in R 3.2.2 by xtable 1.7-4 package -->
<!-- Sun Nov  8 17:16:46 2015 -->
<table border=1>
<tr> <th>  </th> <th> name </th> <th> ability </th> <th> s.e. </th> <th> wins </th>  </tr>
  <tr> <td align="right"> 1 </td> <td> 把瑠都 </td> <td align="right"> 3.79 </td> <td align="right"> 1.43 </td> <td align="right">  14 </td> </tr>
  <tr> <td align="right"> 2 </td> <td> 白鵬 </td> <td align="right"> 2.52 </td> <td align="right"> 1.20 </td> <td align="right">  12 </td> </tr>
  <tr> <td align="right"> 3 </td> <td> 稀勢の里 </td> <td align="right"> 2.12 </td> <td align="right"> 1.14 </td> <td align="right">  11 </td> </tr>
  <tr> <td align="right"> 4 </td> <td> 日馬富士 </td> <td align="right"> 2.00 </td> <td align="right"> 1.15 </td> <td align="right">  11 </td> </tr>
  <tr> <td align="right"> 5 </td> <td> 鶴竜 </td> <td align="right"> 1.73 </td> <td align="right"> 1.11 </td> <td align="right">  10 </td> </tr>
  <tr> <td align="right"> 6 </td> <td> 琴欧洲 </td> <td align="right"> 1.63 </td> <td align="right"> 1.13 </td> <td align="right">  10 </td> </tr>
  <tr> <td align="right"> 7 </td> <td> 安美錦 </td> <td align="right"> 1.23 </td> <td align="right"> 1.08 </td> <td align="right">   9 </td> </tr>
  <tr> <td align="right"> 8 </td> <td> 臥牙丸 </td> <td align="right"> 1.21 </td> <td align="right"> 0.88 </td> <td align="right">  12 </td> </tr>
  <tr> <td align="right"> 9 </td> <td> 栃煌山 </td> <td align="right"> 1.00 </td> <td align="right"> 0.83 </td> <td align="right">  11 </td> </tr>
  <tr> <td align="right"> 10 </td> <td> 時天空 </td> <td align="right"> 0.89 </td> <td align="right"> 0.83 </td> <td align="right">  11 </td> </tr>
  <tr> <td align="right"> 11 </td> <td> 琴奨菊 </td> <td align="right"> 0.83 </td> <td align="right"> 1.09 </td> <td align="right">   8 </td> </tr>
  <tr> <td align="right"> 12 </td> <td> 栃ノ心 </td> <td align="right"> 0.70 </td> <td align="right"> 0.83 </td> <td align="right">  10 </td> </tr>
  <tr> <td align="right"> 13 </td> <td> 妙義龍 </td> <td align="right"> 0.66 </td> <td align="right"> 0.81 </td> <td align="right">   9 </td> </tr>
  <tr> <td align="right"> 14 </td> <td> 嘉風 </td> <td align="right"> 0.64 </td> <td align="right"> 0.79 </td> <td align="right">   9 </td> </tr>
  <tr> <td align="right"> 15 </td> <td> 旭天鵬 </td> <td align="right"> 0.56 </td> <td align="right"> 0.78 </td> <td align="right">   9 </td> </tr>
  <tr> <td align="right"> 16 </td> <td> 松鳳山 </td> <td align="right"> 0.32 </td> <td align="right"> 0.77 </td> <td align="right">   8 </td> </tr>
  <tr> <td align="right"> 17 </td> <td> 栃乃若 </td> <td align="right"> 0.32 </td> <td align="right"> 0.89 </td> <td align="right">   8 </td> </tr>
  <tr> <td align="right"> 18 </td> <td> 豊真将 </td> <td align="right"> 0.29 </td> <td align="right"> 0.92 </td> <td align="right">   7 </td> </tr>
  <tr> <td align="right"> 19 </td> <td> 豪栄道 </td> <td align="right"> 0.25 </td> <td align="right"> 1.09 </td> <td align="right">   6 </td> </tr>
  <tr> <td align="right"> 20 </td> <td> 高安 </td> <td align="right"> 0.21 </td> <td align="right"> 1.04 </td> <td align="right">   6 </td> </tr>
  <tr> <td align="right"> 21 </td> <td> 千代の国 </td> <td align="right"> 0.15 </td> <td align="right"> 0.89 </td> <td align="right">   9 </td> </tr>
  <tr> <td align="right"> 22 </td> <td> 豊響 </td> <td align="right"> 0.05 </td> <td align="right"> 0.79 </td> <td align="right">   7 </td> </tr>
  <tr> <td align="right"> 23 </td> <td> 阿覧 </td> <td align="right"> 0.00 </td> <td align="right"> 0.00 </td> <td align="right">   8 </td> </tr>
  <tr> <td align="right"> 24 </td> <td> 豊ノ島 </td> <td align="right"> -0.11 </td> <td align="right"> 1.11 </td> <td align="right">   5 </td> </tr>
  <tr> <td align="right"> 25 </td> <td> 若荒雄 </td> <td align="right"> -0.11 </td> <td align="right"> 1.11 </td> <td align="right">   5 </td> </tr>
  <tr> <td align="right"> 26 </td> <td> 碧山 </td> <td align="right"> -0.29 </td> <td align="right"> 0.80 </td> <td align="right">   6 </td> </tr>
  <tr> <td align="right"> 27 </td> <td> 豪風 </td> <td align="right"> -0.33 </td> <td align="right"> 1.10 </td> <td align="right">   4 </td> </tr>
  <tr> <td align="right"> 28 </td> <td> 天鎧鵬 </td> <td align="right"> -0.34 </td> <td align="right"> 0.86 </td> <td align="right">   8 </td> </tr>
  <tr> <td align="right"> 29 </td> <td> 朝赤龍 </td> <td align="right"> -0.35 </td> <td align="right"> 0.86 </td> <td align="right">   9 </td> </tr>
  <tr> <td align="right"> 30 </td> <td> 隠岐の海 </td> <td align="right"> -0.44 </td> <td align="right"> 1.07 </td> <td align="right">   4 </td> </tr>
  <tr> <td align="right"> 31 </td> <td> 佐田の富士 </td> <td align="right"> -0.53 </td> <td align="right"> 0.82 </td> <td align="right">   8 </td> </tr>
  <tr> <td align="right"> 32 </td> <td> 大道 </td> <td align="right"> -0.66 </td> <td align="right"> 0.81 </td> <td align="right">   6 </td> </tr>
  <tr> <td align="right"> 33 </td> <td> 富士東 </td> <td align="right"> -0.75 </td> <td align="right"> 0.83 </td> <td align="right">   7 </td> </tr>
  <tr> <td align="right"> 34 </td> <td> 雅山 </td> <td align="right"> -0.91 </td> <td align="right"> 1.16 </td> <td align="right">   3 </td> </tr>
  <tr> <td align="right"> 35 </td> <td> 隆の山 </td> <td align="right"> -1.30 </td> <td align="right"> 0.88 </td> <td align="right">   6 </td> </tr>
  <tr> <td align="right"> 36 </td> <td> 北太樹 </td> <td align="right"> -1.40 </td> <td align="right"> 1.15 </td> <td align="right">   2 </td> </tr>
  <tr> <td align="right"> 37 </td> <td> 磋牙司 </td> <td align="right"> -1.66 </td> <td align="right"> 0.90 </td> <td align="right">   5 </td> </tr>
  <tr> <td align="right"> 38 </td> <td> 土佐豊 </td> <td align="right"> -1.91 </td> <td align="right"> 0.94 </td> <td align="right">   4 </td> </tr>
  <tr> <td align="right"> 39 </td> <td> 魁聖 </td> <td align="right"> -2.03 </td> <td align="right"> 0.91 </td> <td align="right">   4 </td> </tr>
  <tr> <td align="right"> 40 </td> <td> 鳰の湖 </td> <td align="right"> -2.03 </td> <td align="right"> 0.92 </td> <td align="right">   4 </td> </tr>
  <tr> <td align="right"> 41 </td> <td> 芳東 </td> <td align="right"> -2.34 </td> <td align="right"> 0.96 </td> <td align="right">   3 </td> </tr>
  <tr> <td align="right"> 42 </td> <td> 旭秀鵬 </td> <td align="right"> -2.44 </td> <td align="right"> 0.95 </td> <td align="right">   3 </td> </tr>
   </table>

BTモデルで推定した強さ(ability)において、最強だったの把瑠都。14勝1敗で優勝していました。

日馬富士と稀勢の里が11勝で並んでいますが、BTモデルでは稀勢の里のほうが強い、と出ています。

BTモデルにおいては、同じ1勝でも、強い相手からの1勝は高く評価されます。

逆に、弱い相手からの1勝は低く評価されます。

例えば、

千代の国が9勝しているのに順位は低いです。相手が弱かったのでしょう。


## できなかったこと

name列のグループごとにdist列が最小の行を取り出す...というデータフレームの操作が出来ませんでした。

なので、dist列最小行データフレームを作って、最小値をキーにしてjoinしています。

```r
dat_mindist = 
  dat_stringmatch %>% 
  group_by(name) %>% 
  summarise(dist = min(dist))

## 編集距離が距離が最小のものを抜き出す
## 最小値と名前で結合すればいいはず
dat_stringmatch %>% 
  merge(dat_mindist, by = c("name", "dist")) %>% 
  select(name, opponent)
```

ここをもう少しスマートにやりたいなと思いました。

## まとめ

編集距離で名寄せしました。Rだと簡単にできますね。