F# で文字列の一致度を測る

「そうだ、F# で文字列の一致度を測ってみよう」たったそれだけ言い残すと、たいだはパソコンの中に入っていったのです。

ということで、文字列同士の一致度を測定するプログラムを F# で書いてみました。イメージとしては、

「たいだ」と「たいと」の一致度は約66%
「たいだ」と「たこ」の一致度は40%
「たいだ」と「まじめ」の一致度は0%

のようなことです。

指標としてジャロ類似性 (Jaro Similarity) およびそのアレンジ版を使用しました。というか、単にジャロ類似性を F# でやりましたというだけです。Matthew A. Jaro 氏、ありがとうございます。

作業環境
コード
実行結果
説明
ジャロ・タイダログ類似性
結び
参考
更新

作業環境

Windows 10 Home 21H2 (OS Build 19044.2364)
F# 6.0
F# インタラクティブ 12.0.0.0
dotnet 6.0.112
Visual Studio Code 1.74.2
Ionide for F# v7.4.0

コード

namespace Taidalog

[<RequireQualifiedAccess>]
module Seq =
    let trySkip count source =
        if count > (source |> Seq.length) then
            None
        else
            Seq.skip count source |> Some


[<RequireQualifiedAccess>]
module String =
    let tryMid start len str =
        str
        |> Seq.trySkip start
        |> Option.map (Seq.truncate len)
        |> Option.map (Seq.map string)
        |> Option.map (String.concat "")


[<RequireQualifiedAccess>]
module Tuple =
    let map mapping (x, y) =
        mapping x, mapping y


module StringMetric =
    open System
    
    let jaroSimilarity s1 s2 =
        
        let midStart start range = Math.Max(0, start - range)
        let midLen start range = Math.Min(range * 2 + 1, start + range + 1)
        
        let getNearMatch range s1 s2 =
            s1
            |> Seq.mapi
                (fun i c->
                    c, (s2 |> String.tryMid (midStart i range) (midLen i range)))
            |> Seq.map (fun (c, s) -> c, Option.defaultValue "" s)
            |> Seq.filter
                (fun (c, s) -> s |> Seq.contains c)
            |> Seq.map (fun (c, _) -> c)
        
        let matchIndexes s1 s2 range =
            s1
            |> Seq.mapi
                (fun i1 c1->
                    i1, c1, String.tryMid (midStart i1 range) (midLen i1 range) s2)
            |> Seq.map (fun (i1, c1, s) -> i1, c1, Option.defaultValue "" s)
            |> Seq.map
                (fun (i1, c1, sub) ->
                    sub
                    |> Seq.indexed
                    |> Seq.filter (fun (i2, subc) -> subc = c1)
                    |> Seq.map (fun (i2, _) -> i2 + midStart i1 range)
                    |> Seq.toList)
            |> Seq.toList
        
        let rec updateBoolList indexes source =
            let indexes' = indexes |> List.filter (fun i -> i < List.length source)
            match indexes' with
            | [] -> source
            | _ ->
                let h = indexes' |> List.head
                if source |> List.item h = false then
                    source |> List.updateAt h true
                else
                    let t = indexes' |> List.tail
                    updateBoolList t source
        
        let w1 = 1. / 3.
        let w2 = 1. / 3.
        let wt = 1. / 3.
        
        let d = s1 |> String.length |> double
        let r = s2 |> String.length |> double
        let range = Math.Max(d, r) |> fun x -> x / 2. - 1. |> int
        
        let indexes = matchIndexes s1 s2 range
        
        let initBools = List.init (s2 |> String.length) (fun _ -> false)
        let updatedBools =
            (initBools, indexes)
            ||> List.fold (fun acc x -> updateBoolList x acc)
        
        let sub1 = getNearMatch range s1 s2
        let sub2 =
            (s2 |> Seq.toList, updatedBools |> List.toSeq)
            ||> Seq.zip
            |> Seq.filter (fun (c, b) -> b)
            |> Seq.map (fun (c, _) -> c)
        
        let c = sub1 |> Seq.length |> double
        let t =
            Seq.zip sub1 sub2
            |> Seq.countWith (fun (x, y) -> x <> y)
            |> double
            |> fun x -> x / 2.
        
        if s1 = "" || s2 = "" then
            None
        else if c = 0. then
            Some 0.
        else
            Some (w1 * c / d + w2 * c / r + wt * (c - t) / c)
    
    let jarotaidalogSimilarity s1 s2 =
        let w1 =
            (s1, s2)
            |> Tuple.map (String.length >> double)
            ||> fun x y -> 1. - ((x - y) / x |> abs)
        
        let subStr =
            s1
            |> Seq.truncate (String.length s2)
        
        let w2 =
            subStr
            |> Seq.filter (fun c -> s2 |> Seq.contains c)
            |> Seq.length
            |> double
            |> fun x -> x / (s2 |> String.length |> double)
        
        if s1 = "" || s2 = "" then
            None
        else
            jaroSimilarity s1 s2
            |> Option.map (fun s -> s * List.average [w1; w2])

Gist でどうぞ。

F# script to calculate Jaro Similarity. · GitHub

実行例

let s1 = "FAREMVIEL"
let s2 = "FARMVILLE"
jaroSimilarity s1 s2 |> printfn "%A"
// Some 0.8842592593

let s1 = "うろ覚え"
let s2 = "うる覚え"
jaroSimilarity s1 s2 |> printfn "%A"
// Some 0.8333333333

let s1 = "あめんぼあかいなあいうえお"
let s2 = "あめんぼ赤いなあいうえお"
jaroSimilarity s1 s2 |> printfn "%A"
// Some 0.8771367521

let s1 = "たいだ"
let s2 = "まじめ"
jaroSimilarity s1 s2 |> printfn "%A"
// Some 0.0000000000

実行結果

「あさきゆめみしゑひもせす」という文字列と、以下の文字列との類似性を測りました。下線付き赤字が一致しない部分です。

文字列	ジャロ類似性
あさきゆめみしゑひもせす	1.000000
あさゆきめみしゑひもせす	0.972222
あさきゆめみしゑいもせす	0.944444
あさき夢みしゑひもせす	0.914141
あさきゆめみしあいうえお	0.722222
あ	0.694444
ああああああああああああ	0.388889
しゑひもせす	0.000000
子丑寅卯辰巳午未申酉戌亥	0.000000

今度はもっと長い文字列で試しましょう。宮沢賢治氏の「ポラーノの広場」の一節をお借りします。

あのイーハトーヴォのすきとおった風、夏でも底に冷たさをもつ青いそら、うつくしい森で飾られたモリーオ市、郊外のぎらぎらひかる草の波。

上記の文字列と、以下の文字列との類似性を測りました。下線付き赤字が一致しない部分です。

文字列	ジャロ類似性
あのイーハトーヴォのすきとおった風、夏でも底に冷たさをもつ青いそら、うつくしい森で飾られたモリーオ市、郊外のぎらぎらひかる草の波。	1.000000
あのイーハトーヴォのすきおとった風、夏でも底に冷たさをもつ青いそら、うつくしい森で飾られたモリーオ市、郊外のぎらぎらひかる草の波。	0.994872
あのイーハトーヴォの透きとおった風、夏でも底に冷たさをもつ青いそら、うつくしい森で飾られたモリーオ市、郊外のぎらぎらひかる草の波。	0.989744
あのイーハトーヴォのすきとおった風、夏でも底に冷たさをもつ青いそら、	0.960483
あのイーハトーヴォのすきとおった風、夏でも底に冷たさをもつ青いそら、あああああああああああああああああああああああああああああああ	0.764103
あのイーハトーヴォのすきとおったかぜ、なつでもそこにつめたさをもつあおいそら、うつくしいもりでかざられたもりーおし、こうがいのぎらぎらひかるくさのなみ。	0.732375
あ	0.671795
うつくしい森で飾られたモリーオ市、郊外のぎらぎらひかる草の波。	0.448523
あああああああああああああああああああああああああああああああああああああああああああああああああああああああああああああああああ	0.343590
The quick brown fox jumps over the lazy dog	0.000000

説明

ジャロ類似性の説明は探せばたくさん見つかりますので、必要に応じて検索してください。

最初につまづくのは「近くで一致する文字数」というやつではないでしょうか。2 つの文字列 $s_1$ と $s_2$ について、「 $s_1$ の x 文字目（仮に 5 文字目としましょう）が、 $s_2$ の同じ位置（つまり 5 文字目）か、そこから前後 n 文字以内の場所にあれば一致しているとみなす」というやつです。「同じ文字が何文字目にあるか調べて、それが前後 n 文字以内か調べて……」なんて面倒なことはしたくなかったので、Excel の MID 関数を模した String.mid 関数を定義して、「同じ位置を中心に前後 n 文字を抜き出す」ということをしました。抜き出した中に同じ文字が入っていれば一致です。簡単。

