Criptografía (CCLVI): Cálculo del Índice de Coincidencia (IC) en Excel

Ya puse una entrada con un script en python para calcular el Índice de Coincidencia (IC), y ahora le toca el turno a la programación de esto mismo con Visual Basic para Aplicaciones en Excel.

Antes de poner el código y un ejemplo de su funcionamiento, recordar que en este post expliqué qué es y cómo se utiliza el IC para atacar cifrados de sustitución polialfabética con claves periódicas.

El IC es la probabilidad de que dos letras tomadas al azar de un texto sean iguales y, por tanto, para su cálculo utilizaremos la siguiente fórmula (número de casos favorables / número de casos posibles):

Donde:
fi: frecuencia o número de ocurrencias del carácter i-ésimo del alfabeto (de la "A" a la "Z") en el texto.
N: número de caracteres o tamaño del texto .

El código es el siguiente:

'ÍNDICE DE COINCIDENCIA (IC):
'' Cálculo del IC de un texto.
'' http://mikelgarcialarragan.blogspot.com/

Option Explicit
Public TEXTO As Range
Public IC As Range
Public Sub Calcular_IC()
    Dim Alfabeto As String
    Dim Caracter As Integer
    Dim FrecuenciasRelativas As New Collection, FrecuenciaRelativa As Variant
    Dim ParesCaracteresIguales As New Collection, ParCaracteresIguales As Variant
    Dim ParesCaracteresPosibles As Integer
    Dim IC As Double

    Alfabeto = "ABCDEFGHIJKLMNOPQRSTUVWXYZ"
    Range("TEXTO").Value = A_Z(UCase(Replace(Range("TEXTO").Value, "", "")))
    
    If Len(Range("TEXTO").Value) = 0 Then
        MsgBox "Introduzca el texto del que se desea calcular el IC. Sólo caracteres alfabéticos [A-Z], 'Ñ' excluida.", vbOKOnly + vbCritical, "¡Error!"
    Else
        For Caracter = 1 To Len(Alfabeto)
            If Len(Range("TEXTO").Value) - Len(Replace(Range("TEXTO").Value, Mid(Alfabeto, Caracter, 1), "")) <> 0 Then
                FrecuenciasRelativas.Add Len(Range("TEXTO").Value) - Len(Replace(Range("TEXTO").Value, Mid(Alfabeto, Caracter, 1), ""))
            Else
                FrecuenciasRelativas.Add 0
            End If
        Next
        For Each FrecuenciaRelativa In FrecuenciasRelativas
            ParesCaracteresIguales.Add FrecuenciaRelativa * (FrecuenciaRelativa - 1) / 2
        Next
        ParesCaracteresPosibles = Len(Range("TEXTO").Value) * (Len(Range("TEXTO").Value) - 1) / 2
        IC = 0
        For Each ParCaracteresIguales In ParesCaracteresIguales
            IC = IC + (ParCaracteresIguales / ParesCaracteresPosibles)
        Next
        Range("IC").Value = IC
    End If

End Sub
Function A_Z(Cadena As String) As String
    Dim Caracter As Integer

    For Caracter = 1 To Len(Cadena)
        Select Case Asc(Mid(Cadena, Caracter, 1))
            Case 65 To 90:
                A_Z = A_Z & Mid(Cadena, Caracter, 1)
        End Select
    Next

End Function

Ejemplo de funcionamiento:

Quizás también te interese: