単語類似度を用いた病名検索

テキスト分類ではコサイン類似度を用いてドキュメントの類似性を求めて文書検索に応用した。これを応用してあいまい病名検索に利用できないか検討してみた。

考え方の背景はテキスト分類の記事とそこに貼り付けてあるPDFのドキュメントを参考にされたい。ただし、病名検索の場合は、テキスト分類における文書が病名で、文書を構成する要素（形態素）が文字になる。例えば、病名「咽喉圧挫損傷」は文字「咽」「喉」「圧」「挫」「損」「傷」から構成され、文字空間上の1点で表現できるものと考え、それを病名ベクトル（厳密には文字空間上のベクトル）と定義し、病名間の類似度を病名ベクトルのコサイン類似度とする考え方をとる。

まず、図1に示す病名データベースの病名表記（F列）を文字に分解する（図2）。

図1．病名データベース

図2．病名表記を単語分解

このシートでID列（A列）は図1の病名データベースの行番号を示す。語列（B列）には病名を構成する文字が1文字ずつ格納される。図1のシートから図2のシートを作成するプログラムを図3に示す。

Option Explicit

'
' 病名を語分解してベクトル表現する
'
Sub 病名を語分解()
Dim ws1 As Worksheet
Dim ws2 As Worksheet
Dim row1 As Long
Dim row2 As Long
Dim str As String
Dim i As Integer

    Set ws1 = Worksheets("19・20章データベース用")
    Set ws2 = Worksheets("分解")
    
    row1 = 2
    row2 = 2
    Do Until ws1.Cells(row1, 6).Value = "" Or row1 > 119
        str = ws1.Cells(row1, 6).Value
        For i = 1 To Len(str)
            ws2.Cells(row2, 1).Value = row1 - 1
            ws2.Cells(row2, 2).Value = Mid(str, i, 1)
            row2 = row2 + 1
        Next
        row1 = row1 + 1
    Loop
    
End Sub

図3．病名を語分解するプログラム

次に、図2のシートをもとにピボットテーブルを作成する（図4）。

図4．ピボットテーブル

 ピボットテーブルの行には「語」を、列には「ID」を、そしてΣ値には「語」の個数を設定する。すると、図3のように1列（A列）目には病名を構成する単語が並び、B列にはIDが１の病名「むちうち損傷」の単語ベクトル（列ベクトル）が、C列にはIDが2の病名「咽喉圧挫損傷」の単語ベクトルが、・・・と各病名の単語ベクトルが生成される。

図4のピボットテーブルの右側に図5に示すような検索キーワードを入力するセルDR2とその隣にActiveXコントロールで検索ボタンを作成する（オブジェクト名はWVCommandButton）。

図5．類似病名検索

 検索ボタンをクリックすると、検索キーワードに入力された文字列から病名ベクトルを生成してDP列に出力する。図6にそのプログラム（検索ボタンWVCommandButtonのクリック時のイベントプロシージャ）を示す。

Option Explicit

'
' 単語ベクトル検索
'
Private Sub WVCommandButton_Click()
Dim query_str As String
Dim search_range As Range
Dim ICD11_code As String
Dim c As String
Dim i As Integer
Dim j As Long

    Set search_range = Worksheets("19・20章データベース用").Range("F2:O128")
    
    query_str = Me.Cells(2, 122).Value
    MsgBox query_str
    
    j = 5
    Do Until Me.Cells(j, 1).Value = ""
        Me.Cells(j, 120).Value = ""
        j = j + 1
    Loop
    
    '単語ベクトルに分解
    For i = 1 To Len(query_str)
        c = Mid(query_str, i, 1)
        Debug.Print i, c
        j = 5
        Do Until Me.Cells(j, 1).Value = ""
            If Me.Cells(j, 1).Value = c Then
                If Me.Cells(j, 120).Value = "" Then
                    Me.Cells(j, 120).Value = 1
                Else
                    Me.Cells(j, 120).Value = Me.Cells(j, 120).Value + 1
                End If
                Exit Do
            End If
            j = j + 1
        Loop
    Next
    ListCommandButton_Click

