Edited at

特許技術者の憂鬱を軽減する誤字/表記揺れ検出ツールのWord版


ツールの概要とリリース場所

ワード版リント君は、文章の表記揺れを検知するソフトウエアです。

このツールは、パワポエンジニアの憂鬱を軽減する誤字/表記揺れ検出ツールを作った物語に基づいて、実装しました。

ワード版リント君のリリース場所は以下です。lintkun_0010.zip をダウンロードして解凍し、setup.exeを実行してください。

https://osdn.net/projects/lintkun/releases

(注:インストールが上手くいかないときは、setup.exe を管理者権限で起動してください。)

(ソースコードも、そのうちアップロードします。)


前書き

或るブラック特許事務所の午後。

ワイ「あー、今日もワード、明日もワードで明細書書きや。」

ワイ「1ページ2000文字で、15ページくらいの明細書を2~3日で仕上げんとなあ。

   ほんまに腱鞘炎になるで。」

ブラック所長「クライアント企業に納品する特許明細書できたか?」

ワイ「はい、できました!」

ブラック所長「なんやこれは、誤字だらけやないかい!」

ブラック所長「【行なう】じゃのうて【行う】や!JISZ8301にそう書いてあるやろ!」

ブラック所長「【ギア】ってなんや、誤字やろ!【ギヤ】や!」

ブラック所長「【インタフェース】【インターフェース】【インターフェイス】と表記揺れしとるがな、」

ブラック所長「【トラフィック】やのうて【トラヒック】や」

ブラック所長「【ダイヤル】と【ダイアル】とが混在しとるぞ!」

ワイ「は、はい(白目)」

ブラック所長「誤字、脱字、表記の揺れ、があると、

       クライアント企業に、中身もその程度の品質だって思われるぞ!」

ブラック所長「納品時に厳しくチェックされるし注意せなあかん!」

ワイ「はい(白目)」

ブラック所長「ほな、ワシはとりあえず帰るぞ。」

・・・

ワイ「あー、ブラック所長はとっとと帰ってしもうたか。

   なんや最近の所長は、どうでもいい重箱の隅つつきばっかやなあ。

   まあええわ、こんな重箱の隅なところは、機械でチェックしたるぞ。」


特徴

ワード版リント君の実装形態は、VBAのWordアドインとしました。MS-Wordの編集作業中にシームレスに呼び出すことができます。

分かち書きはJanomeなどの形態素解析エンジンではなく、IWordBreakerを用いました。これもまた問題なのですがそれは後述します。


インストール方法

 インストールシールドLEでsetup.exe を構築しました。setup.exe を起動すればインストール可能です。

 追記:よく考えてみると、「会社パソコンへのソフトインストールに許可が必要」な場合には適用できないですね。近日中にインストーラ版以外にも、アドインファイル自体も公開して、手作業でインストール可能にします。

インストール1.png

インストール2.png


コード説明

・MS-Wordのリボンからワード版リント君を呼び出せるように、WordアドインにカスタムUIのxmlを登録しました。リボン上の「表記揺れ」ボタンをクリックしたときに Callback_wordLintkun が呼び出されます。


カスタムUI

<customUI xmlns="http://schemas.microsoft.com/office/2006/01/customui">

<ribbon startFromScratch="false">
<tabs>
<tab idMso="TabAddIns" label="AppLint">
<group id="LintkunGroupJP" label="リント君">
<button id="idWordLintkun" label="表記揺れ" imageMso="TextBoxPositionGallery" size="large" onAction="Callback_wordLintkun" screentip="ver.0.0.1.0" />
</group>
</tab>
</tabs>
</ribbon>
</customUI>

・カスタムUI.xmlにより、MS-Word上にリボンと「表記揺れ」ボタンが表示されます。

リボン.png

・コールバック関数は、単にワード版リント君の関数をコールしているだけです。


Callbacks

Option Explicit

