﻿Option Explicit

' 原文上の1始まり文字位置。LCSの変更区間を、限定した短い共通部で結合する。
Public Function RC_Diff(ByVal news As String, ByVal olds As String) As Object
    Dim result As Object, newSpans As Collection, oldSpans As Collection
    Dim nc As Long, oc As Long, dp() As Long, i As Long, j As Long
    Dim nb() As Boolean, ob() As Boolean, ns As Long, os As Long
    Set result = RC_Dict(): Set newSpans = New Collection: Set oldSpans = New Collection
    result.Add "new", newSpans: result.Add "old", oldSpans
    result.Add "fallback", False
    nc = Len(news): oc = Len(olds)
    If news = olds Then Set RC_Diff = result: Exit Function
    ReDim nb(0 To nc + 1): ReDim ob(0 To oc + 1)
    ' 大きな入力は共通先頭/末尾を保った単一区間。原文を削らない。
    If CDbl(nc + 1) * (oc + 1) > RC_MAX_DIFF_CELLS Then
        result("fallback") = True
        i = 1
        Do While i <= nc And i <= oc
            If Mid$(news, i, 1) <> Mid$(olds, i, 1) Then Exit Do
            i = i + 1
        Loop
        ns = nc: os = oc
        Do While ns >= i And os >= i
            If Mid$(news, ns, 1) <> Mid$(olds, os, 1) Then Exit Do
            ns = ns - 1: os = os - 1
        Loop
        If ns >= i Then RC_AddSpan newSpans, i, ns - i + 1
        If os >= i Then RC_AddSpan oldSpans, i, os - i + 1
        Set RC_Diff = result: Exit Function
    End If
    ReDim dp(0 To nc + 1, 0 To oc + 1)
    For i = nc To 1 Step -1
        For j = oc To 1 Step -1
            If Mid$(news, i, 1) = Mid$(olds, j, 1) Then
                dp(i, j) = dp(i + 1, j + 1) + 1
            ElseIf dp(i + 1, j) >= dp(i, j + 1) Then
                dp(i, j) = dp(i + 1, j)
            Else
                dp(i, j) = dp(i, j + 1)
            End If
        Next j
    Next i
    i = 1: j = 1
    Do While i <= nc Or j <= oc
        If i > nc Then
            ob(j) = True: j = j + 1
        ElseIf j > oc Then
            nb(i) = True: i = i + 1
        ElseIf Mid$(news, i, 1) = Mid$(olds, j, 1) Then
            i = i + 1: j = j + 1
        ElseIf dp(i + 1, j) >= dp(i, j + 1) Then
            nb(i) = True: i = i + 1
        Else
            ob(j) = True: j = j + 1
        End If
    Loop
    ' 対応する共通部の両端にどちらか側の差分がある場合だけ連結。
    i = 1: j = 1
    Do While i <= nc And j <= oc
        If nb(i) Then
            i = i + 1
        ElseIf ob(j) Then
            j = j + 1
        Else
            ns = i: os = j
            Do While i <= nc And j <= oc
                If nb(i) Or ob(j) Then Exit Do
                i = i + 1: j = j + 1
            Loop
            If i - ns <= RC_MERGE_COMMON And ns + os > 2 And (i <= nc Or j <= oc) Then
                If (nb(ns - 1) Or ob(os - 1)) And (nb(i) Or ob(j)) Then
                    If RC_CanMerge(Mid$(news, ns, i - ns)) Then
                        If RC_ChangeWindow(nb, nc, ns, i) <= RC_MERGE_WINDOW And RC_ChangeWindow(ob, oc, os, j) <= RC_MERGE_WINDOW Then
                            For ns = ns To i - 1: nb(ns) = True: Next ns
                            For os = os To j - 1: ob(os) = True: Next os
                        End If
                    End If
                End If
            End If
        End If
    Loop
    RC_MasksToSpans nb, nc, newSpans
    RC_MasksToSpans ob, oc, oldSpans
    Set RC_Diff = result
End Function

Private Function RC_CanMerge(ByVal text As String) As Boolean
    Dim i As Long, ch As String
    RC_CanMerge = True
    For i = 1 To Len(text)
        ch = Mid$(text, i, 1)
        If InStr("。、，．,.！？!?;；:：()（）" & vbCr & vbTab & " 　0123456789０１２３４５６７８９", ch) > 0 Then RC_CanMerge = False: Exit Function
    Next i
End Function

Private Function RC_ChangeWindow(ByRef mask() As Boolean, ByVal length As Long, ByVal first As Long, ByVal after As Long) As Long
    Dim lo As Long, hi As Long
    lo = first: hi = after
    Do While lo > 1
        If Not mask(lo - 1) Then Exit Do
        lo = lo - 1
    Loop
    Do While hi <= length
        If Not mask(hi) Then Exit Do
        hi = hi + 1
    Loop
    RC_ChangeWindow = hi - lo
End Function

Private Sub RC_MasksToSpans(ByRef mask() As Boolean, ByVal length As Long, ByVal spans As Collection)
    Dim i As Long, first As Long
    For i = 1 To length + 1
        If mask(i) Then
            If first = 0 Then first = i
        ElseIf first > 0 Then
            RC_AddSpan spans, first, i - first: first = 0
        End If
    Next i
End Sub

Public Sub RC_AddSpan(ByVal spans As Collection, ByVal first As Long, ByVal length As Long)
    Dim span As Object
    If length <= 0 Then Exit Sub
    Set span = RC_Dict(): span.Add "start", first: span.Add "length", length
    spans.Add span
End Sub