End Sub

'
' コサイン類似度の降順に結果を並べる
'
Private Sub ListCommandButton_Click()
Dim col As Long
Dim row As Long
Dim search_range As Range

    Set search_range = Worksheets("19・20章データベース用").Range("F2:O128")
    
    row = 5
    Do Until Me.Cells(row, 121).Value = ""
        Me.Cells(row, 121).Value = ""
        Me.Cells(row, 122).Value = ""
        Me.Cells(row, 123).Value = ""
        row = row + 1
    Loop
    
    row = 5
    col = 2
    Do Until Me.Cells(4, col).Value = ""
        Debug.Print Me.Cells(4, col).Value
        If Me.Cells(122, col).Value > 0 Then
            Me.Cells(row, 121).Value = Me.Cells(123, col).Value
            Me.Cells(row, 122).Value = search_range.Cells(col - 1, 1).Value
            Me.Cells(row, 123).Value = search_range.Cells(col - 1, 6).Value
            row = row + 1
        End If
        col = col + 1
    Loop
    Sort_Cos_Similarity
    
End Sub

'
' Sort_Cos_Similarity Macro
'
Private Sub Sort_Cos_Similarity()
    Me.Range("DQ5:DS119").Select
    Me.Sort.SortFields.Clear
    Me.Sort.SortFields.Add2 key:=Range( _
        "DQ5:DQ119"), SortOn:=xlSortOnValues, Order:=xlDescending, DataOption:= _
        xlSortNormal
    With Me.Sort
        .SetRange Range("DQ5:DS119")
        .Header = xlGuess
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With
End Sub

図6．病名を単語ベクトルの類似度の大きいものから順に出力するプログラム

WVCommandButton_Clickは、病名ベクトルを作り終えると関数ListCommandButton_Clickを呼び出す。この関数は、コサイン類似度の降順に病名を並べるプログラムである。

その説明をする前に図7を見てほしい。

図7．コサイン類似度の計算

 これはピボットテーブル図4のピボットテーブルの下端で、121行目に病名ベクトルのノルムを計算する計算式「=SQRT(SUMSQ(B5:B119))」が、122行名には当該病名ベクトルとDP列に出力された検索キーワードの病名ベクトルの内積を計算する式「=SUMPRODUCT(B5:B119,$DP5:$DP119)」が、そして123行名にはそれらから計算されるコサイン類似度の計算式「=B122/B121/$DP121」が入っている（計算式の例示はB列であるが、それがすべての病名について計算されている）。

関数ListCommandButton_Clickは、内積が0でない病名を抽出して、コサイン類似度と対応する病名及びDPC11コードを各々DQ列、DR列、DS列に転記し、最後に関数Sort_Cos_Similarityを使ってコサイン類似度の降順にソートする。こうして類似病名検索されたのが図8である。

図8．コサイン類似度病名検索

 興味深いことに同じような文字を含む病名が上位から順に並んでいる。これらは正規表現による検索では得られないもので、人間に近い感覚で類似病名が検索されていることがわかる。

ライブラリ構築

ここまでは、ピボットテーブルとExcel関数、そしてVBAを補助的に用いて単語類似度に基づく病名検索の考え方を説明しながら病名検索の試作品を作成してきた。しかしながら、実際のアプリケーションではピボットテーブルやExcel関数を利用するわけにはいかない。なぜなら、それらは間に手作業が介入するため自動化すること（ボタンを押せば一発で検索すること）ができないからである。

そこで、ここでは単語類似度に基づく病名検索のライブラリ化を行い、それを用いた病名検索のプロトタイプを作成する。図9に作成するプロトタイプを示す。

図9．ライブラリを用いた単語類似度病名検索

画面の動きは、検索ワード（セルB2）に病名を入力して［検索］ボタンをクリックすると、コンボボックスに類似度の降順に病名がリストされ、それから選択するとICD11コードがセルB3に表示されるようになっている。このプログラム（シートモジュール）を図10に示す。

Option Explicit

'
' 単語類似度検索
'
Dim gDic As CDic
Dim search_range As Range

'
' ワークシートがアクティブになったときgDicを初期化する
'
Private Sub Worksheet_Activate()
    Set gDic = New CDic
    Set search_range = Worksheets("19・20章データベース用").Range("F2:O119")
    gDic.addFromRange search_range
End Sub

'
' 検索ボタンを押されたときの処理
'
Private Sub WVButton_Click()
Dim query_str As String
Dim i As Integer
Dim cbox As ComboBox
    
Dim e() As sortElement
Dim d As CDisease
    
    Set cbox = Me.DiseaseComboBox
    cbox.Clear

    query_str = Me.Cells(2, 2).Value
    Set d = New CDisease
    d.init query_str
    
    'もしもgDicが初期化されていなかったら、初期化する
    If gDic Is Nothing Then
        Worksheet_Activate
    End If

    e = gDic.most_similar(d)
    
    For i = 1 To UBound(e)
        cbox.AddItem e(i).item.name_
    Next

End Sub

Private Sub DiseaseComboBox_Click()
Dim ICD11_code As String
    ICD11_code = Application.WorksheetFunction.VLookup(Me.DiseaseComboBox.Value, search_range, 6, False)
    Me.Cells(3, 2).Value = ICD11_code
End Sub

図10．ライブラリを利用した類似病名検索シートのシートモジュール

このプログラムは、病名クラス(CDisease)と辞書クラス(CDic)を利用している。

病名を表現するクラスCDiseaseの定義を図11に示す。

'-----------------------------------------------
'
' 病名を表現するクラス：CDisease
'
'-----------------------------------------------

Option Explicit

'
' 病名クラス
'
Public name_ As String      '病名
Private ch_ As Dictionary   '病名を構成する文字(key)とその頻度(item)

'
' 初期化
'
Public Sub init(name As String)
Dim i As Integer
Dim c As String
Dim index As Integer
    name_ = name
    Set ch_ = New Dictionary
    For i = 1 To Len(name)
        c = Mid(name, i, 1)
        If ch_.Exists(c) Then
            ch_(c) = ch_(c) + 1
        Else
            ch_(c) = 1
        End If
    Next
End Sub

'
' 病名ベクトルのノルムを返す
'
Public Function norm() As Double
Dim sum_ As Double
Dim c As Variant
    sum_ = 0#
    For Each c In ch_
        sum_ = sum_ + ch_(c) ^ 2
    Next
    norm = Math.Sqr(sum_)
End Function

'
' 当該病名と引数に指定された病名との内積を計算して返す
'
Public Function dot(d As CDisease) As Double
Dim c As Variant
    dot = 0#
    For Each c In ch_
        dot = dot + ch_(c) * d.freq(CStr(c))
    Next
End Function

'
' 当該病名と引数に指定された病名とのコサイン類似度を計算して返す
'
Public Function similarity(d As CDisease) As Double
    similarity = dot(d)
    If similarity = 0 Then Exit Function
    similarity = similarity / norm() / d.norm()
End Function

'
' 病名に含まれている文字の出現頻度を求める
'
Public Function freq(c As String) As Integer
    If ch_.Exists(c) Then
        freq = ch_(c)
    Else
        freq = 0
    End If
End Function

'
' 属性表示
'
Public Function toString() As String
Dim str As String
Dim c As Variant
Dim dlm As String
    str = name_ & "("
    dlm = ""
    For Each c In ch_
        str = str & dlm & c & ":" & ch_(c)
        dlm = ","
    Next
    toString = str & ")"
