sábado, 18 de febrero de 2012

Mostrar todas las permutaciones o combinaciones de letras usando Excel VBA

Aqui les paso un ejemplo que encontre hace poco, todos los meritos de este ejemplo son para YOSHIDA, Hajime, aqui solo les comparto el ejemplo que encontre y lo explicare.
En Japon, todos los estudiantes aprenden "Permutaciones y Combinaciones" en el primer grado de la escuela secundaria. Como primera leccion, los profesores muestran todos los patrones de permutacion y combinaciones. Probablemente 4!=24 patrones o 6C3=20 patrones. Despues de mostrar todos los patrones, para calcular el valor de permutaciones o combinaciones es el problema para estudiantes.
Lo que se hace para entender casos como estos aqui cito una parte de un libro "el frasco misterioso de Anno" :

Hay un frasco.
En el frasco, esta el mar.
En el mar, hay una isla.
En la isla, hay 2 paises.
En cada pais hay 3 colinas.
En cada colina, hay 4 castillos.

Este libro muestra desde 1! a 8!=40320 puntos en las paginas. Pero, si queremos mostrar 10! = 3628800, necesitaremos mas de 180 paginas. Esto parece real para los estudiantes.
Aun para los profesores, es duro y doloroso mostrar todos los patrones de 5! o mas a mano. Pero las computadores si pueden hacerlo. Algun programa tiene la funcion de mostrar permutaciones. Desafortunadamente, estos programas no son tan populares en las escuelas. Excel es mas conocido para profesores y estudiantes. Y es una herramienta muy poderosa para la educacion en matematicas. Ademas, Excel VBA (Visual Basic para Aplicaciones) es un lenguaje de programacion poderoso.
JK para Excel es una hoja de trabajo con un programa VBA para mostrar todos los valores al aplicar permutaciones o combinaciones. JK simboliza Junretsu(permutacion) y Kumiawase(combinacion) en japones.
CASO 1
SMILE tiene 5 letras, y todas diferentes. Escribe SMILE y clickea en GO.
Todos los patrones de la permutacion lo veran a continuacion:
Ya que JK es una hoja de Excel, los patrones de salida pueden ser escritos a un archivo de texto.
CASO 2
FOOTBALL tiene 8 letras. 2 O y 2 L son identicas. El numero de permutaciones de "FOOTBALL" es 8!/(2!*2!)=10080. El programa realizado muestra a todos.
Dado que el maximo de filas es 65536 en Excel, JK puede mostrar los siguientes patrones.

8!=40320
9P6=60480
18C9=48620

CASO 3
JK puede mostrar ambos casos, ya sea permutaciones o combinaciones. Mire los siguientes ejemplos.
"CAKE" tiene 4 letras. Y todas son diferentes. Vamos a tomar 2 letras a la vez.
Numero de permutaciones=4P2=12
Numero de combinaciones=4C2=6

El algoritmo principal de JK es una llamada recurrente. No es un algoritmo inusual. Cuando dibujamos un diagrama del arbol, usamos este algoritmo.
Ahora como ya vieron como funciona la macro, les voy a explicar el codigo que tiene.
Al abrir el archivo veran 2 botones (Input Form y Reset)
el codigo que se ejecuta al pulsar el boton Input Form es este:
'// Input Form
  Sheet1.Columns(1).ClearContents
  Label1.Caption = ""
  UserForm1.Show
este codigo lo que hace es limpiar la columna A o 1 de la Hoja1, limpiar el Label1 (es ese rectangulo morado que muestra los resultados) y mostrar el formulario UserForm1.
El formulario que abre es este.
y el codigo que se ejecuta al presionar en el boton Go es este:
'// GO
  Dim OutputStr As String
  Dim SortedStr As String
  Dim startDtm As Date, endDtm As Date 'Process time
  Dim i As Integer
  Dim Msg As String
  Dim TempStr As String
      
  Clr_text
  cnt = 0
  nest = 0
  OverFlowBol = False
  OutputStr = ""
  InputStr = TextBox1.Text
  startDtm = Now()
  Label3.Caption = "Counting ..."
  Label4.Caption = ""
  DupChrChk InputStr, SortedStr

  If JKsw = True Then
     Perm OutputStr, InputStr, r 'Permutations
  Else
     Comb OutputStr, SortedStr, r 'Combinations
  End If
  
  endDtm = Now()
  For i = 1 To 20: Beep: Next i
  
  If OverFlowBol = False Then
    TempStr = cnt & " way"
    If cnt > 1 Then
       TempStr = TempStr & "s."
    Else
       TempStr = TempStr & "."
    End If
    Label3.Caption = TempStr
  Else
    Label3.Caption = "Stop at " & cnt & " "
    Msg = "Process Limit !"
    MsgBox Msg, vbCritical
  End If
  
  Label4.Caption = "Time:" & DateDiff("s", startDtm, endDtm) & " sec."
  Wrt_text
  TextBox1.SetFocus
lo que se hace aqui es inicializar variables con Dim y despues llamar a la macro Clr_Text que contiene este codigo
'// Reset data
  UserForm1.Label3.Caption = ""
  UserForm1.Label4.Caption = ""
  Sheet1.Activate
  Sheet1.Label1.Caption = ""
  Sheet1.Columns(1).ClearContents
  Sheet5.Activate
  Sheet5.Range("B2", "D21").ClearContents
  Sheet5.Range("F7", "H12").ClearContents
  Sheet5.Label1.Caption = ""
  Sheet1.Activate
como se puede ver lo que hace es limpiar ciertos controles, ahora siguiendo con el evento Go de arriba, se almacena la palabra ingresada en InputStr mientras que OutputStr se inicializa como una variable sin caracteres, y se evalua si JKsw es verdadero, esta variable esta inicializada mas arriba por lo que se puede llamar en cualquier funcion, y dado que se inicializo As Boolean por defecto sera verdadera, entonces llamara a la macro Perm la cual se le ingresaran 3 valores y el codigo que ejecutara esta macro sera el siguiente:
Sub Perm(OutNowStr As String, InNowStr As String, sel As Integer)
'// Permutations
  
  Dim k As Integer
  Dim i As Integer
  Dim OutNextStr As String  '
  Dim InNextStr As String   '
  Dim ChkStr As String      '
  Dim chr1Str As String     '
  Dim hit As Integer        '
  
  nest = nest + 1
  If OverFlowBol = True Then
    nest = nest - 1
    Exit Sub
  End If
  
  If sel = 0 Then
    OutProc OutNowStr
  
  Else
    k = Len(InNowStr)
    ChkStr = ""
    
    For i = 1 To k
      chr1Str = Mid(InNowStr, i, 1)
      hit = InStr(ChkStr, chr1Str)
            
      If hit = 0 Then
        ChkStr = ChkStr & chr1Str
'    -------------------------------------------------------------------
        OutNextStr = OutNowStr & chr1Str
        InNextStr = Mid(InNowStr, 1, i - 1) & Mid(InNowStr, i + 1, k - i)
        Perm OutNextStr, InNextStr, sel - 1
'    -------------------------------------------------------------------
      End If
    Next i
  End If
  nest = nest - 1
End Sub
como se ve aqui este codigo realiza las permutaciones, ahora esto sera en caso de que JKsw sea verdadero que como lo dije sera en su defecto, pero que pasa si es falso vemos que llama a otra macro: Comb. Para ver como cambia el valor de la variable vemos en el formulario 2 radiobutton, estos cambian el valor de la variable JKsw ya que si vemos el codigo:
Private Sub OptionButton1_Click()
'// "Permutations"
  JKsw = True
  JKstr = "Permutations"
End Sub
ahora volvemos a la opcion de que JKsw sea falso, llamara a la macro Sub que ejecutara el siguiente codigo:
Sub Comb(OutNowStr As String, InNowStr As String, sel As Integer)
'// Combinations
  
  Dim k As Integer
  Dim i As Integer
  Dim OutNextStr As String  '
  Dim InNextStr As String   '
  Dim ChkStr As String      '
  Dim chr1Str As String     '
  Dim hit As Integer        '
  
  nest = nest + 1
  If OverFlowBol = True Then
    nest = nest - 1
    Exit Sub
  End If
  
  If sel = 0 Then
    OutProc OutNowStr
  
  Else
    k = Len(InNowStr)
    ChkStr = ""
    
    For i = 1 To (k - sel + 1)         ' <-- Caution!
      chr1Str = Mid(InNowStr, i, 1)
      hit = InStr(ChkStr, chr1Str)
            
      If hit = 0 Then
        ChkStr = ChkStr & chr1Str
'    -------------------------------------------------------------------
        OutNextStr = OutNowStr & chr1Str
        InNextStr = Mid(InNowStr, i + 1, k - i)
        Comb OutNextStr, InNextStr, sel - 1
'    -------------------------------------------------------------------
      End If
    Next i
  End If
  nest = nest - 1
End Sub
ahora como vemos en StartDtm y EndDtm se almacenaron los valores al empezar y terminar el codigo, ahora seguimos en el evento click del boton Go, aqui se evalua si OverFlowBol = False y dado que se inicializo asi muestra el numero de celdas que contienen las permutaciones o combinaciones respectivas asi como los ejemplos anteriores que al poner SMILE salia 120 ways (vean la figura de arriba) y despues mostrara el tiempo que demoro en procesar las permutaciones en el Label4, como vimos antes en 120 permutaciones mostro 0 segundos pero en 10080 permutaciones le tomo 6 segundos, este tiempo lo calcula de restar EndDtm y StartDtm. Ahora si pulsamos Reset se ejecutara este boton
Private Sub CommandButton2_Click()
'// Reset Data
  TextBox1.Text = ""
  TextBox2.Text = ""
  Clr_text
  TextBox1.SetFocus
End Sub
aqui lo que hace es limpiar los textbox, llamar al procedimiento Clr_text y poner el cursor en el textbox1. El boton Close tiene el siguiente codigo
Private Sub CommandButton3_Click()
'// Close Form
  End
End Sub
En el codigo para elegir el numero de combinaciones o permutaciones se utiliza un spinbutton que tiene el siguiente codigo:
Private Sub SpinButton1_Change()
'// Change the value of "r" by spin button
  TextBox2.Text = SpinButton1.Value
End Sub
y vemos que en el evento textchange del textbox2 se llama al spinbutton
Private Sub TextBox2_Change()
'// Chose r
  Dim msgStr As String
  
  r = Val(TextBox2.Text)
  n = Len(TextBox1.Text)
  
  If TextBox2.Text <> "" Then
    If (Not IsNumeric(TextBox2.Text)) Or _
       r < 0 Or r > n Then
      msgStr = "Choose 0 <= r <= " & n
      MsgBox msgStr, vbExclamation
      r = n
      TextBox2.Text = n
    End If
  End If
  
  SpinButton1.Max = n
  SpinButton1.Value = r
End Sub
Ahora al elegir los radiobuttons se llamara a los procedimientos Perm o Comb
Private Sub OptionButton1_Click()
'// "Permutations"
  JKsw = True
  JKstr = "Permutations"
End Sub

Private Sub OptionButton2_Click()
'// "Combinations"
  JKsw = False
  JKstr = "Combinations"
End Sub
y este es el codigo con el que se inicializa el formulario
Private Sub UserForm_Initialize()
'// Initialize
  OptionButton1.Value = True
  OptionButton1_Click   'Set "Permutation"
  CalSheetBol = True    'Write to CalcSheet
  n = 0
  r = 0
  UserForm1.SpinButton1.Max = 0
  UserForm1.SpinButton1.Value = 0
  Load UserForm1
End Sub
no tengo mucho tiempo para explicar el resto de codigo, asi que aqui les dejo el ejemplito para que se guien y espero les haya servido esta pequeña explicacion que hice.

0 comentarios:

Publicar un comentario