#ツールの概要とリリース場所
ワード版リント君は、文章の表記揺れを検知するソフトウエアです。
このツールは、パワポエンジニアの憂鬱を軽減する誤字/表記揺れ検出ツールを作った物語に基づいて、実装しました。
ワード版リント君のリリース場所は以下です。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 を起動すればインストール可能です。
追記:よく考えてみると、「会社パソコンへのソフトインストールに許可が必要」な場合には適用できないですね。近日中にインストーラ版以外にも、アドインファイル自体も公開して、手作業でインストール可能にします。
#コード説明
・MS-Wordのリボンからワード版リント君を呼び出せるように、WordアドインにカスタムUIのxmlを登録しました。リボン上の「表記揺れ」ボタンをクリックしたときに Callback_wordLintkun が呼び出されます。
<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上にリボンと「表記揺れ」ボタンが表示されます。
・コールバック関数は、単にワード版リント君の関数をコールしているだけです。
Option Explicit
'Callback for Auto_JP onAction
Sub Callback_wordLintkun(control As IRibbonControl)
Call ワード版リント君
End Sub
##ワード版リント君の関数
最初はプログレスバーのフォームを表示します。
'======================================================================
' 正規化した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 で単語分割して単語表に追加します。なお、処理に応じてプログレスバーを更新します。
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以下ならば、表記揺れの可能性があると判定して、ワークシートに書き込みます。
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距離を除算します。
'======================================================================
' 正規化した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
'======================================================================
' 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のリボンに表示されている「表記揺れ」ボタンをクリックしてください。
次に、Excelワークシートへの結果出力の進捗を示すプログレスバーが表示されます。
Excelが起動していますので、そのワークシートを確認してください。表記揺れの可能性のある文字列のペアが各カラムに表示されます。
#後書き
深夜の或る特許事務所、ワイ君は「Word版リント君」のコーディングとテストに励むのであった。
ワイ「所長にお小言を言われた部分を、このツールでチェックしたで」
ワイ「やった!【インタフェース】【インターフェース】【インターフェイス】の表記揺れを検出できたで!」
ワイ「【トラフィック】【トラヒック】もOKや」
ワイ「【ダイヤル】と【ダイアル】もや。」
ワイ「2つの文字列の組合せが重複して表示されるのはご愛敬やが、
これも対処した方がええやろなあ。」
・・・・
ワイ「【行なう】と【行う】は抽出してくれんなあ。
両方とも「おこなう」の読みやから、表記が類似して読みが同じなら表記揺れやと判定すればええんやろうけど、
IWordBreaker やのうて、ちゃんとした形態素解析エンジンでないとできんなあ。」
ワイ「【ギア】と【ギヤ】も抽出してくれんなあ。
2文字中1文字の違いやと、50%やから無理やなあ。判定範囲外や。
ローマ字で書けば、giyaとgiaやから、4文字中1文字違い、25%で似てるのになあ。
せや、かな文字の比較はローマ字に変換してからDamerau-Levenshtein距離をとれば・・・。
次のバージョンの課題やな。」
ワイ「パワポエンジニアの憂鬱の例題も試したろ」
ワイ「とりあえず全部リストアップ出来とるみたいやな。」
ワイ「他の公報とかも試したろ。特開2010-130410や。」
ワイ「【MFPl0】【MPF10】の誤記が拾えたのはよかったで。」
ワイ「でも、用言の変化をもろに拾ってるなあ。
【問い合わせる】と【問い合わせ】とかを表記揺れとされるのは痛いなあ。
やっぱり形態素解析して、名詞に限らんといかんかなぁ。」
ワイ「名詞も【プリンタドライバ】と【プリンタドライバ上】が表記揺れとされとる。
IWordBreakerの癖で、名詞に接尾辞をつけてしまうんやろうなあ。」
Comments
Let's comment your feelings that are more than good