End Function

図11．病名クラス CDisease

これは病名を文字空間ベクトルモデル（病名を構成する個々の文字が座標軸で、その出現頻度が座標の値となる多次元空間上の1点で病名を表すモデル）で表現するクラスモジュールである。このクラスは、病名を格納する文字列型の属性(name_)と病名を構成する文字とその頻度を格納するDictionary型の属性(ch_)をクラス属性として持っている。また、メソッドとしては、病名を引数にとり、属性name_やch_に格納する初期化メソッドinit、病名ベクトルのノルムを計算して返すnormメソッド、引数に指定された病名との内積を計算して返すdotメソッド、引数に指定された病名とのコサイン類似度を計算して返すsimilarityメソッド、病名に含まれている文字の出現頻度を求めるfreqメソッド、そして、インスタンスを文字列化するtoStringメソッドからなる。

次に、病名の辞書クラスCDicのソースコードを図12に示す。これも、CDiseaseと同様にクラスモジュールで作成されている。

'-----------------------------------------------
'
' 病名を構成する文字を管理する辞書クラス：CDic
'
'-----------------------------------------------

Option Explicit

Private diseases_ As Collection '病名(CDisease)コレクション（keyは病名）

' コンストラクタ
Private Sub Class_Initialize()
    Set diseases_ = New Collection
End Sub

' 病名をRangeから追加
Public Sub addFromRange(r As Range)
Dim i As Integer
Dim disease_name As String
    For i = 1 To r.Rows.Count
        disease_name = r.Cells(i, 1).Value
        add disease_name
    Next
End Sub

' 病名を追加
Public Sub add(str As String)
Dim disease As CDisease
    Set disease = New CDisease
    disease.init str
    diseases_.add disease, str
End Sub

'
' 第1引数に指定された病名(d)とのcos類似度を計算して
' 類似度の降順に並べたsortElement構造体配列を返す
'
Public Function most_similar(d As CDisease) As sortElement()
Dim x As CDisease
Dim i As Integer
Dim row As Integer
Dim similarity As Double
Dim e() As sortElement
Dim length As Integer

    'cos類似度を計算してリスト
    length = 0
    For i = 1 To diseases_.Count
        Set x = diseases_.item(i)
        similarity = x.similarity(d)
        If similarity > 0 Then
            length = length + 1
            ReDim Preserve e(length) As sortElement
            e(length).key = similarity
            Set e(length).item = x
        End If
    Next
    
    'cos類似度の降順にソート(降順)
    qsort_ e, 1, length
    
    most_similar = e

End Function

'クイックソート(e().keyの降順)
Private Sub qsort_(a() As sortElement, iLeft As Variant, iRight As Variant)
Dim i, j As Integer
Dim b As sortElement

    '中央値を取得
    Dim iMid As Variant '中央値
    iMid = a(Int((iLeft + iRight) / 2)).key
    
    i = iLeft '左側の探索用変数
    j = iRight '右側の探索用変数
    
    '中央値から左側と右側の値を入れ替えていく
    Do
        '中央値から左側のループ
        Do While a(i).key > iMid
            '中央値以下の値まで右側に探索していく
            i = i + 1
        Loop
        
        '中央値から右側のループ
        Do While iMid > a(j).key
            '中央値以上の値まで左側に探索していく
            j = j - 1
        Loop
        
        '左側探索と右側探索の位置が交差したら終了
        If i >= j Then Exit Do
        
        'まだ交差していない場合、左側と右側の値を入れ替える
        b = a(i)
        a(i) = a(j)
        a(j) = b
        
        '左側は1つ右からスタート
        i = i + 1
        '右側は1つ左からスタート
        j = j - 1
    Loop
    
    '中央値から左側を入れ替えていく（再帰）
    If iLeft < i - 1 Then
        Call qsort_(a, iLeft, i - 1)
    End If
    
    '中央値から右側を入れ替えていく（再帰）
    If j + 1 < iRight Then
        Call qsort_(a, j + 1, iRight)
    End If
    
