From f35bb019ccb3308936910c884b17244ae72c7b0b Mon Sep 17 00:00:00 2001 From: moosecrab Date: Mon, 24 Feb 2020 22:49:05 -0800 Subject: [PATCH] Moved the Glicko class to a separate file Removed some unused 'custom upset' code --- PepperBet/Glicko.vb | 224 +++++++++++++++++++++++++++++++++ PepperBet/PepperBet.vb | 252 +------------------------------------ PepperBet/PepperBet.vbproj | 1 + 3 files changed, 229 insertions(+), 248 deletions(-) create mode 100755 PepperBet/Glicko.vb diff --git a/PepperBet/Glicko.vb b/PepperBet/Glicko.vb new file mode 100755 index 0000000..48c0b40 --- /dev/null +++ b/PepperBet/Glicko.vb @@ -0,0 +1,224 @@ +Public Class Glicko + + 'This constant defines how RD increases over time, higher=faster + Private Const c = 0.6 + 'Minimum RD (to ensure liquidity) + Private Const RDmin = 30 + 'Defined as part of the Glicko system + Private Const q = 0.005756462732485 + + Enum Tiers + Unknown + Potato + B + A + S + X + End Enum + + Property K As Double + Private _RD As Double + Property RD As Double + Set(value As Double) + If value < RDmin Then + _RD = RDmin + Else + _RD = value + End If + End Set + Get + Return _RD + End Get + End Property + Property Name As String + Property LastMatch As Long + Property Tier As Tiers = Tiers.Unknown + ReadOnly Property TierString As String + Get + Select Case Me.Tier + Case Tiers.A + Return " A " + Case Tiers.B + Return " B " + Case Tiers.Potato + Return " P " + Case Tiers.S + Return " S" + Case Tiers.X + Return " X " + Case Tiers.Unknown + Return "U " + End Select + Return "" + End Get + End Property + ReadOnly Property TierLetter As String + Get + Select Case Me.Tier + Case Tiers.A + Return "A" + Case Tiers.B + Return "B" + Case Tiers.Potato + Return "P" + Case Tiers.S + Return "S" + Case Tiers.X + Return "X" + Case Tiers.Unknown + Return "U" + End Select + Return "" + End Get + End Property + + ''' + ''' Updates this Glicko rating after a match. MAKE SURE TO COPY THE OPPONENT BEFORE UPDATING + ''' + ''' Opponent that was faced + ''' Did this Glicko win? Draw=0.5 + ''' Match number of this match + ''' + Private Sub Update(opp() As Glicko, win() As Double, t As Long) + Dim E As Double = 0 + Dim g As Double = 0 + Dim dsum As Double = 0 + Dim rsum As Double = 0 + + For i = 0 To opp.Count - 1 + g = 1 / Math.Sqrt(1 + (3 * Math.Pow(q, 2) * Math.Pow(opp(i).RD, 2)) / Math.Pow(Math.PI, 2)) + E = 1 / (1 + Math.Pow(10, (g * (Me.K - opp(i).K)) / -400)) + dsum += Math.Pow(g, 2) * E * (1 - E) + rsum += g * (win(i) - E) + Next + + Dim dsq As Double = Math.Pow(Math.Pow(q, 2) * dsum, -1) + + Me.K = Me.K + (q / ((1 / Math.Pow(Me.RD, 2)) + (1 / dsq))) * rsum + Me.RD = Math.Max(Math.Sqrt(Math.Pow((1 / Math.Pow(Me.RD, 2)) + (1 / dsq), -1)), 30) + Me.LastMatch = t + End Sub + + Public Shared Sub UpdateBatch(a As Glicko, b As Glicko, Acount As Integer, Bcount As Integer, t As Long, Optional Dcount As Integer = 0) + Dim total As Integer = Acount + Bcount + Dcount + Dim Aresults(total - 1) As Double + Dim aopps(total - 1) As Glicko + Dim Bresults(total - 1) As Double + Dim bopps(total - 1) As Glicko + Dim upset As Boolean = False + Dim confidence As Double = Conf(a, b) + + Dim tempb As New Glicko("", -1) + tempb.K = b.K + tempb.RD = b.RD + + For i = 0 To total - 1 + aopps(i) = tempb + bopps(i) = a + Next + For i = 0 To Acount - 1 + Aresults(i) = 1 + Next + + For i = Acount To Acount + Bcount - 1 + Bresults(i) = 1 + Next + + For i = Acount + Bcount To total - 1 + Aresults(i) = 0.5 + Bresults(i) = 0.5 + Next + + If (Aresults.Average > 0.5 And b.K > a.K) Or (Bresults.Average > 0.5 And a.K > b.K) Then + upset = True + End If + + b.Update(bopps, Bresults, t) + a.Update(aopps, Aresults, t) + + 'My custom RD-increasing function in case of upsets + 'Note this increases after Glicko's decrease, so they oppose each other + 'If upset = True Then + ' 'U-factor is upset factor, the maximum possible increase in RD for a character if we trusted the results 100% accurately + ' Dim aUfactor As Double = u * a.RD * (confidence ^ e) + ' Dim bUfactor As Double = u * b.RD * (confidence ^ e) + ' 'F-factor is the fluke factor, more rounds means it's less of a fluke and we should increase more + ' Dim Ffactor As Double = 1 - (1 / (Aresults.Count + f)) + ' 'C-factor is the closeness factor, close matches are weighted less (5-0 more increase than 5-4) + ' Dim Cfactor As Double = (Math.Max(Aresults.Average, Bresults.Average) - 0.5) * 2 + ' a.RD = Math.Min(350, a.RD + (aUfactor * Ffactor * Cfactor)) + ' b.RD = Math.Min(350, b.RD + (bUfactor * Ffactor * Cfactor)) + 'End If + + + End Sub + + + + ''' + ''' Time-decays RD in preperation for a match + ''' + ''' Current match number + ''' + Public Sub Prep(t As Long) + Me.RD = Math.Min(350, Math.Sqrt(Math.Pow(Me.RD, 2) + Math.Pow(c, 2) * (t - Me.LastMatch))) + End Sub + + Public Sub New(name As String, t As Long) + Me.K = 1500 + Me.RD = 350 + Me.Name = name + Me.LastMatch = t + End Sub + + Public Function GenerateXMLItem() As XElement + Dim ret As New XElement("glicko") + ret.SetAttributeValue("name", Me.Name) + ret.SetAttributeValue("k", Me.K) + ret.SetAttributeValue("rd", Me.RD) + ret.SetAttributeValue("lastmatch", Me.LastMatch) + ret.SetAttributeValue("tier", CInt(Me.Tier)) + Return ret + End Function + + Private Shared Function erf(x As Double) As Double + 'Erf(x) approximation, max error 3e-7 + Dim a1 As Double = 0.0705230784 + Dim a2 As Double = 0.0422820123 + Dim a3 As Double = 0.0092705272 + Dim a4 As Double = 0.0001520143 + Dim a5 As Double = 0.0002765672 + Dim a6 As Double = 0.0000430638 + + a1 = a1 * x + a2 = a2 * (x ^ 2) + a3 = a3 * (x ^ 3) + a4 = a4 * (x ^ 4) + a5 = a5 * (x ^ 5) + a6 = a6 * (x ^ 6) + Return 1 - (1 / ((1 + a1 + a2 + a3 + a4 + a5 + a6) ^ 16)) + End Function + + Private Shared Function CDF(x As Double, mu As Double, sigma As Double) As Double + Return 0.5 * (1 + erf((x - mu) / (sigma * Math.Sqrt(2)))) + End Function + + Private Shared Function StdNorm(x As Double) As Double + Return Math.Exp(-0.5 * (x ^ 2)) / (Math.Sqrt(2 * Math.PI)) + End Function + + Private Shared Function Norm(x As Double, mu As Double, sigma As Double) As Double + Return (1 / sigma) * StdNorm((x - mu) / sigma) + End Function + + Public Shared Function Conf(a As Glicko, b As Glicko) As Double + Dim sum As Double + For i = 0 To 3000 Step 1 + sum += Math.Max(Norm(i, a.K, a.RD) - Norm(i, b.K, b.RD), 0) + Next + Return sum + End Function + +End Class + + diff --git a/PepperBet/PepperBet.vb b/PepperBet/PepperBet.vb index 9311ea1..b92f856 100755 --- a/PepperBet/PepperBet.vb +++ b/PepperBet/PepperBet.vb @@ -1,19 +1,7 @@ Module Pepperbet - 'This constant defines how RD increases over time, higher=faster - Const c = 0.6 - 'Minimum RD (to ensure liquidity) - Const RDmin = 30 - 'Defined as part of the Glicko system - Const q = 0.005756462732485 'Seconds between updates Const updatedelay = 2 - 'Upset RD maximum increase factor (infinite matches, as a fraction of RD) - Const u = 0.5 - 'Upset RD increase fluke-factor, more matches creates less chance of a fluke - Const f = 0.5 - 'Upset RD exponent, steepens modification curve with confidence - Const e = 1.5 Const version As String = "1.9.12" Const downloadurl As String = "https://long-cat.net/projects/pepperbet/pepperbet.exe?v=" & version Const versionurl As String = "https://long-cat.net/projects/pepperbet/version.txt?v=" & version @@ -24,6 +12,10 @@ Dim watching As Boolean = True Dim autoupdate As Boolean = False Dim lastupdatecheck As New DateTime(0) + Dim accuracies(10) As Double + 'These are the time constants for the exponentially weighted falloff + Dim accuracytimeconstants() As Double = {10, 20, 50, 100, 200, 500, 1000, 2000, 5000, 10000} + Enum ModeTypes Matchmaking Tournament @@ -888,242 +880,6 @@ End Function - Private Class Glicko - Enum Tiers - Unknown - Potato - B - A - S - X - End Enum - - Property K As Double - Private _RD As Double - Property RD As Double - Set(value As Double) - If value < RDmin Then - _RD = RDmin - Else - _RD = value - End If - End Set - Get - Return _RD - End Get - End Property - Property Name As String - Property LastMatch As Long - Property Tier As Tiers = Tiers.Unknown - ReadOnly Property TierString As String - Get - Select Case Me.Tier - Case Tiers.A - Return " A " - Case Tiers.B - Return " B " - Case Tiers.Potato - Return " P " - Case Tiers.S - Return " S" - Case Tiers.X - Return " X " - Case Tiers.Unknown - Return "U " - End Select - Return "" - End Get - End Property - ReadOnly Property TierLetter As String - Get - Select Case Me.Tier - Case Tiers.A - Return "A" - Case Tiers.B - Return "B" - Case Tiers.Potato - Return "P" - Case Tiers.S - Return "S" - Case Tiers.X - Return "X" - Case Tiers.Unknown - Return "U" - End Select - Return "" - End Get - End Property - - ''' - ''' Updates this Glicko rating after a match. MAKE SURE TO COPY THE OPPONENT BEFORE UPDATING - ''' - ''' Opponent that was faced - ''' Did this Glicko win? Draw=0.5 - ''' Match number of this match - ''' - Private Sub Update(opp() As Glicko, win() As Double, t As Long) - Dim E As Double = 0 - Dim g As Double = 0 - Dim dsum As Double = 0 - Dim rsum As Double = 0 - - For i = 0 To opp.Count - 1 - g = 1 / Math.Sqrt(1 + (3 * Math.Pow(q, 2) * Math.Pow(opp(i).RD, 2)) / Math.Pow(Math.PI, 2)) - E = 1 / (1 + Math.Pow(10, (g * (Me.K - opp(i).K)) / -400)) - dsum += Math.Pow(g, 2) * E * (1 - E) - rsum += g * (win(i) - E) - Next - - Dim dsq As Double = Math.Pow(Math.Pow(q, 2) * dsum, -1) - - Me.K = Me.K + (q / ((1 / Math.Pow(Me.RD, 2)) + (1 / dsq))) * rsum - Me.RD = Math.Max(Math.Sqrt(Math.Pow((1 / Math.Pow(Me.RD, 2)) + (1 / dsq), -1)), 30) - Me.LastMatch = t - End Sub - - Public Shared Sub UpdateBatch(a As Glicko, b As Glicko, Acount As Integer, Bcount As Integer, t As Long, Optional Dcount As Integer = 0) - Dim total As Integer = Acount + Bcount + Dcount - Dim Aresults(total - 1) As Double - Dim aopps(total - 1) As Glicko - Dim Bresults(total - 1) As Double - Dim bopps(total - 1) As Glicko - Dim upset As Boolean = False - Dim confidence As Double = Conf(a, b) - - Dim tempb As New Glicko("", -1) - tempb.K = b.K - tempb.RD = b.RD - - For i = 0 To total - 1 - aopps(i) = tempb - bopps(i) = a - Next - For i = 0 To Acount - 1 - Aresults(i) = 1 - Next - - For i = Acount To Acount + Bcount - 1 - Bresults(i) = 1 - Next - - For i = Acount + Bcount To total - 1 - Aresults(i) = 0.5 - Bresults(i) = 0.5 - Next - - If (Aresults.Average > 0.5 And b.K > a.K) Or (Bresults.Average > 0.5 And a.K > b.K) Then - upset = True - End If - - b.Update(bopps, Bresults, t) - a.Update(aopps, Aresults, t) - - 'My custom RD-increasing function in case of upsets - 'Note this increases after Glicko's decrease, so they oppose each other - 'If upset = True Then - ' 'U-factor is upset factor, the maximum possible increase in RD for a character if we trusted the results 100% accurately - ' Dim aUfactor As Double = u * a.RD * (confidence ^ e) - ' Dim bUfactor As Double = u * b.RD * (confidence ^ e) - ' 'F-factor is the fluke factor, more rounds means it's less of a fluke and we should increase more - ' Dim Ffactor As Double = 1 - (1 / (Aresults.Count + f)) - ' 'C-factor is the closeness factor, close matches are weighted less (5-0 more increase than 5-4) - ' Dim Cfactor As Double = (Math.Max(Aresults.Average, Bresults.Average) - 0.5) * 2 - ' a.RD = Math.Min(350, a.RD + (aUfactor * Ffactor * Cfactor)) - ' b.RD = Math.Min(350, b.RD + (bUfactor * Ffactor * Cfactor)) - 'End If - - - End Sub - - Public Shared Sub UpdateTiers(a As Glicko, b As Glicko) - If Now.DayOfWeek = DayOfWeek.Thursday And Now.Hour >= 18 And Now.Hour < 21 Then - 'shaker classic - Exit Sub - End If - - If a.Tier = Tiers.Unknown And b.Tier = Tiers.Unknown Then - Exit Sub - ElseIf a.Tier = Tiers.Unknown Then - a.Tier = b.Tier - ElseIf b.Tier = Tiers.Unknown Then - b.Tier = a.Tier - ElseIf b.Tier = a.Tier Then - Exit Sub - Else - a.Tier = Tiers.Unknown - b.Tier = Tiers.Unknown - - End If - Save() - End Sub - - - ''' - ''' Time-decays RD in preperation for a match - ''' - ''' Current match number - ''' - Public Sub Prep(t As Long) - Me.RD = Math.Min(350, Math.Sqrt(Math.Pow(Me.RD, 2) + Math.Pow(c, 2) * (t - Me.LastMatch))) - End Sub - - Public Sub New(name As String, t As Long) - Me.K = 1500 - Me.RD = 350 - Me.Name = name - Me.LastMatch = t - End Sub - - Public Function GenerateXMLItem() As XElement - Dim ret As New XElement("glicko") - ret.SetAttributeValue("name", Me.Name) - ret.SetAttributeValue("k", Me.K) - ret.SetAttributeValue("rd", Me.RD) - ret.SetAttributeValue("lastmatch", Me.LastMatch) - ret.SetAttributeValue("tier", CInt(Me.Tier)) - Return ret - End Function - - Private Shared Function erf(x As Double) As Double - 'Erf(x) approximation, max error 3e-7 - Dim a1 As Double = 0.0705230784 - Dim a2 As Double = 0.0422820123 - Dim a3 As Double = 0.0092705272 - Dim a4 As Double = 0.0001520143 - Dim a5 As Double = 0.0002765672 - Dim a6 As Double = 0.0000430638 - - a1 = a1 * x - a2 = a2 * (x ^ 2) - a3 = a3 * (x ^ 3) - a4 = a4 * (x ^ 4) - a5 = a5 * (x ^ 5) - a6 = a6 * (x ^ 6) - Return 1 - (1 / ((1 + a1 + a2 + a3 + a4 + a5 + a6) ^ 16)) - End Function - - Private Shared Function CDF(x As Double, mu As Double, sigma As Double) As Double - Return 0.5 * (1 + erf((x - mu) / (sigma * Math.Sqrt(2)))) - End Function - - Private Shared Function StdNorm(x As Double) As Double - Return Math.Exp(-0.5 * (x ^ 2)) / (Math.Sqrt(2 * Math.PI)) - End Function - - Private Shared Function Norm(x As Double, mu As Double, sigma As Double) As Double - Return (1 / sigma) * StdNorm((x - mu) / sigma) - End Function - - Public Shared Function Conf(a As Glicko, b As Glicko) As Double - Dim sum As Double - For i = 0 To 3000 Step 1 - sum += Math.Max(Norm(i, a.K, a.RD) - Norm(i, b.K, b.RD), 0) - Next - Return sum - End Function - - End Class - Private Sub Save() Dim thr As New Threading.Thread(AddressOf SaveDelegate) thr.Start() diff --git a/PepperBet/PepperBet.vbproj b/PepperBet/PepperBet.vbproj index a760851..85481e5 100755 --- a/PepperBet/PepperBet.vbproj +++ b/PepperBet/PepperBet.vbproj @@ -97,6 +97,7 @@ +