Una escala de colores "redonda" para los mapas en Reporting Services

Enunciado

Las formas automáticas para definir la escala de colores en los mapas de reporting services tienen un defecto: los máximos y mínimos de cada rango pueden ser algo así como:

• De 567 a 1002
• De 1002 a 3141    
• De 3141 a 9999
• De 9999 a 20010

En este post copio un código que genera una escala:

• De 500 a 1000
• De 1000 a 3000    
• De 3000 a 10000    
• De 10000 a 30000

Cada color contiene "mas o menos" la misma cantidad de elementos.

Solución

Hay que hacer varias cosas:

1. Evaluar la sentencia del informe (en mi código una sentencia MDX, pero no es necesario podría ser SQL)
2. Para que haya la misma cantidad de países en cada color usamos percentiles. En el código que muestro hay diez colores, por tanto uso deciles (uso un código similar al de mi post Cuartiles en SSAS, pero es aplicable con otras formas de obtener los datos, i.e. SQL)
3. A medida que los obtenemos redondeamos el dígito mas alto esto es de 9.999.999 "redondeamos a 10.000.000 y lo guardamos.
4. Cuando terminamos, comprobamos si hay dos valores iguales y lo resolvemos(lo puede haber provocado el redondeo). Por ejemplo 10000 a 20000,  20000 a 20000, 20000 a 30000 pasaría a ser 10000 a 20000 20000 a 25000 25000 a 30000.
5. Modificamos la definición del informe (ver mi post sobre cómo hacerlo)

Bien, este es el código:

Public Function RangosMapa(s As String) As List(Of Double)
        Dim r As New List(Of Double)
        Dim isov As String()
        If Ambito = "M" Then
            isov = IsoEsriMundo 'lista de ISO2 paises del mundo
        Else
            isov = IsoEsriEuropa 'Lista de ISO2 paises de Europa
        End If
        Dim lista As New List(Of Double)

        'Calculamos la sentencia en el informe
        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
            If isov.Contains(lector.GetString(0)) Then lista.Add(lector.GetDecimal(4))
        Loop
        lector.Close()
        cn.Close()
        cn.Dispose()

        'recorremos lo deciles
        lista.Sort()
        r.Add(Piso(lista(0)))
        Dim paso = lista.Count / 10
        For i = paso To lista.Count - 2 Step paso
            Dim valor = lista(Math.Round(i) - 1)
            Dim redondo = Redondeo(valor)
            If redondo > r(r.Count - 1) Then
                r.Add(Redondeo(lista(Math.Round(i) - 1)))
            Else
                r.Add(Techo(valor))
            End If
        Next
        r.Add(Techo(lista(lista.Count - 1)))
        'Si hay valores duplicados partimos por la mitad.
        Dim cambio As Boolean
        Do
            cambio = False
            For i = 1 To r.Count - 1
                If r(i) = r(i - 1) Then
                    r(i) = (r(i - 1) + r(i + 1)) / 2
                    cambio = True
                End If
            Next
        Loop Until Not cambio
        Return r
    End Function
'Funciones de redondeo
    Public Function CalculoFactor10(n As Double) As Integer
        Return Math.Pow(10, Math.Round(Math.Log10(n)))
    End Function
    Public Function Piso(n As Double) As Double
        If RedondeoSuperior Then
            Dim factor10 = CalculoFactor10(n)
            Return Math.Floor(n / factor10) * factor10
        Else
            Return Math.Floor(n)
        End If

    End Function

    Public Function Techo(n As Double) As Double
        If RedondeoSuperior Then
            Dim factor10 = CalculoFactor10(n)
            Return Math.Ceiling(n / factor10) * factor10
        Else
            Return Math.Ceiling(n)
        End If
    End Function

    Public Function Redondeo(n As Double) As Double
        If RedondeoSuperior Then
            Dim factor10 = CalculoFactor10(n)
            Return Math.Round(n / factor10) * factor10
        Else
            Return Math.Round(n)
        End If
    End Function
'parametrización del mapa
 Public Function ParametrizaMapa(informe As XDocument, rangosMapa As List(Of Double)) As XDocument
        Dim df = informe.Root.Name.Namespace
        Dim mapa = informe.Root.Element(
            df + "ReportSections").Element(
            df + "ReportSection").Element(
            df + "Body").Element(
            df + "ReportItems").Element(
            df + "Map")
        Dim capa = mapa.Element(df + "MapLayers").Element(df + "MapPolygonLayer")
        capa.Element(df + "MapPolygons").ReplaceNodes(Poligonos.Nodes)
        Dim reglasColor = capa.Element(df + "MapPolygonRules").Element(df + "MapColorRangeRule")
        Dim culturaUSA = New System.Globalization.CultureInfo("en-US")
        reglasColor.Element(df + "DistributionType").Value = "Custom"
        Dim i = 0
        For Each elemento In reglasColor.Element(df + "MapBuckets").Elements
            elemento.Element(df + "StartValue").Value = rangosMapa(i).ToString(culturaUSA.NumberFormat)
            elemento.Element(df + "EndValue").Value = rangosMapa(i + 1).ToString(culturaUSA.NumberFormat)
                i += 1
        Next
        Return informe
    End Function

Si alguien necesita mas detalles, estoy a su disposición