PepperBet/PepperBet/Glicko.vb

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

    ''' <summary>
    ''' Updates this Glicko rating after a match.  MAKE SURE TO COPY THE OPPONENT BEFORE UPDATING
    ''' </summary>
    ''' <param name="opp">Opponent that was faced</param>
    ''' <param name="win">Did this Glicko win?  Draw=0.5</param>
    ''' <param name="t">Match number of this match</param>
    ''' <remarks></remarks>
    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



    ''' <summary>
    ''' Time-decays RD in preperation for a match
    ''' </summary>
    ''' <param name="t">Current match number</param>
    ''' <remarks></remarks>
    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