'Callback for Auto_JP onAction
Sub Callback_wordLintkun(control As IRibbonControl)
Call ワード版リント君
End Sub



ワード版リント君の関数

最初はプログレスバーのフォームを表示します。


ワード版リント君の関数(1/3)

'======================================================================

' 正規化したDamerau-Levenshtein距離を用いて表記揺れを算出
' 所定値以下は、表記揺れの可能性ありとしてExcelに書き出し
' Date : 17/Apr/2019
' Programmer : Ken'ichiro Ayaki
'======================================================================
Public Sub ワード版リント君()
Dim Bar As New ProgressForm
Application.StatusBar = "ワード版リント君"
Bar.MaxCount = ActiveDocument.Sentences.Count 'プログレスバーの最大カウント数を設定(ループ回数)
Bar.ShowBar 'プログレスバーを表示

・IWordBreaker で単語分割して単語表に追加します。なお、処理に応じてプログレスバーを更新します。


ワード版リント君の関数(2/3)

    Dim 単語 As Word.range

Dim 文章 As Word.range
Dim 単語表 As Object
Set 単語表 = CreateObject("scripting.dictionary")
Dim s単語 As String

' プログレスバーの表示オーバーヘッドを防ぐため、ドキュメント→文章→単語の順で分割
Dim 文章数 As Long
文章数 = 0
For Each 文章 In ActiveDocument.Sentences
Bar.CountUp 'プログレスバーをカウントアップ
If Bar.StopProcedure = True Then 'キャンセルボタンをが押されたときの処理
MsgBox "処理を中断しました。"
Exit Sub
End If
Bar.Message = "形態素解析進捗 " & Int(文章数 * 100# / ActiveDocument.Sentences.Count) & "%"

For Each 単語 In 文章.Words
s単語 = Trim(単語.Text)
If Len(s単語) > 3 Then
If 単語表.Exists(s単語) = False Then
単語表.Add s単語, Len(s単語)
End If
End If
Next
文章数 = 文章数 + 1
Next


・次に、Excelのワークシートを開きます。そして単語表から2つの単語を取り出して、正規化したDamerau-Levenshtein距離を算出します。その値が 0.34以下ならば、表記揺れの可能性があると判定して、ワークシートに書き込みます。


ワード版リント君の関数(3/3)

    Dim xl As Object

Set xl = CreateObject("Excel.Application")
xl.Visible = True
xl.Workbooks.Add
xl.Cells(1, 1) = ActiveDocument.name & "のリント結果"

Dim v単語0 As Variant
Dim v単語1 As Variant
Dim s単語0 As String
Dim s単語1 As String

Dim row As Long
Dim col As Long

Application.StatusBar = "ワード版リント君"
Bar.MaxCount = 単語表.Count 'プログレスバーの最大カウント数を設定(ループ回数)

Dim 単語cnt As Long
xl.Cells(2, 1) = "比較元"
col = 3
単語cnt = 1
For Each v単語0 In 単語表
Bar.CountUp 'プログレスバーをカウントアップ
If Bar.StopProcedure = True Then 'キャンセルボタンをが押されたときの処理
MsgBox "処理を中断しました。"
Exit Sub
End If
Bar.Message = "Excelへの出力 " & Int(単語cnt * 100# / 単語表.Count) & "%"

s単語0 = v単語0
row = 1
xl.Cells(col, row) = s単語0
For Each v単語1 In 単語表
s単語1 = v単語1
If s単語0 <> s単語1 Then
If NormalizeWeightedDL(s単語0, s単語1) <= 0.34 Then
row = row + 1
xl.Cells(col, row) = s単語1
xl.Cells(2, row) = "比較先"
End If
End If
Next
If row <> 1 Then
col = col + 1
Else
xl.Cells(col, row) = ""
End If
単語cnt = 単語cnt + 1
Next
Set xl = Nothing
Unload Bar
End Sub



正規化したDamerau-Levenshtein距離の算出関数

sourceとtargetの2つの単語のDamerau-Levenshtein距離を算出したのち、2つの単語のうち長い方でDamerau-Levenshtein距離を除算します。


NormalizeWeightedDL

'======================================================================

' 正規化したDamerau-Levenshtein距離の算出
'======================================================================
Public Function NormalizeWeightedDL(source As String, target As String) As Double
Dim lSource As Long
Dim lTarget As Long

lSource = Len(source)
lTarget = Len(target)
If lSource > lTarget Then
NormalizeWeightedDL = WeightedDL(source, target) / lSource
Else
NormalizeWeightedDL = WeightedDL(source, target) / lTarget
End If
End Function



Damerau-Levenshtein距離の算出

以下のURLを参考としました。

https://stackoverflow.com/questions/13693149/weighted-damerau-levenshtein-in-vba


WeightedDL

'======================================================================

' Damerau-Levenshtein距離の算出
' https://stackoverflow.com/questions/13693149/weighted-damerau-levenshtein-in-vba
'======================================================================
Public Function WeightedDL(source As String, target As String) As Double

Dim deleteCost As Double
Dim insertCost As Double
Dim replaceCost As Double
Dim swapCost As Double

deleteCost = 1
insertCost = 1
replaceCost = 1
swapCost = 0.8

Dim i As Long
Dim j As Long
Dim k As Long

If Len(source) = 0 Then
WeightedDL = Len(target) * insertCost
Exit Function
End If

If Len(target) = 0 Then
WeightedDL = Len(source) * deleteCost
Exit Function
End If

Dim table() As Double
ReDim table(Len(source), Len(target))

Dim sourceIndexByCharacter() As Variant
ReDim sourceIndexByCharacter(0 To 1, 0 To Len(source) - 1) As Variant

If Left(source, 1) <> Left(target, 1) Then
table(0, 0) = aMin(replaceCost, (deleteCost + insertCost))
End If

sourceIndexByCharacter(0, 0) = Left(source, 1)
sourceIndexByCharacter(1, 0) = 0

Dim deleteDistance As Double
Dim insertDistance As Double
Dim matchDistance As Double

For i = 1 To Len(source) - 1

deleteDistance = table(i - 1, 0) + deleteCost
insertDistance = ((i + 1) * deleteCost) + insertCost

If Mid(source, i + 1, 1) = Left(target, 1) Then
matchDistance = (i * deleteCost) + 0
Else
matchDistance = (i * deleteCost) + replaceCost
End If

table(i, 0) = aMin(aMin(deleteDistance, insertDistance), matchDistance)
Next

For j = 1 To Len(target) - 1

deleteDistance = table(0, j - 1) + insertCost
insertDistance = ((j + 1) * insertCost) + deleteCost

If Left(source, 1) = Mid(target, j + 1, 1) Then
matchDistance = (j * insertCost) + 0
Else
matchDistance = (j * insertCost) + replaceCost
End If

table(0, j) = aMin(aMin(deleteDistance, insertDistance), matchDistance)
Next

For i = 1 To Len(source) - 1

Dim maxSourceLetterMatchIndex As Long

If Mid(source, i + 1, 1) = Left(target, 1) Then
maxSourceLetterMatchIndex = 0
Else
maxSourceLetterMatchIndex = -1
End If

For j = 1 To Len(target) - 1

Dim candidateSwapIndex As Long
candidateSwapIndex = -1

For k = 0 To UBound(sourceIndexByCharacter, 2)
If sourceIndexByCharacter(0, k) = Mid(target, j + 1, 1) Then candidateSwapIndex = sourceIndexByCharacter(1, k)
Next

Dim jSwap As Long
jSwap = maxSourceLetterMatchIndex

deleteDistance = table(i - 1, j) + deleteCost
insertDistance = table(i, j - 1) + insertCost
matchDistance = table(i - 1, j - 1)

If Mid(source, i + 1, 1) <> Mid(target, j + 1, 1) Then
matchDistance = matchDistance + replaceCost
Else
maxSourceLetterMatchIndex = j
End If

Dim swapDistance As Double

If candidateSwapIndex <> -1 And jSwap <> -1 Then

Dim iSwap As Long
iSwap = candidateSwapIndex

Dim preSwapCost
If iSwap = 0 And jSwap = 0 Then
preSwapCost = 0
Else
preSwapCost = table(aMax(0, iSwap - 1), aMax(0, jSwap - 1))
End If

swapDistance = preSwapCost + ((i - iSwap - 1) * deleteCost) + ((j - jSwap - 1) * insertCost) + swapCost

Else
swapDistance = 500
End If

table(i, j) = aMin(aMin(aMin(deleteDistance, insertDistance), matchDistance), swapDistance)

Next

sourceIndexByCharacter(0, i) = Mid(source, i + 1, 1)
sourceIndexByCharacter(1, i) = i

Next

WeightedDL = table(Len(source) - 1, Len(target) - 1)

End Function
'======================================================================
' 最小値
'======================================================================
Private Function aMin(v1 As Double, v2 As Double) As Double
If v1 < v2 Then
aMin = v1
Else
aMin = v2
End If
End Function

'======================================================================
' 最大値
'======================================================================
Private Function aMax(v1 As Double, v2 As Double) As Double
If v1 < v2 Then
aMax = v2
Else
aMax = v1
End If
End Function



実行方法

MS-Wordのリボンに表示されている「表記揺れ」ボタンをクリックしてください。

リボン.png

最初、形態素解析の進捗を示すプログレスバーか表示されます。

プログレスバー0.png

次に、Excelワークシートへの結果出力の進捗を示すプログレスバーが表示されます。

プログレスバー1.png

Excelが起動していますので、そのワークシートを確認してください。表記揺れの可能性のある文字列のペアが各カラムに表示されます。


後書き

深夜の或る特許事務所、ワイ君は「Word版リント君」のコーディングとテストに励むのであった。

所長.png

ワイ「所長にお小言を言われた部分を、このツールでチェックしたで」

ワイ「やった!【インタフェース】【インターフェース】【インターフェイス】の表記揺れを検出できたで!」

ワイ「【トラフィック】【トラヒック】もOKや」

ワイ「【ダイヤル】と【ダイアル】もや。」

ワイ「2つの文字列の組合せが重複して表示されるのはご愛敬やが、

   これも対処した方がええやろなあ。」

   ・・・・

ワイ「【行なう】と【行う】は抽出してくれんなあ。

   両方とも「おこなう」の読みやから、表記が類似して読みが同じなら表記揺れやと判定すればええんやろうけど、

   IWordBreaker やのうて、ちゃんとした形態素解析エンジンでないとできんなあ。」

ワイ「【ギア】と【ギヤ】も抽出してくれんなあ。

   2文字中1文字の違いやと、50%やから無理やなあ。判定範囲外や。

   ローマ字で書けば、giyaとgiaやから、4文字中1文字違い、25%で似てるのになあ。

   せや、かな文字の比較はローマ字に変換してからDamerau-Levenshtein距離をとれば・・・。

   次のバージョンの課題やな。」

ワイ「パワポエンジニアの憂鬱の例題も試したろ」

無題.png

ワイ「とりあえず全部リストアップ出来とるみたいやな。」

ワイ「他の公報とかも試したろ。特開2010-130410や。」

公報チェック.png

ワイ「【MFPl0】【MPF10】の誤記が拾えたのはよかったで。」

ワイ「でも、用言の変化をもろに拾ってるなあ。

  【問い合わせる】と【問い合わせ】とかを表記揺れとされるのは痛いなあ。

  やっぱり形態素解析して、名詞に限らんといかんかなぁ。」

ワイ「名詞も【プリンタドライバ】と【プリンタドライバ上】が表記揺れとされとる。

   IWordBreakerの癖で、名詞に接尾辞をつけてしまうんやろうなあ。」