レーベンシュタイン距離で文字列の差分を調べる

2018年4月6日2018年10月13日

正しい住所と間違った住所の差分に

間違った住所をどうやって見つけていくかですが、基本的には郵便データにある「都道府県・市・区・町・村・郡・町域」と入手した名刺からスキャンした住所を比較していきます。
きちんとマッチングできればそれでよしなんですが、当然、誤認識された住所については一致しません。
で、不一致になった住所について、候補となりうる住所の部分となるべく近しい住所を調べるのですが、その方法としてレーベンシュタイン距離という方法をとっています。

具体的にはそれぞれの住所を比較して、その違っている文字数を調べるというものです。

参考ソースコード

難しい理論は置いといて今日は参考になるソースコードを添付しておきます。
下記は、Visual Basicの例です。

'************************************************************************
'* (.NET)文字列の比較 / 第１引数：元のテキスト　第２引数：比較テキスト
'************************************************************************
Public Function lsDist(baseText As String, tryText As String) As Integer

	Dim matrix(,) As Integer
	Dim matmin() As Integer
	Dim i As Integer, j As Integer, cost As Integer

	lsDist = 0

	If (baseText = tryText) Then
		Exit Function
	End If
	If (Len(baseText) = 0) Then
		lsDist = Len(tryText)
		Exit Function
	End If
	If (Len(tryText) = 0) Then
		lsDist = Len(baseText)
		Exit Function
	End If

	ReDim matrix(Len(baseText), Len(tryText))

	For i = 0 To Len(baseText)
		matrix(i, 0) = i
	Next i

	For j = 0 To Len(tryText)
		matrix(0, j) = j
	Next j

	For i = 1 To Len(baseText)
		For j = 1 To Len(tryText)
			cost = IIf(Mid$(baseText, i, 1) = Mid$(tryText, j, 1), 0, 1)
			matmin = {matrix(i - 1, j) + 1, matrix(i, j - 1) + 1, matrix(i - 1, j - 1) + cost}
			matrix(i, j) = matmin.Min
		Next j
	Next i

	lsDist = matrix(Len(baseText), Len(tryText))

End Function

次にExcelで使用する場合もあると思いますので Visual Basic for Applications（VBA）もあわせて添付しておきます。

'************************************************************************
'* (VBA)文字列の比較 / 第１引数：元のテキスト　第２引数：比較テキスト
'************************************************************************
Public Function lsDist(baseText As String, tryText As String) As Integer

    Dim matrix() As Variant
    Dim i As Integer, j As Integer, cost As Integer

    lsDist = 0

	If (baseText = tryText) Then
		Exit Function
	End If
	If (Len(baseText) = 0) Then
		lsDist = Len(tryText)
		Exit Function
	End If
	If (Len(tryText) = 0) Then
		lsDist = Len(baseText)
		Exit Function
	End If
  
	ReDim matrix(Len(baseText), Len(tryText))

	For i = 0 To Len(baseText)
		matrix(i, 0) = i
	Next i
  
	For j = 0 To Len(tryText)
		matrix(0, j) = j
	Next j

	For i = 1 To Len(baseText)
		For j = 1 To Len(tryText)
			cost = IIf(Mid$(baseText, i, 1) = Mid$(tryText, j, 1), 0, 1)
			matrix(i, j) = WorksheetFunction.Min(matrix(i - 1, j) + 1, matrix(i, j - 1) + 1, matrix(i - 1, j - 1) + cost)
		Next j
	Next i

	lsDist = matrix(Len(baseText), Len(tryText))

End Function