Criptografía (CCLVII): Cálculo de la Entropía (H) en Excel

Ya puse una entrada con un script en python para calcular la Entropía (H) de un texto, y en ésta pongo el código Visual Basic para aplicaciones (VBA) para automatizar en Excel esa misma tarea.

Antes de poner el código y un ejemplo de su funcionamiento, recordar qué es y cómo se calcula.

la Entropía (H) mide la incertidumbre de una fuente de información y puede ser considerada como la cantidad de información promedio que contienen los símbolos usados.

Donde:

H: Entropía.

M: mensaje o texto.

mi: carácter i-ésimo del mensaje o texto.

p(mi): probabilidad de aparición del carácter i-ésimo en el mensaje o texto.

n: número de caracteres o tamaño del mensaje o texto.

El código es el siguiente:

' ENTROPÍA (H):
'
' Cálculo de la Entropía (H) de un texto.
'
' http://mikelgarcialarragan.blogspot.com/

Option Explicit
Public TEXTO As Range
Public H As Range
Public Sub Calcular_H()
    Dim Alfabeto As String
    Dim Caracter As Integer
    Dim FrecuenciasRelativas As New Collection, FrecuenciaRelativa As Variant
    Dim H 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 la Entropía (H). 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
        H = 0
        For Each FrecuenciaRelativa In FrecuenciasRelativas
            If FrecuenciaRelativa <> 0 Then
                H = H + FrecuenciaRelativa / Len(Range("TEXTO").Value) * Log(Len(Range("TEXTO").Value) / FrecuenciaRelativa) / Log(2)
            End If
        Next
        Range("H").Value = H
    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: