Source code for the method I used to select a random lottery winner.
Option Explicit On
Option Strict On
Imports System.Text.RegularExpressions
Imports System.Security.Cryptography
Module RandLotteryMain
Private Class DetailEntry
Implements IComparable(Of DetailEntry)
Public UserID As String
Public RandValue() As Byte
Public Sub New(ByVal UserID As String)
Me.UserID = UserID
RandValue = CType(Array.CreateInstance(GetType(Byte), 16), Byte())
End Sub
Public Function CompareTo(ByVal other As DetailEntry) As Integer Implements System.IComparable(Of DetailEntry).CompareTo
Dim n As Integer = 0
For i As Integer = 0 To RandValue.Length - 1
If n = 0 Then n = Me.RandValue(i).CompareTo(other.RandValue(i))
Next
If n = 0 Then n = String.Compare(Me.UserID, other.UserID, True)
Return n
End Function
End Class
Sub Main()
Const ItemUrl As String = "http://www.boardgamegeek.com/geeklist/52338/item/1221296#item1221296"
Const baseUrlStr As String = "http://www.boardgamegeek.com/geekrecommend.php?action=recspy&itemtype=listitem&itemid={0}"
Const BonusTrigger As Integer = 5
Const BidLimit As Integer = 0
Const DetermineMaxBidWinner As Boolean = True
Const ShowDetails As Boolean = True
Dim tmr As Diagnostics.Stopwatch = Diagnostics.Stopwatch.StartNew
Try
'instantiate random number generator
Dim RandGen As RandomNumberGenerator = RandomNumberGenerator.Create
Dim RandBuf() As Byte = CType(Array.CreateInstance(GetType(Byte), 1024), Byte())
'give it a bit of a shake
RandGen.GetBytes(RandBuf)
Dim seedCount As Integer = RandBuf(RandBuf(0))
For i As Integer = 0 To seedCount
RandGen.GetBytes(RandBuf)
Next
'find the item # in the url
Dim ItemID As Integer = -1
Dim rItem As New Regex("item/(\d+)#", RegexOptions.Compiled Or RegexOptions.IgnoreCase)
Dim mItem As Match = rItem.Match(ItemUrl)
If mItem.Success Then
ItemID = CInt(mItem.Groups(1).Value)
End If
If ItemID <= 0 Then Throw New Exception("Unable to determine ItemID from ItemURL")
'get tip info for this item
Console.WriteLine("Downloading geekgold info from:")
Console.WriteLine(" " & String.Format(baseUrlStr, ItemID))
Dim wc As New Net.WebClient
Dim s As String = wc.DownloadString(String.Format(baseUrlStr, ItemID))
'one record per tipper with total amount of tips as the value
Dim TotalTips As New Dictionary(Of String, Integer)(StringComparer.CurrentCultureIgnoreCase)
'parse the tipper info
Dim ndx As Integer = InStr(s, ">Tippers<", CompareMethod.Text)
Dim r As New Regex("<a href=""/user/[^""]+"">([^<]+)</a> ([\d\.]+)")
Dim m As Match = r.Match(s, ndx + 1)
Dim RawTotal As Integer = 0
Do While m.Success
Dim userID As String = m.Groups(1).Value
Dim tips As Integer = CInt(m.Groups(2).Value)
If TotalTips.ContainsKey(userID) = False Then
TotalTips.Add(userID, 0)
End If
TotalTips(userID) += tips
RawTotal += tips
m = r.Match(s, m.Index + 1)
Loop
If TotalTips.Count = 0 Then
Throw New Exception("Unable to find any tippers for this item; possibly the wrong item #?")
End If
'just for me. If I donated to it, tell me how much
If TotalTips.ContainsKey("oudknoei") Then
Console.WriteLine("I've personally put {0} gg into this entry", TotalTips("oudknoei"))
End If
If DetermineMaxBidWinner Then
Console.WriteLine("")
Dim BiggestTipper As String = ""
Dim BiggestTipperAmt As Integer = -1
For Each Tipper As String In TotalTips.Keys
If TotalTips(Tipper) > BiggestTipperAmt Then
BiggestTipper = Tipper
BiggestTipperAmt = TotalTips(Tipper)
End If
Next
Dim BTs As New List(Of String)
Console.WriteLine("Biggest tippers:")
For Each Tipper As String In TotalTips.Keys
If TotalTips(Tipper) = BiggestTipperAmt Then
Console.WriteLine(" {0} ({1})", Tipper, TotalTips(Tipper))
BTs.Add(Tipper)
End If
Next
If BTs.Count > 1 Then
RandGen.GetBytes(RandBuf)
Dim rn1 As ULong = BitConverter.ToUInt64(RandBuf, 0)
Dim rn2 As Integer = CInt(rn1 Mod BTs.Count)
Console.WriteLine(" High bid winner: {0} (random)", BTs(rn2))
End If
End If
Dim Details As New List(Of DetailEntry)
For Each UserID As String In TotalTips.Keys
Dim baseBid As Integer = TotalTips(UserID)
If BidLimit > 0 AndAlso baseBid > BidLimit Then baseBid = BidLimit
Dim bonus As Integer = 0
If BonusTrigger > 0 Then
bonus = baseBid \ BonusTrigger
End If
For i As Integer = 1 To baseBid + bonus
Details.Add(New DetailEntry(UserID))
Next
Next
Console.WriteLine()
Console.WriteLine("Total geekgold in this lottery: {0}", RawTotal)
Console.WriteLine("Total ""entries"" in this lottery: {0}", Details.Count)
Console.WriteLine("Number of distinct entrants: {0}", TotalTips.Count)
Console.WriteLine("")
Dim ndxBuf As Integer = -1
For ndxRand As Integer = 0 To Details.Count - 1
For i As Integer = 0 To Details(ndxRand).RandValue.Length - 1
If ndxBuf < 0 OrElse ndxBuf >= RandBuf.Length Then
RandGen.GetBytes(RandBuf)
ndxBuf = 0
End If
Details(ndxRand).RandValue(i) = RandBuf(ndxBuf)
ndxBuf += 1
Next
Next
Details.Sort() 'Sort by the random number posted with each entry
Dim Winner As String = Details(0).UserID
Dim cnt As Integer = 0
For Each item As DetailEntry In Details
If String.Compare(item.UserID, Winner, True) = 0 Then
cnt += 1 'how many virtual entries did winner have (not actual geekgold, but entries)
End If
Next
Console.WriteLine("Lottery Winner = {0}", Winner)
Console.WriteLine(" {0} chances out of {1} ({2:#,##0.00}%)", cnt, Details.Count, TotalTips(Winner) / Details.Count * 100)
If ShowDetails Then
Console.WriteLine()
For i As Integer = 0 To Details.Count - 1
Console.WriteLine("{0} = {1}", i, Details(i).UserID)
Next
End If
Console.WriteLine()
Catch ex As Exception
Console.WriteLine(ex.Message)
Console.WriteLine(ex.StackTrace)
Finally
tmr.Stop()
Console.WriteLine("Done. Runtime={0}", tmr.Elapsed)
Console.ReadLine()
End Try
End Sub
End Module