ENUNCIADO
En la entrada (1) de esta serie definimos los objetivos: una regla de color personalizada para un mapa generado mediante Reporting Services que fuera uniforme, redondeada, con cero y colores desplazados
En la entrada (2) vimos como podemos cargar un informe en memoria, para modificarlo y volcarlo en un control ReportViewer.
En la entrada (3) modificamos la definición XML del informe dejando pendientes las funciones que cálculan los rangos y colores.
Durante la modificación de las reglas de color del informe utilizamos una función rangosMapa que desde una sentencia MDX devuelve la lista de valores doubles para construir los rangos de la regla.
Dicho de otra forma, los números que vemos aquí:
Recordemos que estos números deben satisfacer las condiciones:
- Cada rango de color debe contener aproximadamente al misma cantidad de países.
- Los extremos de cada rango deben redondearse con ceros a la derecha sin afectar la condición anterior.
- Si los valores inferior y exterior tienen distinto signo dos rangos de color deben tener como extremo el cero, con mínima afección sobre el requisito 1.
SOLUCIÓN
En nuestro ejemplo los datos provederán de un servidor SQL Server Analisys Services por lo que necesitaremos la librería Microsoft.AnalysisServices.adomdClient
Imports Microsoft.AnalysisServices.AdomdClient
Dividimos nuestro trabajo en dos pasos: evaluar la sentencia MDX y calcular los rangos:
Public Function RangosMapa (s As String) As List(Of Double, numRangos as Integer)
Dim lista As List(Of Double)= EvaluaMDX(s)
Dim Rangos as List (Of Double)=RangosRedondos(lista, NumRangos, 0, True)
Return (Rangos)
End Function
Evaluar la expresión MDX y almacenamos los resultados en una lista de doubles no tiene gran secreto:
Public Function EvaluaMDX(s As String) As List(Of Double)
Dim lista As New List(Of Double)
Dim cn As New AdomdConnection(My.Settings.SSASConexion)
cn.Open()
Dim cmd As AdomdCommand = cn.CreateCommand()
cmd.CommandText = evaluaSentencia(s)
Dim lector = cmd.ExecuteReader()
Do While lector.Read
lista.Add(lector.GetDecimal(4)) 'el valor está en la posición 4
Loop
lector.Close()
cn.Close()
cn.Dispose()
Return (lista)
End Function
El procedimiento siguiente será crear la lista de rangos.
El truco está en ordenar la lista y luego la recorrerla en saltos con un paso calculado desde el total de valores y numero de intervalos que queramos. En cada salto extremos el valor y lo añadimos a la lista de rangos Obtendríamos así una la lista que satisfacerla la condición 1 más arriba..
Para el caso de que la lista contenga el cero (condición 2), el procedimiento es ligeramente distinto. Trabajamos con dos listas (positivos y negativos) y aplicamos el algoritmo anterior a cada uno de ellos con un numero de rangos en cada lista proporcional a la posición del cero.
Esta lista tendrá valores extraídos de la lista por ejemplo 9457,89. La siguiente tarea será redondear a un múltiplo de 10 sin alterar los valores incluidos en cada rango, por ejemplo 9000,00. pero deberemos hacer evitando afectar el número de valores entre los nuevos extremos.
Veamos el código que quizás sea lo mas simple:
'''
''' Desde una lista de valores decimales obtiene otra lista de valores decimales que reparte de forma uniforme los valores.
'''
''' Lista original
''' Número de rangos en los que se repartirá
''' número decimales
''' Lista de rangos
'''
Public Function RangosRedondos(lista As List(Of Double), numRangos As Integer, decimales As Integer, redondear As Boolean) As List(Of Double)
Dim rangos As List(Of Double)
lista.Sort() 'ordenamos
'obtención del rango variable
If lista(0) <= 0 And lista(lista.Count - 1) >= 0 Then
'cuando hay un cero deberá aparecer en un extremo de los rangos
rangos = repartoConCero(lista, numRangos)
Else
rangos = reparto(lista, numRangos)
End If
'ahora vamos redondeando sin alterar el reparto
If redondear Then rangos = RedondeoLista(rangos, lista, decimales)
'y para terminar nos aseguramos de que los valores extremos esten incluidos
rangos(0) -= 1
rangos(rangos.Count - 1) += 1
Return rangos
End Function
'''
''' Crea una lista de rangos que contienen aproximandamente la misma cantidad de elementos
'''
''' lista ordenada de números decimales desde donde se genera
''' numero de rangos
''' lista con numrangos + 1 valores decimales que definen los rangos
'''
Private Function reparto(lista As List(Of Double), numRangos As Integer) As List(Of Double)
Dim paso As Decimal = lista.Count / numRangos
Dim rangos As New List(Of Double)
rangos.Add(lista(0))
For i = 1 To numRangos - 1
rangos.Add(lista(Math.Round(i * paso, System.MidpointRounding.AwayFromZero)))
Next
rangos.Add(lista(lista.Count - 1))
Return rangos
End Function
'''
''' Reparte los valores de una lista decimal que cruza el valor cero entre una serie de rangos.
''' Dos rangos compartiran el extremo con valor cero
'''
''' lista ordenada de números decimales desde donde se genera
''' numero de rangos
''' lista con numrangos + 1 valores decimales que definen los rangos
'''
Private Function repartoConCero(lista As List(Of Double), numRangos As Integer) As List(Of Double)
Dim Negativos = (From v In lista Where v < 0).ToList
Dim Positivos = (From v In lista Where v >= 0).ToList
Dim rangoNegativos = reparto(Negativos, numRangos * Negativos.Count / lista.Count)
Dim rangoPositivos = reparto(Positivos, numRangos * Positivos.Count / lista.Count)
If (-rangoNegativos(rangoNegativos.Count - 1)) < rangoPositivos(0) Then
'el mayor número negativo está mas próximo a cero que el menor positivo
rangoNegativos(rangoNegativos.Count - 1) = 0
rangoPositivos.RemoveAt(0)
Else
rangoPositivos(0) = 0
rangoNegativos.RemoveAt(rangoNegativos.Count - 1)
End If
Dim resultado As New List(Of Double)
resultado.AddRange(rangoNegativos)
resultado.AddRange(rangoPositivos)
Return resultado
End Function
'''
''' Redondea todo lo posible los valores del rango.
'''
''' rango a redondear
''' lista que controla el rango
''' número de decimales a conservar
'''
'''
Private Function RedondeoLista(rangos As List(Of Double), lista As List(Of Double), decimales As Integer) As List(Of Double)
For i = 1 To rangos.Count - 2
Dim limiteRango = rangos(i)
'calculamos la diferencia entre el último valor en el rango anterior y el primero del siguiente
Dim difSupInf = (From v In lista Where v >= limiteRango).Min - (From v In lista Where v < limiteRango).Max
'calculamos el primer digito no significativo mediante la parte entera del logaritmo en base 10
Dim factorDigitos = 10 ^ Math.Floor(Math.Log10(difSupInf) + decimales - 1) 'le sumamos los decimales (ver linea siguiente)
Dim factorDecimales = 10 ^ decimales
limiteRango *= factorDecimales 'estamos trasladando los decimales a la parte entera.
limiteRango = Math.Floor(limiteRango / factorDigitos) * factorDigitos
rangos(i) = limiteRango / factorDecimales
Next
Return rangos
End Function
Antes de terminar llamar la atención sobre dos parámetros que no he comentado:
- decimales: que permite establecer el número de decimales con los que trabajamos en el redondeo.
- redondeo: por si en un momento preferimos obtener la lista sin redondeo.
La próxima y última entrada de esta serie definirá una lista de colores para el rango calculado si este contuviera el "cero".
