martes, 17 de julio de 2018

Bucles For anidados

Puede descargar el archivo BuclesForAnidados.xlsm

Vamos a trabajar con dos bucles For...Next anidados. Realizaremos unos ejercicios con macros Excel programando en VBA.

Llegaremos a realizar la siguiente figura con números que van entre 1 y 9, tanto en horizontal como en vertical.


Pero antes de llegar a obtener esa imagen que hemos denominado 'Bandera Color' vamos a ir paso a paso.



Borra

Como vamos a trabajar en varios casos, antes de comenzar  nos interesa borrar el contenido del rango A1.I9. También vamos a borrar el color de fondo de las celdas.


Sub Borra()
Dim R As Range
Set R = Range("A1:I9")
R.ClearContents
R.Interior.Pattern = xlNone
End Sub


Completo

Anidamos dos bucles For para conseguir imprimir en cada una de las celdas del cuadrado de 9 filas y 9 columnas, los números i j.



Sub Completo()
Dim i As Byte, j As Byte
Call Borra
For i = 1 To 9
  For j = 1 To 9
    Cells(i, j) = Str(i) & " " & Str(j)
  Next j
Next i
End Sub


Caja

Ahora queremos que no se imprima el cuadrado completo, únicamente deseamos imprimir los bordes. Para ello precisamos incluir dentro de los bucles anidados un condicional if que imprima únicamente los índices i j cuando se cumpla que el primero es igual a 1 o 9, o bien el segundo sea igual a 1 o 9. De esta forma conseguimos imprimir solo el perímetro del cuadrado.



Sub Caja()
Dim i As Byte, j As Byte
Call Borra
For i = 1 To 9
  For j = 1 To 9
    If i = 1 Or i = 9 Or j = 1 Or j = 9 Then
      Cells(i, j) = Str(i) & " " & Str(j)
    End If
  Next j
Next i
End Sub


Diagonal 1

Queremos imprimir únicamente la diagonal primera que se consigue haciendo que el condicional if filtre únicamente aquellos valores donde los índices i j coincidan.




Sub Diagonal_1()
Dim i As Byte, j As Byte
Call Borra
For i = 1 To 9
  For j = 1 To 9
    If i = j Then
      Cells(i, j) = Str(i) & " " & Str(j)
    End If
  Next j
Next i
End Sub


Diagonal 2

La segunda diagonal se consigue buscando qué tienen en común los índices i j. Observamos que esta diagonal cumple que al sumar ambos índices la suma siempre es igual a 10. Esta será la condición que impondremos en el condicional if.



Sub Diagonal_2()
Dim i As Byte, j As Byte
Call Borra
For i = 1 To 9
  For j = 1 To 9
    If i + j = 10 Then
      Cells(i, j) = Str(i) & " " & Str(j)
    End If
  Next j
Next i
End Sub


Bandera


Deseamos imprimir únicamente los bordes y las dos diagonales. A esta figura la hemos llamado bandera. Observe que se consigue incluyendo en el if seis condiciones concatenadas con el operador lógico Or.



Sub Bandera()
Dim i As Byte, j As Byte
Call Borra
For i = 1 To 9
  For j = 1 To 9
    If i = 1 Or i = 9 Or j = 1 Or j = 9 Or i = j Or i + j = 10 Then
      Cells(i, j) = Str(i) & " " & Str(j)
    End If
  Next j
Next i
End Sub


Bandera Color

Nos gustaría que la bandera tuviera colores. Los colores de fondo de cada celda se consiguen con Interior.ColorIndex=número. Donde el número nos da el color.





Sub BanderaColor()
Dim i As Byte, j As Byte
Call Borra
For i = 1 To 9
  For j = 1 To 9
    If i = j Or i + j = 10 Then
      Cells(i, j) = Str(i) & " " & Str(j)
      Cells(i, j).Interior.ColorIndex = 3 'rojo
    ElseIf i = 1 Or i = 9 Or j = 1 Or j = 9 Then
      Cells(i, j) = Str(i) & " " & Str(j)
      Cells(i, j).Interior.ColorIndex = 6 'amarillo
    Else
      Cells(i, j).Interior.ColorIndex = 8 'azul
    End If
  Next j
Next i
End Sub

Ya tenemos bandera.

lunes, 4 de junio de 2018

Triángulo de Floyd

Puede descargar el archivo trianguloFloyd.xlsm

El triángulo de Floyd para cuatro filas es el siguiente.


Se construye con los números naturales en forma de triángulo rectángulo. Se suele utilizar como ejercicio para los que están aprendiendo a programar en un cierto lenguaje.

El triángulo de Floyd se resuelve con un algoritmo que ideó el Dr. Floyd, científico e informático que fue compañero de habitación de Carl Sagan cuando ambos estudiaban en la universidad.

Hoja 1

Resuelto usando fórmulas de Excel y sin usar macros.



La fórmula de la celda C5 calcula el máximo de la fila anterior para saber con qué número se ha de comenzar la fila actual.

=MAX(C4:P4)+1

La celda D5 suma 1 al valor previo y usa un condicional SI para saber hasta que valor se ha de continuar sumando 1.

=SI(CONTAR($C5:C5)<$A5;C5+1;"")

Hoja 2

También resuelve el triángulo con fórmulas y sin usar macros.

En este caso las celdas de la primera columna se obtienen con una fórmula que indica que nos da el último valor de la fila precedente y le suma 1. Se cumple que los últimos valores de cada fila son los llamados números triangulares, que se obtienen como n*(n+1)/2. Siendo n el número de fila.


En nuestro caso la celda C5 tiene la siguiente expresión.

=(A5*(A5-1)/2)+1

La celda D5 se calcula con la siguiente fórmula, que es igual a la empleada en la Hoja1.

=SI(CONTAR($C5:C5)<$A5;C5+1;"")

Hoja3

Se construye el triángulo de Floyd mediante macro.


Sub Floyd1()
Dim n As Long, i As Long, j As Long, n_max As Long
Dim R As Range
Worksheets("Hoja3").Activate
Set R = Range("B3")
n_max = 24: j = 1
R.Offset(1, -1).Resize(n_max+2, n_max+2).ClearContents
For n = 1 To n_max
  R.Offset(n, -1) = n 'imprimimos la columna A
  For i = 1 To n 'i recorre los elementos de cada fila
    R.Offset(n, i) = j 'imprimimos el valor de j en la celda que toca
    j = j + 1  'j proporciona los números naturales correlativos
  Next i
Next n
End Sub


Hoja4

Dada una fila n, podemos calcular el último valor de su fila usando los números triangulares que son los siguientes.


  1. Para n=1 el número triangular es 1
  2. Para n=2 el número triangular es 3
  3. Para n=3 el número triangular es 6
  4. Para n=4 el número triangular es 10
  5. Para n=5 el número triangular es 15

A esos valores e le suma 1 para saber cuál es el primer valor de la fila siguiente.

Sub Floyd2()
Dim n As Long, i As Long, j As Long, n_max As Long
Dim R As Range
Worksheets("Hoja4").Activate
Set R = Range("B3")
n_max = 24
R.Offset(1, -1).Resize(n_max+2, n_max+2).ClearContents
For n = 1 To n_max
  R.Offset(n, -1) = n
  'primera columan del triángulo
  R.Offset(n, 1) = (n * (n - 1) / 2) + 1
  For i = 2 To n
    R.Offset(n, i) = R.Offset(n, i - 1) + 1
  Next i
Next n
End Sub

Hoja5


Una pequeña variante para poder elegir el número de filas desde un control numérico que se encuentra en la propia hoja de cálculo.


También está disponible en un lenguaje de programación que está muy de moda.

domingo, 3 de junio de 2018

Seleccionar tabla sin cabecera

Puede descargar el archivo seleccionaTabla.xlsm

Primero generamos una tabla con valores aleatorios y con un número de filas que podemos elegir, con un control numérico, entre 1 y 20.


La macro que genera la tabla con valores aleatorios es la siguiente.

Observe que se define la celda B4 como la esquina superior izquierda y en base a ella se genera toda la tabla. Esta esquina sería fácil de variar en el código de la macro, gracias al uso de Offset.

Sub generaTabla()
Dim n As Byte, i As Byte
Dim R As Range
Set R = Range("B4")
n = [I2]
Range("B5:F24").ClearContents
For i = 1 To n
  R.Offset(i, 0) = i
  R.Offset(i, 1).Value = WorksheetFunction.Choose(Int(Rnd() * 3) + 1, "Norte", "Sur", "Centro")
  R.Offset(i, 2).Value = Date - i + 1
  R.Offset(i, 3).Value = WorksheetFunction.Choose(Int(Rnd() * 3) + 1, "Libros", "Comic", "Web")
  R.Offset(i, 4).Value = (Int(Rnd() * 100000) + 20000) / 100
Next i
End Sub


El código VBA que selecciona la tabla sin incluir la cabecera es la siguiente.

Sub seleccionaTablaSinCabecera()
Worksheets("Hoja1").Activate
'el cursor inicialmente tiene que estar dentro de la tabla
Range("B5").Select
Set R = ActiveCell.CurrentRegion
R.Offset(1, 0).Resize(R.Rows.Count - 1, R.Columns.Count).Select
End Sub

Aquí vemos otro uso estupendo de Offset combinado con Resize, propiedad de los rangos que hemos visto recientemente. Puede verlo en el post siguiente.

viernes, 1 de junio de 2018

Árbol binomial generado con una macro

Puede descargar el archivo arbolBinomial.xlsm

Vamos a crear un árbol binomial usando una macro de Excel, con un poco de código VBA. Lo interesante del caso es que al variar el número de periodos n el árbol se recalcula y se redimensiona en tamaño.

Partimos de un precio de una acción de S=100 €. Este precio puede subir o bajar en cada periodo. Suponemos que si sube lo hará con incrementos del 25% (u=1,25) y si baja lo hace con disminución del 20% (d=0,80).

Se cumple que d=1/u

1 / 1,25 = 0,80

n=1


El árbol para un periodo sería el siguiente.


Donde
125 = 100 * 1,25
80 = 100 * 0,80

Partiendo del precio inicial de 100, transcurrido un periodo pueden suceder dos cosas, o bien, el precio se incrementa y 25% pasando a ser 125 €, o bien se reduce un 20% pasando a ser 80 €.

n=2

Si hacemos el árbol para dos periodos.


Donde
156,25 = 125 * 1,25
100 = 125 * 0,80  o bien  100 = 80 * 1,25
64 = 80 * 0,80

Para el periodo 2, el valor mayor  (156,25) se obtiene incrementando un 25% más el precio superior del periodo anterior. También se puede ver como que 156.25 = 100 * 1,25 * 1,25, ya que se parte de un precio inicial de 100 y se experimentan dos incrementos del 25%.

El valor de 100 € del periodo 2 se alcanza por uno de los dos siguientes caminos.
  • 100 = 100*1,25*0,80 Partimos de 100, subimos a 125 y luego volvemos a bajar a 100.
  • 100 = 100 *0.80*1,25. Partimos de 100, bajamos a 80 y luego volvemos a subir a 100.
El valor de 64 se puede entender que se alcanza partiendo del precio inicial de 100 y experimentando dos reducciones consecutivas del 20%. 64 = 100 * 0,80 * 0,80

n=3

Si hacemos el árbol para tres periodos.


Donde
195,3125 = 100 * 1,253
125 = 100 * 1,252 * 0,80
80 =  100 * 1,25 * 0,802
51,2 = 100 * 0,803

Para n>3

La macro funciona hasta n=40, y no por la limitación de la propia macro sino porque hemos limitado hasta 40 el valor que se puede poner en la celda amarilla (C7) usando el control numérico que está a su lado.



Option Explicit
Public n As Integer 'número de etapas del arbor, hasta 40
Public A() As Double 'matriz que contiene el arbol

Sub arbol()
Dim i As Integer, j As Integer
Dim u As Double, d As Double
Worksheets("Hoja1").Activate
n = [C7]: u = [C4]: d = [C5]
Call borra
Call cabeceras
ReDim A(2 * n, n) 'el arbol tiene el doble de filas que de columnas
A(n, 0) = 100 'valor inicial en la columna cero
For j = 1 To n  'columnas de la matriz
  For i = 0 To 2 * n 'filas
    If j = n - i Then 'primero calculamos la diagonal superiro
      A(n - j, j) = A(n - j + 1, j - 1) * u
    ElseIf j >= n - i + 2 And j <= i + n Then 'calculamos el resto
      A(i, j) = A(i - 1, j - 1) * d
    End If
  Next i
Next j
Call imprimeA
End Sub
Sub borra()
Range("C10:AR91").Clear ' borra hasta n=40
End Sub
Sub cabeceras()
Dim i As Integer
Range("A1").Copy ' copiamos A1 para luego pegar el formato
'pegamos el formato de A1 a la columna C
Range(Cells(10, "C"), Cells(2 * n + 11, "C")).PasteSpecial Paste:=xlPasteFormats
'pegamos el formato de A1 a la fila 10
Range(Cells(10, 4), Cells(10, n + 4)).PasteSpecial Paste:=xlPasteFormats
Application.CutCopyMode = False 'elimina la fila de hormigas
For i = 0 To n
  'generamos los números 0 a 2n de la columna C
  Cells(i + 11, 3) = i 'vertical, los n primeros
  Cells(i + n + 11, 3) = i + n 'vertical, los n últimos
  'generamos los números 0 a n de la fila 10
  Cells(10, i + 4) = i 'horizontal
Next i
Range("C10").Activate 'situamos el cursor en C10
End Sub
Sub imprimeA()
Dim i As Integer, j As Integer
For j = 0 To n
  For i = 0 To 2 * n 'recorremos toda la matriz A
    If A(i, j) <> 0 Then 'imprimimos solo los no vacios
      Cells(i + 11, j + 4) = A(i, j)
    End If
  Next i
Next j
End Sub

La idea básica para hacer el árbol es que la diagonal superior se obtiene como el precio anterior por u. Y el resto de los valores del árbol se obtienen como el precio superior del periodo anterior por d.

Ejemplo para n=4.


244,1 se obtiene como 195,3 * 1,25
El resto de valores se obtienen multiplicando por 0,80, así tenemos los siguientes.
156,3 = 195,6 * 0,80
100 = 125 * 0,80
64 = 80 * 0,80
40,96 = 51,2  * 0,80

Este es método que usa la macro para obtener todos los valores del árbol binomial.

Lo que más esfuerzo ha costado es calcular bien las celdas donde se han de escribir los valores del árbol ya que al crecer n el árbol va aumentando de tamaño y es necesario ir bajando la celda inicial.

jueves, 31 de mayo de 2018

Manejar matrices con VBA

Puede descargar el archivo manejarMatrices.xlsm

Vamos a trabajar con matrices en Excel programando en VBA (Visual Basic for Applications).


Lo interesante de este caso es ver que para dejar el contenido de una matriz en la hoja de cálculo lo que debemos hacer es lo que nos dice la intuición.

Rango = Matriz 'respetando las dimensiones


Option Base 1 'Las matrices empiecen en 1 y no en 0

Sub manejaMatriz()
Dim A As Variant
Dim B As Variant
'para asignar un rango a una matriz
A = Range("B4:E9")
'para asignar una matriz a un rango
B = WorksheetFunction.Transpose(A)
'para imprimir una matriz en un rango
Range("B11:G14") = B
End Sub

Sub aleatorios()
Dim A(6, 4) As Double
Dim inicio As Range
Dim final As Range
Randomize 'para mejorar la aleatoriedad
For i = 1 To 6
  For j = 1 To 4
    'números aleatorios [0,1) a dos decimales
    A(i, j) = Int(Rnd() * 100) / 100
  Next j
Next i
Set inicio = Cells(4, "B")
Set final = Cells(9, "E")
Range(inicio, final) = A
End Sub

Sub multiplicaMatriz()
Dim A() As Variant
Dim B() As Variant
Dim C() As Variant
A = Range("B4:E9")
B = Range("B11:G14")
C = WorksheetFunction.MMult(A, B)
Range("B16:G21") = C
End Sub

Sub invierteMatriz()
Dim A() As Variant
A = Range("B23:D25")
Range("B27:D29") = WorksheetFunction.MInverse(A)
Range("B27:D29").Interior.Color = 6750156
Call extraeElementos
End Sub

Sub extraeElementos()
Dim A() As Variant
Dim origen As Range
Range("M4:AC30").Clear
Range("M4:AC30").Interior.Color = 13434879 'amarillo
Set origen = Range("L3")
A = Range("B27:D29")
fila = [L14]
columna = [S2]
For i = 1 To 3 'recorremos las 3 filas de la matriz
  For j = 1 To 3 'recorremos las 3 columnas de A
    With origen.Offset(fila + i - 1, columna + j - 1)
    .Value = A(i, j)
    .Borders(xlEdgeLeft).LineStyle = xlContinuous
    .Borders(xlEdgeRight).LineStyle = xlContinuous
    .Borders(xlEdgeTop).LineStyle = xlContinuous
    .Borders(xlEdgeBottom).LineStyle = xlContinuous
    End With
  Next j
Next i
Range(origen.Offset(fila + i - 4, columna + j - 4), origen.Offset(fila + i - 2, columna + j - 2)).Interior.Color = 6750156
End Sub

Sub copia()
Dim A As Variant
A = Range("B4:D6")
Range("B23:D25") = A
Range("B4:D6,B23:D25").Interior.ColorIndex = 8
End Sub

Sub Borra()
Range("B4:AD32").ClearContents
[S2] = 1: [L14] = 1
Range("B4:G29").Interior.Pattern = xlNone
Range("M4:AC30").Clear
Range("M4:AC30").Interior.Color = 13434879 'amarillo
End Sub

También es interesante ver el pos siguiente.

Propiedad Resize para manejar rangos en Excel

Puede descargar el archivo resize.xlsm

Cuando programamos macros en Excel usando VBA es muy habitual trabajar con rangos. Una propiedad de los rangos que modifica su tamaño es resize.

Rango.Resize(filas, columnas).Select

Veamos algunos ejemplos de su uso.



Resize1

Da color aleatorio a las celdas del rango B4:E8.

Sub Resize1()
Dim rojo As Byte, verde As Byte, azul As Byte
Dim R As Range
Set R = Range("B4")
Range("A1").Select
Randomize 'elegimos colores aleatorios
rojo = Int(Rnd() * 100) + 100
verde = Int(Rnd() * 100) + 100
azul = Int(Rnd() * 100) + 100
R.Resize(5, 4).Interior.Color = RGB(rojo, verde, azul)
End Sub

Observe que después de Resize(5.4) se ha de poner algo, o bien, .Select para seleccionar, o bien, .Interior.Color=RGB(rojo, verde, azul) como en este caso. Pero si después de Resize se deja sin poner nada nos dará error.

Resize2

Permite seleccionar un rango de 3 filas y 2 columnas usando como celda de origen la B4.

Range("B4").Resize(3, 2).Select



Sub Resize2()
'Seleccionamos un rango de 3 filas y 2 columnas
'La celda de origen es B4
Range("B4").Resize(3, 2).Select
End Sub

Resize3

Permite seleccionar un rango de 3 filas en la primera columna usando como celda de origen la B4.

Range("B4").Resize(3).Select



Sub Resize3()
'Seleccionamos un rango de 3 filas de la primera columna
'La celda de origen es B4
Range("B4").Resize(3).Select
End Sub

Resize4

Permite seleccionar un rango de 3 columnas en la primera fila usando como celda de origen la B4.

Range("B4").Resize(, 3).Select




Sub Resize4()
'Seleccionaremos un rango de 3 columnas de la primera fila
'La celda de origen es B4
Range("B4").Resize(, 3).Select
End Sub

Resize5

Permite seleccionar un rango de 2 columnas en la primera fila usando como celda de origen la B4 y hasta la fila 8, ya que el rango indicado es hasta la E8.

Range("B4:E8").Resize(, 2).Select



Sub Resize5()
Range("B4:E8").Resize(, 2).Select
End Sub

Resize6

Permite seleccionar un rango de 3 columnas en la primera fila usando como celda de origen la A4.

Range("B4").Offset(, -1).Resize(, 3).Select

Es una maravilla poder usar Offset para cambiar el rango de referencia, y usar, como en el ejemplo, valores negativos. Esto aporta flexibilidad al manejar gran cantidad de rangos cambiantes.


Sub Resize6()
Range("B4").Offset(, -1).Resize(, 3).Select
End Sub

Resize7

Copia el rango amarillo (B11:E15) en el rango superior (B4:E8).

Range("B4").Resize(5, 4) = A

Este es un uso muy útil de la propiedad Resize ya que nos permite depositar (imprimir) de golpe todo un rango o el contenido de una matriz.



Sub Resize7()
Dim A As Variant
Worksheets("Hoja1").Range("A1").Select
A = Range("B11:E15")
Range("B4").Resize(5, 4) = A
End Sub

Resize8

Hace lo mismo que la macro anterior, copia el rango amarillo (B11:E15) en el rango superior (B4:E8).

Range("B4").Resize(R.Rows.Count, R.Columns.Count) = A

Este procedimiento realiza el mismo trabajo que el anterior aunque lo hemos programado de otra forma. En este caso, creamos las variables n y m que calculan el número de filas y columnas respectivamente del rango R. De esta forma hacemos más flexible el código ya que evitamos tener que dar nosotros los parámetros a la propiedad Resize.

Sub Resize8()
Dim A As Variant
Dim R As Range
Worksheets("Hoja1").Range("A1").Select
Set R = Range("B11:E15")
A = R
n = R.Rows.Count
m = R.Columns.Count
Range("B4").Resize(n, m) = A
End Sub

Resize9

Genera una matriz de números aleatorios y la imprime en una posición inicial variable y con un tamaño variable.

Range(Cells(pf, pc), Cells(pf, pc)) .Resize(n, m) = A


Seguidamente se muestra el código de ejemplo utilizado para ilustrar la versatilidad de la propiedad Resize.

Sub Resize9()
Dim A As Variant
Dim R As Range
Dim tf As Byte, tc As Byte, pf As Byte, pc As Byte
Worksheets("Hoja2").Activate
Range("E7:AQ45").Clear
Randomize
Range("A1").Select
tf = Int(Rnd() * 20) + 1 'tamaño:fila
tc = Int(Rnd() * 20) + 1 'tamaño: columna
pf = Int(Rnd() * 20) + 7 'posición inicial: fila
pc = Int(Rnd() * 20) + 5 'posición inicial: columna
[C6] = tf
[D6] = tc
[C5] = pf
[D5] = pc
Set R = Range(Cells(pf, pc), Cells(pf + tf - 1, pc + tc - 1))
R.Interior.Color = RGB(0, 255, 100)
A = R
n = R.Rows.Count
m = R.Columns.Count
ReDim A(n, m)
For i = 1 To n
  For j = 1 To m
    A(i, j) = Int(Rnd() * 100)
  Next j
Next i
Range(Cells(pf, pc), Cells(pf, pc)).Resize(n, m) = A
End Sub

Veamos un GIF animado donde se aprecia que el rango varía en posición y tamaño de forma aleatoria.


Conviene ver cómo se resolvió en otros casos la necesidad de imprimir de golpe toda una matriz, incluso de gran tamaño. Recomiendo ver los siguientes enlaces a otros post publicados.

domingo, 13 de mayo de 2018

Puntos linealmente separables

Puede descargar el archivo separarPuntos.xlsm

Vamos a generar 1000 puntos en un plano cartesiano unos rojos y otros azules. Las coordenadas de los puntos se generan de forma aleatoria pero lo que diferencia su color es que pueden ser separados por una línea recta.


Disponemos de una macro que genera los puntos y los parámetros de la recta en su forma implícita. La macro se denomina nuevaRecta y se lanza con un botón con el mismo nombre.


La ecuación implícita de la recta es la siguiente.

ω+ ωx+ ωx= 0

De ella despejamos la variable dependiente y obtenemos la ecuación explícita de la recta.

x= - (ω1 /  ω2) x1 - (ω0 / ω2)

Los parámetros que manejaremos para obtener la recta son ω0, ω1, ω2.

La macro que genera los puntos y la recta de forma aleatoria es la siguiente.

 Sub nuevaRecta()  
 Dim i As Integer  
 Dim R1 As Range, R2 As Range  
 Dim A, B  
 Set R1 = Range("B40:B1039")  
 Set R2 = Range("C40:C1039")  
 A = R1  
 B = R2  
 Randomize  
 For i = 1 To 1000  
  A(i, 1) = Rnd() * 10 - 5  
  B(i, 1) = Rnd() * 10 - 5  
 Next i  
 R1 = A  
 R2 = B  
 [C35] = Int(Rnd() * 80 - 40) / 10 'w0  
 [C36] = Int(Rnd() * 80 - 40) / 10 'w1  
 [C37] = Int(Rnd() * 80 - 40) / 10 'w2  
 End Sub  

Esta recta generada de forma aleatoria no separa bien los puntos rojos y azules, por lo que será necesario recurrir a algún procedimiento que nos de una nueva recta que si separe los puntos por colores.

Para conseguir separar los puntos mediante una recta procedemos a calcular en la celda amarilla (Q12) el número de errores cometidos. Cada punto rojo que esté por debajo de la recta y cada punto azul que esté por encima de la recta supondrán un error.


Para conseguir que el número de errores sea cero y que por tanto los puntos rojos queden por encima de la recta y los azules por debajo, recurrimos a una fantástica herramienta de Excel denominada 'Tabla de datos' que podemos encontrar en Datos / Análisis de hipótesis /Tabla de datos.


Lo que hacemos es calcular el error mínimo que se comete según diferentes valores de los parámetros de la recta ω0, ω1, ω2. La macro que se lanza con el botón 'mínimos' realiza la búsqueda de los errores mínimos. Este botón se ha de lanzar varias veces hasta conseguir que el error (celda amarilla) sea cero.

Este es un ejemplo que muestra la potencia de la herramienta Tabla de datos.

Veamos un gif animado donde se generan nuevos puntos y una nueva recta pulsando sobre el botón que llama a la macro nuevaRecta y luego pulsamos reiteradamente sobre el botón mínimos que lanza la macro que va minimizando los errores hasta que el error de la celda amarilla se hace cero. En ese momento tendremos la recta que separa completamente los puntos de colores en el plano.


viernes, 11 de mayo de 2018

Máquina de Galton en Excel

Puede descargar el archivo maquinaGalton.xlsm

La máquina de Galton nos permite ver cómo una distribución binomial tiende a una distribución normal cuando el número de tiradas va creciendo.


La máquina se puede ver en algunos museos de ciencias. También podríamos construirla nosotros con un tablero inclinado con una ranura superior por la que van cayendo bolitas que rebotan en una serie de clavos o pivotes. En cada rebote la bola tiene probabilidad 1/2 de ir hacia la izquierda o hacia la derecha. Esto se repite una y otra vez hasta que al final la bola termina en una cierta posición y cae por un carril que hemos construido con unas tablas verticales para separar unos de otros. Lo que vemos, si lanzamos un gran número de bolitas, es que los carriles de abajo forman una campana de Gauss. La distribución normal se forma como si de un histograma de frecuencias se tratara.

Vamos a construir una máquina de Galton virtual utilizando Excel y una macro que nos permite hacer el trabajo de la iteraciones de una forma rápida.

Hoja1

Primero creamos la macro que hace la que bolita baje rebotando entre los pivotes. En cada movimiento hacia abajo la bola tiene una probabilidad del 50% de ir hacia la izquierda y otro 50% de ir hacia la derecha. Es similar a un árbol binomial.



La macro que hace que la bola baje es la siguiente.

 Sub baja()  
 'árbol binomial de 32 etapas  
 Dim col As Byte  
 Worksheets("Hoja1").Activate  
 Randomize  
 Range("B2:BN68").Font.Bold = False  
 col = 34  
 Cells(2, 34) = "O"  
 Cells(4, 34) = "O"  
 Cells(4, 34).Font.Bold = True  
 For i = 1 To 32  
  If Rnd < 0.5 Then  
   col = col - 1  
  Else  
   col = col + 1  
  End If  
  Cells(i * 2 + 4, col) = "O"  
  Cells(i * 2 + 4, col).Font.Bold = True  
 Next i  
 End Sub  

Hoja2

Creamos un bucle FOR...NEXT que lanza un gran número de bolas, por ejemplo, 1000. De esta forma podemos ver en que columna ha quedado cada una de ellas al realizar el recorrido hacia abajo.

Veamos el código, similar al anterior pero incluyendo el bucle.

 Sub baja2()  
 Call BorraO  
 'árbol binomial de 32 etapas  
 Dim n As Long 'nº de tiradas  
 Dim col As Byte  
 Worksheets("Hoja2").Activate  
 Randomize  
 n = 1000  
 Application.ScreenUpdating = False  
 For j = 1 To n  
  col = 34  
  Cells(2, 34) = "O"  
  Cells(4, 34) = "O"  
  For i = 1 To 32  
   'una forma alternativa de sumar o restar 1 de forma aleatoria  
   col = col + WorksheetFunction.RandBetween(0, 1) * 2 - 1  
   Cells(i * 2 + 4, col) = "O"  
  Next i  
  'anotamos en la fila 99 los resultados  
  Cells(99, col) = Cells(99, col) + 1  
 Next j  
 Application.ScreenUpdating = True  
 End Sub  

Este es un proceso que puede tardar bastante tiempo en función del valor que demos a n. Para intentar reducir el tiempo de proceso podemos incluir al inicio la siguiente línea.

Application.ScreenUpdating = False


Con ella lo que hacemos el anular el envío de refresco a la pantalla de nuestro ordenador. Al final de la macro, dejamos el refresco activado para poder ver el resultado.

Application.ScreenUpdating = True

Veamos el resultado tras lanzar 10.000 veces la bola.



Hoja3

Nos gustaría poder ver la campana de Gauss que se forma con las tiradas. En la Hoja3 hemos creado unas columnas que se van rellenando con las bolas en vertical hasta que la columna más alta llegue a una altura de 30 bolas.


Con algo de imaginación podemos ver el bosquejo de una campana de Gauss. Para que veamos algo que nos recuerde más a la curva de una distribución normal tendríamos que usar muchas más tiradas.

Veamos el código.

 Sub baja3()  
 'árbol binomial de 32 etapas  
 Dim col As Byte  
 Call BorraO  
 Worksheets("Hoja3").Activate  
 Randomize  
 Do  
  col = 34  
  Cells(2, 34) = "O"  
  Cells(4, 34) = "O"  
  For i = 1 To 32  
   If Rnd < 0.5 Then  
    col = col - 1  
   Else  
    col = col + 1  
   End If  
   Cells(i * 2 + 4, col) = "O"  
  Next i  
  Cells(99, col) = Cells(99, col) + 1  
  miMax = Application.WorksheetFunction.Max(Range("Z99:AP99"))  
  Call BorraTri  
  Cells(98 - Cells(99, col), col) = "O"  
 Loop While miMax < 30  
 End Sub  


Hoja4 y Gráfico

En la Hoja4 lo que hacemos es traernos los valores obtenidos en la Hoja2, y presentarlos en forma de columna. Para ello usamos la siguiente expresión en la celda C4.

=INDIRECTO("Hoja2!"&"F99C"&B4*2;0)

Podemos ver aquí un potente uso de la función indirecto que toma valores de otra hoja para trasponerlos.

Con los valores obtenidos hacemos un histograma de frecuencias que se asemeja a una campana de Gauss. La apariencia será tanto mejor cuanto mayor sea el valor de tiradas (n).



jueves, 3 de mayo de 2018

Pesos y umbrales

Puede descargar el archivo pesosUmbrales.xlsm

He leído el siguiente artículo que es una introducción a la inteligencia artificial.


En el artículo se plantea un caso sencillo que podría resolver un perceptrón. Se trata de entender el comportamiento de una única neurona que tiene dos entradas con sus pesos omega 1 (ω1) y omega 2 (ω2), y un umbral de activación.

Planteamiento del problema

Un profesor realiza dos exámenes y pone la calificación final sin explicar cómo ha obtenido ésta. En la calificación final únicamente dice si el alumno ha aprobado o ha suspendido. Los alumnos desean averiguar que pesos da el profesor en cada examen (ω1 y ω2) para obtener la calificación media y con que nota media aprueba el profesor. Esa nota de corte sería el umbral de activación. Por ejemplo, una respuesta al problema podría ser la siguiente.

ω1=0,30 → El primer examen pesa un 30% en la nota final
ω2=0,70 → El segundo examen pesa un 70% en la nota final
u=0,4 → La asignatura se aprueba con un 4

Los pesos ω1 y ω2 se expresan en tanto por uno y su suma siempre es 1, que equivale al 100%.
La notas de los exámenes van entre 0 y 10, pero se divididen entre 10 para que su rango de variación esté entre 0 y 1. Lo mismo sucede con el umbral de activación (u), también se divide entre 10, por lo que aprobar con un 4 equivale a tener un umbral de 0,4.

Solución en Excel

No vamos a plantear la resolución en Excel mediante el uso de redes neuronales. Simplemente pretendemos plantear este caso sencillo mediante el uso de la hoja de cálculo. Es una pequeña aproximación a los fundamentos que rigen el comportamiento de una única neurona en un perceptrón sencillo de una capa. En lugar de ir buscando el camino más apropiado para llegar a la solución lo que hacemos es explorar todos los casos dentro de los valores que damos a ω1, ω2 y u.


Hacemos variar ω1 entre 0 y 1 en intervalos de 0,1. Como ω2 es la parte complementaria (ambas omegas suman 1), obtendremos que ω2 varía en el mismo intervalo, pero justo en orden inverso.

Hacemos variar el umbral u entre 0,1 y 0,9 con intervalos de 0,1.

Paso 1

Disponemos en la Hoja1 de los datos de los exámenes. Tenemos una tabla con las calificaciones obtenidas por los alumnos en el examen 1 y en el examen 2 (columnas C y D). En color naranja tenemos los pesos que ha asignado el profesor a cada examen y la nota de corte o umbral utilizado para aprobar.


Nuestro sistema será alimentado con los valores de color rosa correspondientes a 30 alumnos. Las columnas G y H contienen las notas de los dos exámenes divididas entre 10, ya que al perceptrón se le alimenta con datos estandarizados que van entre 0 y 1. La columna I indica si se ha aprobado el examen (1) o se ha supendido (0). La columan I es la misma que la columan F.



Paso 2

A la Hoja2 llevamos las notas de 30 alumnos, para ello copiamos y pegamos con pegado especial valores las tres columnas de color rosa.



Para cada uno de los 30 alumnos vamos a calcular la nota final ponderando con los valores de ω1y ω2 que van entre 0 y 1 con variación de 0,1. De esta forma se crea una tabla en las columnas de la E hasta la O. Así, la fórmula de la celda E7 es la siguiente fórmula matricial.

=SUMAPRODUCTO(TRANSPONER(E$4:E$5);$B7:$C7)

Esta fórmula multiplica la nota del examen 1 por el peso ω1 más el producto de la nota 2 por el peso ω2. También podríamos haber conseguido el mismo resultado con la fórmula siguiente para la celda E7.

=$B7*E$4+$C7*E$5



Paso 3


En las columnas desde la P hasta la Z, vamos a calcular la calificación de aprobado (1) o suspenso (0) teniendo en cuenta la nota media calculada en la tabla anterior y el umbral (u) que se encuentra en la celda P2. Si el umbral es 0,4 quiere decir que se aprueba con un 4 en la nota media.



La fórmula de la celda P7 es un condicional que nos dice si se aprubeba o no según se supere o no el umbral.

=SI(E7>=$P$2;1;0)


Paso 4

Ahora vamos a calcular los errores cometidos comparando el vector de ceros y unos de cada una de las columnas P:Z con los valores de la columna D que contienen los aprobados y suspensos publicados por el profesor.



La celda AA7 contiene la siguiente fórmula que nos permite realizar la comparación .

=--(P7<>$D7)

Si obtenemos un vector completamente de ceros lo vamos a colorear en amarillo usando Formato condicional.

En la fila 1, en el rango AA1:AK1 calculamos la suma de los errores cometidos en cada una de la columnas. Lo que nos interesa es detectar que el error sea cero. En AN1 calculamos el mínimo de ese rango y si llegamos a obtener un cero quiere decir que estamos ante un caso donde los valores de ω1, ω2 y u explican bien las calificaciones publicadas por el profesor.

Pero tenemos que calcular esta tabla para cada uno de los posibles valores de u desde 0,1 hasta 0,9. Para realizar este cálculo sin tener que ir variando el valor de forma manual o sin tener que hacer más tablas hemos recurrido a una estupenda herramienta de Excel denominada Tabla de datos y su resultado se muestra en el rango AM6:AN17.

Con ayuda de Formato condicional para los colores y con un par de botones que lanzan macros, podemos obtener la solución que buscamos. Si en el rango AP6:AP9 obtenemos las cuatro celdas con valores VERDADERO quiere decir que hemos encontrado la solución a un caso.

Si deseamos hacer un nuevo caso pulsaremos el botón denominado "cambia pesos" que lo que hace es cambiar los valores de los omegas y el umbral en la Hoja1, y lanzando la macro que intenta resolver el caso. El caso queda resuelto cando obtenemos los cuatro verdaderos.

Pero existe la posibilidad de que las 30 notas de los alumnos no sean suficientes para resolver el caso y entonces necesitemos otra muestra de valores. Esto se consigue pulsando el botón "Toma datos", que habrá que pulsar reiteradamente en algunas ocasiones para llegar a conseguir los cuatro verdaderos y por tanto la solución final del problema planteado.




domingo, 22 de abril de 2018

Gráfico con datos matriciales

Puede descargar el archivo manchasSolares.xlsm
Disponemos de dos casos, en ambos creamos un gráfico de dispersión XY con puntos constituidos por parejas de datos aleatorios. En el primer caso los datos se encuentran en la propia hoja de cálculo y en segundo caso los datos se generan de forma aleatoria en la propia macro, usando simplemente código VBA.

Hoja1

La capacidad de representar datos en un gráfico está limitada en Excel según la versión. Seguidamente se muestran las limitaciones de la versión 2016.


La información anterior está obtenida de la página de Microsoft. En la Hoja1 hemos creado 30.000 parejas de valores.


En las columnas A y B creamos aleatoriamente el radio y el ángulo que son las dos coordenadas polares que vamos a manejar. Luego en las columnas C y D convertimos las coordenadas polares en coordenadas cartesianas con la fórmula siguiente.


Si el radio se obtiene con la función aleatorio() esto nos permite crear un gráfico como el siguiente.


Observamos una mayor concentración de puntos en el centro. Si queremos que la distribución de puntos aleatorios sea uniforme en toda la circunferencia hemos de elegir el radio como la raiz cuadrada de una uniforme cero uno.

=raiz(aleatorio())

Con este cambio obtendremos el siguiente gráfico que podemos ver en forma de gif animado obtenido al recalcular los valores aleatorios pulsando la tecla de función F9 de forma reiterada.


Hoja2

Con el segundo caso veremos cómo generar los puntos aleatorios con una macro. Mediante código VBA crearemos una matriz para el eje X y otra matriz para el eje Y. Luego introduciremos ambas matrices como las series de valores para poder generar el gráfico de tipo dispersión XY.


Primera macro

 Sub generaChartConArray1()  
 Dim A(16000) As Variant  
 Dim B(16000) As Variant  
 Dim i As Long  
 Dim grafico As ChartObject  
 Dim c As Byte  
 Dim ChtObj As ChartObject  
 Worksheets("Hoja2").Activate  
 c = 0  
 Randomize  
 For i = 1 To 16000  
  A(i) = Rnd  
  B(i) = Rnd  
 Next i  
 For Each grafico In Worksheets("Hoja2").ChartObjects  
   If grafico.Name = "migas" Then  
     c = c + 1  
   End If  
 Next  
 If c = 0 Then  
  Set ChtObj = Worksheets("Hoja2").ChartObjects.Add(Left:=10, Top:=10, _  
       Width:=400, Height:=400)  
  With ChtObj  
   .Chart.ChartType = xlXYScatter  
   .Chart.SetSourceData Source:=Range("Hoja2!$A$1:$B$2")  
   .Name = "migas"  
 End With  
 End If  
 ActiveSheet.ChartObjects("migas").Activate  
 ActiveChart.SeriesCollection(1).XValues = A  
 ActiveChart.SeriesCollection(1).Values = B  
 ActiveChart.Axes(xlCategory).MaximumScale = 1  
 ActiveChart.Axes(xlCategory).MinimumScale = 0  
 ActiveChart.Axes(xlValue).MaximumScale = 1  
 ActiveChart.Axes(xlValue).MinimumScale = 0  
 ActiveChart.SetElement (msoElementLegendNone)  
 ActiveChart.SetElement (msoElementPrimaryValueGridLinesNone)  
 ActiveChart.SetElement (msoElementPrimaryCategoryAxisNone)  
 ActiveChart.SetElement (msoElementPrimaryValueAxisNone)  
 ActiveChart.SetElement (msoElementChartTitleNone)  
 ActiveChart.FullSeriesCollection(1).MarkerStyle = -4118  
 ActiveChart.FullSeriesCollection(1).MarkerSize = 2  
 Range("A1").Select  
 End Sub  

