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.