一番苦戦したのは、 $s_1$ と $s_2$ の一致部分を抜き出す工程です。これでいいやと思ったのですが↓、

let matches1 = s1 |> String.filter (fun c -> s2 |> Seq.contains c)
let matches2 = s2 |> String.filter (fun c -> s1 |> Seq.contains c)

これでは s1 から同じ文字を重複して抜き出す可能性があるのと、 s2 内での文字の順番を維持できないのでいけません。結局、

List.init (s2 |> String.length) (fun _ -> false)

で s2 の要素数分の false のリストを作り、 s2 から文字を抜き出すときに、抜き出す文字の位置の false を true に変えることで、同じ文字を重複して数えないようにしました。mutable にはしていません。詳しくはコードをご覧ください。

転置の数は、一致部分の文字列 2 つを Seq.zip で「同じ位置の文字同士のタプルの Seq」にして、あとは Seq.filter で同じ位置の文字同士が異なるタプルを抽出して数えたらいいです。条件に合う要素の数を数えるために、Excel の COUNTIF 関数（私の推し関数です！）を模した Seq.countWith 関数を定義しました。

// matches1, matches2 はそれぞれ s1, s2 の一致部分。
// 仮に
// matches1 = "あさきゆみしゑもせす",
// matches2 = "あさゆきみしゑもせす" とする。
Seq.zip matches1 matches2 // seq [('あ', 'あ'); ('さ', 'さ'); ('き', 'ゆ'); ('ゆ', 'き'); ('み', 'み'); ...]
|> Seq.countWith (fun (x, y) -> x <> y) // seq [('き', 'ゆ'); ('ゆ', 'き')] が該当するので 2 を返す。

あとはジャロ氏が定めたもうた通りに足したり引いたり掛けたり割ったりします。

ジャロ・タイダログ類似性

なんとか F# でジャロ類似性を算出することができて、そこは満足したのですが、ひとつ納得いかないことがあります。お気付きでしょうか。「あさきゆめみしゑひもせす」と「あ」一文字の類似性が 0.694444 もあるのです。ほぼ 7 割。手計算でも同じ結果になりました（計算が合っていれば）。「ポラーノの広場」の方でも「あ」で約 7 割。残りの部分の重みはたった 3 割……。詩人が泣きますよ。

また、「あ」を連打するだけでも 3 割一致していることになっているのも気になります。万能すぎやしないか、「あ」。

そんなわけで、文字数や文字種の一致度も加味するように変形させてみました。便宜上「ジャロ・タイダログ類似性」と呼ばせていただきます。ジャロ・タイダログ類似性のポイントは以下の通りです。

2 つの文字列 $s_1$ と $s_2$ について、

$s_1$ と $s_2$ が異なる場合、 $s_1$ が正しいものとして扱う
$s_1$ の長さと $s_2$ の長さの差が大きいほど類似性を下げる
$s_1$ に含まれている文字が $s_2$ に含まれていなければ類似性を下げる

ポイント 2 は、「あ」一文字への対策、ポイント 3 は「あ」連打への対策です。

文字列 $s_1$ と $s_2$ のジャロ・タイダログ類似性 $sim_t$ は以下の式で表します。

$sim_t = sim_j\dfrac{(1 - |\frac{l_1 - l_2}{l_1}|) + \frac{c}{l_1}}{2}$

ここで、

$sim_j$ は文字列 $s_1$ と $s_2$ のジャロ類似性
$l_i$ は $s_i$ の文字数
$c$ は $s_1$ に含まれる文字のうち $s_2$ にも含まれる文字の数（出現する順番を問わない。同じ文字を複数回数える。 $s_1$ のうち、 $s_2$ の長さを越える部分の文字は無視する）

を表します。

なんだか数式はややこしいですが（そして書き方が合っているか不安ですが）、やっていることは簡単です。具体的に以下の文字列を例に説明します。

s1 = あさきゆめみしゑひもせす
s2 = あああさきゆ

まず $s_1$ と $s_2$ のジャロ類似性を求めます。0.666... と出ました。そこに、

$s_1$ の文字数と $s_2$ の文字数の一致度合い
$s_1$ の文字数と $s_2$ の文字種の一致度合い

の平均値を掛けます。