End Sub

'
' 第1引数に指定された病名(d)とのcos類似度を計算して
' 第2引数に指定されたRange(r)にcos類似度と病名のタプルをリストする
'
Public Sub diseasesIntoRange(d As CDisease, r As Range)
Dim row As Integer
Dim e() As sortElement

    '第1引数に指定された病名(d)とのcos類似度の降順のソート
    e = Me.most_similar(d)

    '第2引数に指定されたRange(r)リスト
    row = 1
    Do Until row > UBound(e)
        If row > r.Rows.Count Then Exit Do
        r.Cells(row, 1).Value = e(row).key
        r.Cells(row, 2).Value = e(row).item.name_
        row = row + 1
    Loop
    
    ' 余白は空欄
    Do Until row > r.Rows.Count
        r.Cells(row, 1).Value = ""
        r.Cells(row, 2).Value = ""
        row = row + 1
    Loop

End Sub

図11．病名の辞書クラスCDic

CDicクラスは病名集を表現するオブジェクトである。このクラスの唯一のプライベート変数diseases_はCDiseaseクラスのインスタンスである病名オブジェクトのコレクションである。このクラスには、病名集をExcelのRange型から読み込んでCDiseaseインスタンスを生成してdiseases_コレクションに追加するaddFromRangeメソッドがある。これはこのオブジェクトの初期化メソッドであり、このオブジェクトの他のメソッドを利用する前に必ず一度だけ呼び出さなければならない。たとえば、図10の「ライブラリを利用した類似病名検索シートのシートモジュール」では、ワークシートがアクティブになった際に呼び出されるWorksheet_Activateイベントプロシージャでこの初期化メソッドが呼び出されている。その際、引数に与える病名集は図1「病名データベース」に示したワークシートの黄色い部分である（このRangeの第1列が病名集になっている）。

addメソッドは病名を単体で辞書へ追加するメソッドで、通常はaddFromRangeから呼び出される下請け的なメソッドである。

most_similarメソッドは、引数に指定したCDiseaseオブジェクトの病名インスタンスdに類似した病名をコサイン類似度の降順にリストして返すメソッドである。なお、戻り値は図12に示す構造体の配列になっている（構造体の宣言は標準モジュールで行う）。

Type sortElement
    item As Object
    key As Double
End Type

図12．most_similarメソッドの戻り値（配列）の要素となる構造体

この構造体はObject型の要素itemと実数型（倍精度浮動小数点数）の要素keyからなっており、itemにはCDiseaseクラスのオブジェクトが、keyにはそのインスタンスとdのコサイン類似度が格納されている。図9の［検索］ボタンがクリックされると図10のWVButton_Clickイベントプロシージャが呼び出され、e = gDic.most_similar(d)が実行され、検索ワードに入力された病名dと類似した病名が辞書gDicから類似した順にリストされ、それがコンボボックス（cbox）に追加される。 その結果、図9に示すようなコンボボックスが得られる。

CDicクラスには、引数に指定された病名dに類似した病名をその類似度の高い順にリストして引数に指定されたExcelのRangeへ出力するdiseasesIntoRangeメソッドも実装している。これは、類似病名をコンボボックスではなくExcelのシートに直接表示したい場合に役立つメソッドである。 

最後に図11内にあるqsort_メソッドは図12に示す構造体の配列をkeyの降順にソートするクイックソートである。これは内部でしか使わないのでプライベートメソッドになっている。

図9でコンボボックスから病名を選択すると、図10のDiseaseComboBox_Clickイベントプロシージャが呼び出され、選択された病名（Me.DiseaseComboBox.Value）に対応するICDコードを図1の病名データベースから（Vlookup関数を使って）求め、Excelのシート（セルB3）に出力する。