Segunda macro

 Sub generaChartConArray2()  
 Dim A() As Variant  
 Dim B() As Variant  
 Dim i As Long  
 Dim radio As Double  
 Dim angulo As Double  
 Dim grafico As ChartObject  
 Dim c As Byte  
 Dim n As Long  
 Dim ChtObj As ChartObject  
 Worksheets("Hoja2").Activate  
 c = 0  
 n = 16384  
 ReDim A(n)  
 ReDim B(n)  
 Randomize  
 For i = 1 To n  
  radio = Rnd  
  angulo = Rnd * 2 * (WorksheetFunction.Pi)  
  A(i) = radio * Cos(angulo)  
  B(i) = radio * Sin(angulo)  
 Next i  
 For Each grafico In Worksheets("Hoja2").ChartObjects  
   If grafico.Name = "migas" Then  
     c = c + 1  
   End If  
 Next  
 If c = 0 Then  
  Set ChtObj = Worksheets("Hoja2").ChartObjects.Add(Left:=10, Top:=10, _  
       Width:=400, Height:=400)  
  With ChtObj  
   .Chart.ChartType = xlXYScatter  
   .Chart.SetSourceData Source:=Range("Hoja2!$A$1:$B$2")  
   .Name = "migas"  
 End With  
 End If  
 ActiveSheet.ChartObjects("migas").Activate  
 ActiveChart.SeriesCollection(1).XValues = A  
 ActiveChart.SeriesCollection(1).Values = B  
 ActiveChart.Axes(xlCategory).MaximumScale = 1  
 ActiveChart.Axes(xlCategory).MinimumScale = -1  
 ActiveChart.Axes(xlValue).MaximumScale = 1  
 ActiveChart.Axes(xlValue).MinimumScale = -1  
 ActiveChart.SetElement (msoElementLegendNone)  
 ActiveChart.SetElement (msoElementPrimaryValueGridLinesNone)  
 ActiveChart.SetElement (msoElementPrimaryCategoryAxisNone)  
 ActiveChart.SetElement (msoElementPrimaryValueAxisNone)  
 ActiveChart.SetElement (msoElementChartTitleNone)  
 ActiveChart.FullSeriesCollection(1).MarkerStyle = -4118  
 ActiveChart.FullSeriesCollection(1).MarkerSize = 2  
 Range("A1").Select  
 End Sub  

Tercera macro

 Sub generaChartConArray3()  
 Dim A() As Variant  
 Dim B() As Variant  
 Dim i As Long  
 Dim radio As Double  
 Dim angulo As Double  
 Dim grafico As ChartObject  
 Dim c As Byte  
 Dim n As Long  
 Dim ChtObj As ChartObject  
 Worksheets("Hoja2").Activate  
 c = 0  
 n = 16384  
 ReDim A(n)  
 ReDim B(n)  
 Randomize  
 For i = 1 To n  
  radio = Sqr(Rnd)  
  angulo = Rnd * 2 * (WorksheetFunction.Pi)  
  A(i) = radio * Cos(angulo)  
  B(i) = radio * Sin(angulo)  
 Next i  
 For Each grafico In Worksheets("Hoja2").ChartObjects  
   If grafico.Name = "migas" Then  
     c = c + 1  
   End If  
 Next  
 If c = 0 Then  
  Set ChtObj = Worksheets("Hoja2").ChartObjects.Add(Left:=10, Top:=10, _  
       Width:=400, Height:=400)  
  With ChtObj  
   .Chart.ChartType = xlXYScatter  
   .Chart.SetSourceData Source:=Range("Hoja2!$A$1:$B$2")  
   .Name = "migas"  
 End With  
 End If  
 ActiveSheet.ChartObjects("migas").Activate  
 ActiveChart.SeriesCollection(1).XValues = A  
 ActiveChart.SeriesCollection(1).Values = B  
 ActiveChart.Axes(xlCategory).MaximumScale = 1  
 ActiveChart.Axes(xlCategory).MinimumScale = -1  
 ActiveChart.Axes(xlValue).MaximumScale = 1  
 ActiveChart.Axes(xlValue).MinimumScale = -1  
 ActiveChart.SetElement (msoElementLegendNone)  
 ActiveChart.SetElement (msoElementPrimaryValueGridLinesNone)  
 ActiveChart.SetElement (msoElementPrimaryCategoryAxisNone)  
 ActiveChart.SetElement (msoElementPrimaryValueAxisNone)  
 ActiveChart.SetElement (msoElementChartTitleNone)  
 ActiveChart.FullSeriesCollection(1).MarkerStyle = -4118  
 ActiveChart.FullSeriesCollection(1).MarkerSize = 2  
 Range("A1").Select  
 End Sub  

La segunda y tercera macro son prácticamente iguales, únicamente cambia la forma en la que elegimos el radio. En la segunda macro se hace según una distribución de probabilidad uniforme entre cero y uno. En la tercera macro lo que pretendemos es que los puntos del gráfico se distribuyan de forma uniforme por el área de la circunferencia por lo que hemos tenido que modificar la distribución de probabilidad introduciendo la raiz cuadrada de una uniforme entre cero y uno.

Puede ver un desarrollo parecido en otro lenguaje de programación en el siguiente enlace.

Canvas en HTML5+CSS+JS creando puntitos aleatorios

El él se emplea HTML5+CSS+JavaScript.