$s_1$ に対して $s_2$ の文字数が半分しかないため、文字数の一致度合いは 0.5 です。そして $s_1$ のうち、 $s_2$ の長さを越える部分の文字を無視した文字列（あさきゆめみ）に含まれる文字のうち、 $s_2$ にも含まれるものは3分の2の種類しかないため、文字種の一致度合いは 0.666... です。その 2 つの度合いの平均値の 0.58333... を、ジャロ類似性 0.666... に掛けた 0.3888... がジャロ・タイダログ類似性です。以上の方法で、極端に文字数が少ない場合や一致箇所が少ない場合、つまりは「あ」一文字や「あ」連打の類似性を下げることを考えました。

実際にジャロ類似性とジャロ・タイダログ類似性を比較すると、以下のようになりました。

「あさきゆめみしゑひもせす」との類似性

文字列	ジャロ類似性	ジャロ・タイダログ類似性
あさきゆめみしゑひもせす	1.000000	1.000000
あさゆきめみしゑひもせす	0.972222	0.972222
あさきゆめみしゑいもせす	0.944444	0.905093
あさき夢みしゑひもせす	0.914141	0.792948
あさきゆめみしあいうえお	0.722222	0.571759
あ	0.694444	0.376157
ああああああああああああ	0.388889	0.210648
しゑひもせす	0.000000	0.000000
子丑寅卯辰巳午未申酉戌亥	0.000000	0.000000

「ポラーノの広場」の一節との類似性

文字列	ジャロ類似性	ジャロ・タイダログ類似性
あのイーハトーヴォのすきとおった風、夏でも底に冷たさをもつ青いそら、うつくしい森で飾られたモリーオ市、郊外のぎらぎらひかる草の波。	1.000000	1.000000
あのイーハトーヴォのすきおとった風、夏でも底に冷たさをもつ青いそら、うつくしい森で飾られたモリーオ市、郊外のぎらぎらひかる草の波。	0.994872	0.994872
あのイーハトーヴォの透きとおった風、夏でも底に冷たさをもつ青いそら、うつくしい森で飾られたモリーオ市、郊外のぎらぎらひかる草の波。	0.989744	0.982130
あのイーハトーヴォのすきとおった風、夏でも底に冷たさをもつ青いそら、	0.960483	0.731444
あのイーハトーヴォのすきとおった風、夏でも底に冷たさをもつ青いそら、あああああああああああああああああああああああああああああああ	0.764103	0.646548
あのイーハトーヴォのすきとおったかぜ、なつでもそこにつめたさをもつあおいそら、うつくしいもりでかざられたもりーおし、こうがいのぎらぎらひかるくさのなみ。	0.732375	0.545130
あ	0.671795	0.341065
うつくしい森で飾られたモリーオ市、郊外のぎらぎらひかる草の波。	0.448523	0.179298
あああああああああああああああああああああああああああああああああああああああああああああああああああああああああああああああああ	0.343590	0.174438
The quick brown fox jumps over the lazy dog	0.000000	0.000000

「あ」一文字と「あ」連打の類似性がガッツリ下がってますね！　その一方で、誤りの少ない文字列の変動は比較的小さいことが見て取れます。強力すぎる「あ」に対する抑止力として、ジャロ・タイダログ類似性が有効だと言えるのではないでしょうか。「あ」にお困りの方、ぜひご活用ください。

結び

「へー簡単そうじゃんやってみよ」とか言いながらクリスマス頃に手を出したジャロ類似性でしたが、なかなか苦戦しました。年内に終わらないかと思った。

文字列間の一致部分を数えるんだから、String を |> Seq.toList して |> List.filter とか何とかしたらいいんじゃない？　とか考えて書き始めましたが、そもそも Seq.toList に渡せる時点で String は Seq なんだよなぁ。じゃあ String |> Seq.filter でいいじゃん、と今更気づいて Seq を多用しました。

Option 型をまともに使ったのも初めてな気がします。Option 型と Result 型をもっと触りたい。「成功か失敗のどちらかの値が入っている」とか完全にシュレディンガーのネコ。Result 型を用いた「鉄道指向プログラミング (Railway Oriented Programming: ROP)」に興味があったり、ライブラリを作ってみたかったりと、やりたいことがいくつかあるので、2023年はその辺りに挑戦したいと思います。

ジャロ類似性を自分で算出できることが分かったので、これを何かに転用してみようと思いました。何か思い付いたら書きます。