sábado, 25 de mayo de 2013

Una regla de color uniforme, redondeada, con cero y colores desplazados (4)

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:

  1. Cada rango de color debe contener aproximadamente al misma cantidad de países.
  2. Los extremos de cada rango deben redondearse con ceros a la derecha sin afectar la condición anterior.
  3. 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".

No hay comentarios: