asked on 8/10/2011

Ranking Data in Vb.net

I am trying to write a routine that will rank some data contained in a datatable in vb.net and display it in a data grid. If there is a tie I want the following rank to reflect it
(for example if there is a 3 way tie for first. I want a ranking of 1 to appear 3 times followed by a ranking of 4

I have included the code and some sample data below (for security reasons I blanked out the connection string)

At one point I thought it was working but it seems to get in an endless loop in the

While dTable.DefaultView.Item(i).Item("AverageWork") - CurRank > 1
dTable.DefaultView.Item(i).Item("AverageWork") = dTable.DefaultView.Item(i).Item("AverageScore") - 1
End While

Any ideas?

Dim strConnectionString As String

        strConnectionString = ""


        Dim dbadp As New SqlDataAdapter("Select shopnum, district, csiscorem1 as averageScore From Month1PAQuarterResult where district =" & 323 & " and csiscorem1 > 0", strConnectionString)
        Dim dTable As New DataTable
        dbadp.Fill(dTable)
        dbadp.Dispose()

        dTable.Columns.Add("AverageWork", GetType(Decimal))
        dTable.Columns.Add("OverallRank", GetType(Integer))

        dTable.DefaultView.Sort = "AverageScore"

        Dim CurRank As Integer = 0
        Dim CurRankHold As Integer = 1
        Dim LastRankUsed As Integer = 0


        For i As Integer = 0 To dTable.DefaultView.Count - 1
            dTable.DefaultView.Item(i).Item("AverageWork") = dTable.DefaultView.Item(i).Item("AverageScore")
            While dTable.DefaultView.Item(i).Item("AverageWork") - CurRank > 1
                dTable.DefaultView.Item(i).Item("AverageWork") = dTable.DefaultView.Item(i).Item("AverageScore") - 1
            End While
            CurRank = dTable.DefaultView.Item(i).Item("AverageWork")

            If i = 0 Then
                dTable.DefaultView.Item(i).Item("OverallRank") = CurRank
            Else
                LastRankUsed = dTable.DefaultView.Item(i - 1).Item("OverallRank")
                If dTable.DefaultView.Item(i).Item("AverageScore") = dTable.DefaultView.Item(i - 1).Item("AverageScore") Then

                    If CurRank = 1 Then
                        dTable.DefaultView.Item(i).Item("OverallRank") = CurRank
                    Else
                        dTable.DefaultView.Item(i).Item("OverallRank") = LastRankUsed
                    End If

                    CurRankHold = CurRankHold + 1
                Else

                    dTable.DefaultView.Item(i).Item("OverallRank") = (LastRankUsed + CurRankHold)

                    CurRankHold = 1
                End If
            End If
        Next

        Me.dgRankings.DataSource = dTable

        Me.dgRankings.Refresh()





ShopNum	District	AverageScore
1762	323	50
5111	323	52
1814	323	54.8
1612	323	57.1
1302	323	60
1377	323	60
1397	323	60
1458	323	60
1848	323	60
1973	323	60
1153	323	63.3
5776	323	63.6
1869	323	64.5
1213	323	65
1219	323	65
1394	323	65
1185	323	66.7
1611	323	66.7
1130	323	67.6
1137	323	67.7
1139	323	69
1115	323	70
1135	323	70
1202	323	70
1572	323	70
2464	323	70
2711	323	70
5274	323	70
1663	323	70.6
1126	323	71.4
5390	323	71.4
1174	323	72.4
1180	323	73.3
1862	323	73.3
1104	323	75
1118	323	75
1158	323	75
1164	323	75
1599	323	75
3714	323	75
1176	323	76.2
1148	323	77.8
1391	323	77.8
1125	323	78.6
1672	323	78.9
1144	323	79.3
1101	323	80
1103	323	80
1228	323	80
1231	323	80
1236	323	80
1247	323	80
1286	323	80
1576	323	80
1664	323	80
1816	323	80
1854	323	81.8
1184	323	83.3
1210	323	83.3
1355	323	83.3
1866	323	83.3
1309	323	84.2
1357	323	84.2
1157	323	85
1358	323	85
1961	323	85
1109	323	85.7
1395	323	86.7
1800	323	89.7
1124	323	90
1195	323	90
1203	323	90
1241	323	90
1299	323	90
1376	323	90
1396	323	90
1433	323	90
1577	323	90
1662	323	90
1801	323	90
1966	323	90
1968	323	90
5106	323	90
1356	323	90.5
1560	323	90.9
1129	323	95
1239	323	95
1354	323	95
1598	323	95
5110	323	95
1182	323	96.7
1163	323	100
1413	323	100
5105	323	100
5669	323	100


This is  the ranking results I was hoping for

ShopNum	District	AverageScore	OverallRank
1762	323	50	1
5111	323	52	2
1814	323	54.8	3
1612	323	57.1	4
1302	323	60	5
1377	323	60	5
1397	323	60	5
1458	323	60	5
1848	323	60	5
1973	323	60	5
1153	323	63.3	11
5776	323	63.6	12
1869	323	64.5	13
1213	323	65	14
1219	323	65	14
1394	323	65	14
1185	323	66.7	17
1611	323	66.7	17
1130	323	67.6	19
1137	323	67.7	20
1139	323	69	21
1115	323	70	22
1135	323	70	22
1202	323	70	22
1572	323	70	22
2464	323	70	22
2711	323	70	22
5274	323	70	22
1663	323	70.6	29
1126	323	71.4	30
5390	323	71.4	30
1174	323	72.4	32
1180	323	73.3	33
1862	323	73.3	33
1104	323	75	35
1118	323	75	35
1158	323	75	35
1164	323	75	35
1599	323	75	35
3714	323	75	35
1176	323	76.2	41
1148	323	77.8	42
1391	323	77.8	42
1125	323	78.6	44
1672	323	78.9	45
1144	323	79.3	46
1101	323	80	47
1103	323	80	47
1228	323	80	47
1231	323	80	47
1236	323	80	47
1247	323	80	47
1286	323	80	47
1576	323	80	47
1664	323	80	47
1816	323	80	47
1854	323	81.8	57
1184	323	83.3	58
1210	323	83.3	58
1355	323	83.3	58
1866	323	83.3	58
1309	323	84.2	62
1357	323	84.2	62
1157	323	85	64
1358	323	85	64
1961	323	85	64
1109	323	85.7	67
1395	323	86.7	68
1800	323	89.7	69
1124	323	90	70
1195	323	90	70
1203	323	90	70
1241	323	90	70
1299	323	90	70
1376	323	90	70
1396	323	90	70
1433	323	90	70
1577	323	90	70
1662	323	90	70
1801	323	90	70
1966	323	90	70
1968	323	90	70
5106	323	90	70
1356	323	90.5	84
1560	323	90.9	85
1129	323	95	86
1239	323	95	86
1354	323	95	86
1598	323	95	86
5110	323	95	86
1182	323	96.7	91
1163	323	100	92
1413	323	100	92
5105	323	100	92
5669	323	100	92

Open in new window

ASP.NET Visual Basic.NET

Last Comment

johnnyg123

8/11/2011

nepaluz

8/10/2011

I found an article on the web and it had this function. It did not produce the resuts you wanted, but having played with it for a few minutes, I have to admit I need some rest. Try and tweak it and see if you get the results you want.

    Function Rank(Of T)(ByRef x() As T) As Integer()
        Dim original_pos = x.Select(Function(xx, index) New With {.Val = xx, .Index = index}) _
                 .ToLookup(Function(xxx) xxx.Val)
        Dim keys = original_pos.OrderBy(Function(yy) yy.Key)
        Dim result(x.Count - 1) As Integer
        Dim i As Integer = 1
        For Each item In keys
            For Each v In item
                result(v.Index) = i
            Next
            i = i + item.Count
        Next
        Return result
    End Function

Open in new window

ASKER CERTIFIED SOLUTION

ElrondCT

8/11/2011

THIS SOLUTION IS ONLY AVAILABLE TO MEMBERS.

View this solution by signing up for a free trial.

Members can start a 7-Day free trial and enjoy unlimited access to the platform.

See Pricing Options

Start Free Trial

Alfred A.

8/11/2011

You could actually simplify this further by using a T-SQL Ranking function (e.g. RANK()) rather than doing it in VB.NET. You could add an OverallRank Column by doing the following improvement in your T-SQL in the code below. You could just then easily fill your datatable considering that there is no need for you to create a rank functionality within VB.NET. Check the link below for further reference.

http://msdn.microsoft.com/en-us/library/ms189798.aspx

Dim dbadp As New SqlDataAdapter("Select shopnum, district, csiscorem1 as averageScore, RANK() OVER (ORDER BY csiscoreml) As [OverallRank] From Month1PAQuarterResult where district =" & 323 & " and csiscorem1 > 0", strConnectionString)

Open in new window

johnnyg123

8/11/2011

ASKER

Thanks for all the posts!

Alfred1,

Thanks for the suggestion about the rank function.

I forgot to mention I'm using sql 2000 and unfortunately the rank function is only availiable in sql 2005 and later

nepaluz

8/11/2011

the code I gave above will rank integers but seems to have problems with decimals and doubles.
Here's the original article (which is consistent with your query). See if you can make sense of it.
http://www.iwebthereforeiam.com/iwebthereforeiam/2009/10/vbnet-code-to-implement-excel-rank.html

johnnyg123

8/11/2011

ASKER

ElrondCT,

Your suggestion provides the exact result I had asked for.

Unfortunately, my original understanding that the lowest scores should get the highest rank was incorrect

The user wants the highest scores rated highest. Is there in easy way to reverse?

Thanks!

johnnyg123

8/11/2011

ASKER

Actually....I just needed to change

dTable.DefaultView.Sort = "AverageScore"

to

dTable.DefaultView.Sort = "AverageScore desc"

All is well

thanks so much!

For anyone following this post here is the code

strConnectionString = ""

Dim dbadp As New SqlDataAdapter("Select shopnum, district, csiscorem1 as averageScore From Month1PAQuarterResult where district =" & 323, strConnectionString)
Dim dTable As New DataTable
dbadp.Fill(dTable)
dbadp.Dispose()

dTable.Columns.Add("AverageWork", GetType(Decimal))
dTable.Columns.Add("OverallRank", GetType(Integer))

dTable.DefaultView.Sort = "AverageScore desc"

Dim CurRank As Integer = 0
Dim LastAverage As Double = -1

For i As Integer = 0 To dTable.DefaultView.Count - 1
If dTable.DefaultView.Item(i).Item("AverageScore") = LastAverage Then
dTable.DefaultView.Item(i).Item("OverallRank") = CurRank
Else
dTable.DefaultView.Item(i).Item("OverallRank") = i + 1
CurRank = i + 1
LastAverage = dTable.DefaultView.Item(i).Item("AverageScore")
End If
Next

Me.dgRankings.DataSource = dTable

Me.dgRankings.Refresh()

Note: For security purposes the connection string is set to blank

johnnyg123

8/11/2011

ASKER

You were right. I can't believe how hard I was making it

Thanks!