Create Random list of Record

by Ruben 4/4/2008 5:10:00 PM

How to select record by create random selection using VB.Net.

ex: CreateRandomList(Percentage, TotalRecs, True)

******Module*******
Imports System
Imports System.IO
Imports Microsoft.VisualBasic
Imports System.Math
Imports System.Timers

Module modFunction
    Private Sub BubbleSort(ByVal theArray() As Integer)
        Dim pass As Integer, compare As Integer
        Dim hold As Integer

        For pass = 1 To (UBound(theArray) - 1)
            For compare = 1 To (UBound(theArray) - 1)
                If theArray(compare) > theArray(compare + 1) Then
                    hold = theArray(compare)
                    theArray(compare) = theArray(compare + 1)
                    theArray(compare + 1) = hold
                End If
            Next compare
        Next pass
    End Sub

    Public Function CreateRandomList(ByVal Percentage As Long, ByVal MaxDocs As Long, ByVal Whole As Boolean) As Long
        Dim iNumDocs As Integer, iIndex As Integer
        Dim Num As Integer, Used() As Boolean, Count As Integer
        Dim iTime As New Timers.Timer

        ' Variables for the computation when we want to get sampling via percentage
        Dim iItems As Integer, iIncrement As Integer, iItemsCtr As Integer
        Dim iUpperBound As Integer, iLowerBound As Integer

        Try
            If Not Whole Then
                iItemsCtr = 1
                iItems = MaxDocs * (Percentage / 100)
                iIncrement = Round(MaxDocs / iItems)

                ' Initialize bounds
                iLowerBound = 1
                iUpperBound = iIncrement
            End If

            ' Compute for the number of documents that should be extracted
            iNumDocs = Round(MaxDocs * (Percentage / 100))

            ReDim RandomList(0 To iNumDocs)
            iIndex = 1

            ReDim Used(0 To Val(MaxDocs))

            Randomize(iTime.Interval)

            For Count = 0 To Val(iNumDocs) - 1
                Do
                    If Whole Then
                        Num = (Rnd() * (Val(MaxDocs) - 1)) + 1
                    Else
                        ' Check for the last range
                        If iItemsCtr + 1 = MaxDocs Then
                            ' Means the last range have smaller value than the increment value
                            If iUpperBound + iIncrement > MaxDocs Then
                                iIncrement = Round((MaxDocs - iUpperBound) / 2)
                            End If
                        End If

                        ' Check if last range is less than the increment
                        If iItemsCtr = MaxDocs Then
                            If iUpperBound <> MaxDocs Then
                                iUpperBound = MaxDocs
                            End If
                        End If

                        If (iUpperBound - iLowerBound = 1) Then
                            If Rnd() > 0.5 Then
                                Num = Int((iUpperBound - iLowerBound + 1) * Rnd() + iLowerBound)
                            Else
                                Num = Int((iUpperBound - iLowerBound) * Rnd() + iLowerBound)
                            End If
                        Else
                            Num = Int((iUpperBound - iLowerBound + 1) * Rnd() + iLowerBound)
                        End If

                        iLowerBound = iUpperBound + 1
                        iUpperBound = iUpperBound + iIncrement

                        If iUpperBound > MaxDocs Then
                            iUpperBound = MaxDocs
                        End If

                        iItemsCtr = iItemsCtr + 1
                    End If
                Loop Until Not Used(Num)

                Used(Num) = True

                RandomList(iIndex) = Num
                iIndex = iIndex + 1
            Next Count

            BubbleSort(RandomList)
            CreateRandomList = iNumDocs

        Catch ex As Exception
            MessageBox.Show(ex.Message, "S2xDE", MessageBoxButtons.OK, MessageBoxIcon.Information)
        End Try
    End Function
End Module