Compare commits

..

8 Commits

11 changed files with 17288 additions and 262 deletions

74
GlickoTest/GlickoTest.vb Executable file
View File

@ -0,0 +1,74 @@
Imports System.Xml.Linq
Imports Microsoft.VisualStudio.TestTools.UnitTesting
Imports System.Text
Imports PepperBet
<TestClass()>
Public Class GlickoTest
Private testContextInstance As TestContext
'''<summary>
'''Gets or sets the test context which provides
'''information about and functionality for the current test run.
'''</summary>
Public Property TestContext() As TestContext
Get
Return testContextInstance
End Get
Set(ByVal value As TestContext)
testContextInstance = value
End Set
End Property
#Region "Additional test attributes"
'
' You can use the following additional attributes as you write your tests:
'
' Use ClassInitialize to run code before running the first test in the class
' <ClassInitialize()> Public Shared Sub MyClassInitialize(ByVal testContext As TestContext)
' End Sub
'
' Use ClassCleanup to run code after all tests in a class have run
' <ClassCleanup()> Public Shared Sub MyClassCleanup()
' End Sub
'
' Use TestInitialize to run code before running each test
' <TestInitialize()> Public Sub MyTestInitialize()
' End Sub
'
' Use TestCleanup to run code after each test has run
' <TestCleanup()> Public Sub MyTestCleanup()
' End Sub
'
#End Region
<TestMethod()>
Public Sub TestGlickoMatchup()
Dim testman As New Glicko("testman", 0)
testman.K = 1500
testman.RD = 200
Dim opp1 As New Glicko("1", 0)
opp1.K = 1400
opp1.RD = 30
Dim opp2 As New Glicko("2", 0)
opp2.K = 1550
opp2.RD = 100
Dim opp3 As New Glicko("3", 0)
opp3.K = 1700
opp3.RD = 300
'testman.Update({opp1, opp2, opp3}, {1, 0, 0}, 0)
Glicko.UpdateBatch(testman, opp1, 1, 0, 0)
Glicko.UpdateBatch(testman, opp2, 0, 1, 0)
Glicko.UpdateBatch(testman, opp3, 0, 1, 0)
'testmans K should be 1464 and RD should be 151.4
Assert.AreEqual(testman.K, 1464.2190389663426)
Assert.AreEqual(testman.RD, 151.2537434317843)
End Sub
End Class

98
GlickoTest/GlickoTest.vbproj Executable file
View File

@ -0,0 +1,98 @@
<?xml version="1.0" encoding="utf-8"?>
<Project ToolsVersion="4.0" DefaultTargets="Build" xmlns="http://schemas.microsoft.com/developer/msbuild/2003">
<PropertyGroup>
<Configuration Condition=" '$(Configuration)' == '' ">Debug</Configuration>
<Platform Condition=" '$(Platform)' == '' ">AnyCPU</Platform>
<ProductVersion>
</ProductVersion>
<SchemaVersion>
</SchemaVersion>
<ProjectGuid>{E6794089-F810-402B-A3CE-0D7EA579108A}</ProjectGuid>
<OutputType>Library</OutputType>
<RootNamespace>GlickoTest</RootNamespace>
<AssemblyName>GlickoTest</AssemblyName>
<FileAlignment>512</FileAlignment>
<MyType>Windows</MyType>
<TargetFrameworkVersion>v4.0</TargetFrameworkVersion>
<ProjectTypeGuids>{3AC096D0-A1C2-E12C-1390-A8335801FDAB};{F184B08F-C81C-45F6-A57F-5ABD9991F28F}</ProjectTypeGuids>
<ReferencePath>$(DevEnvDir)PublicAssemblies\</ReferencePath>
</PropertyGroup>
<PropertyGroup Condition=" '$(Configuration)|$(Platform)' == 'Debug|AnyCPU' ">
<DebugSymbols>true</DebugSymbols>
<DebugType>full</DebugType>
<DefineDebug>true</DefineDebug>
<DefineTrace>true</DefineTrace>
<OutputPath>bin\Debug\</OutputPath>
<DocumentationFile>GlickoTest.xml</DocumentationFile>
<NoWarn>42016,41999,42017,42018,42019,42032,42036,42020,42021,42022</NoWarn>
</PropertyGroup>
<PropertyGroup Condition=" '$(Configuration)|$(Platform)' == 'Release|AnyCPU' ">
<DebugType>pdbonly</DebugType>
<DefineDebug>false</DefineDebug>
<DefineTrace>true</DefineTrace>
<Optimize>true</Optimize>
<OutputPath>bin\Release\</OutputPath>
<DocumentationFile>GlickoTest.xml</DocumentationFile>
<NoWarn>42016,41999,42017,42018,42019,42032,42036,42020,42021,42022</NoWarn>
</PropertyGroup>
<PropertyGroup>
<OptionExplicit>On</OptionExplicit>
</PropertyGroup>
<PropertyGroup>
<OptionCompare>Binary</OptionCompare>
</PropertyGroup>
<PropertyGroup>
<OptionStrict>Off</OptionStrict>
</PropertyGroup>
<PropertyGroup>
<OptionInfer>On</OptionInfer>
</PropertyGroup>
<ItemGroup>
<Reference Include="Microsoft.VisualStudio.QualityTools.UnitTestFramework, Version=10.0.0.0, Culture=neutral, PublicKeyToken=b03f5f7f11d50a3a, processorArchitecture=MSIL" />
<Reference Include="Newtonsoft.Json, Version=4.5.0.0, Culture=neutral, PublicKeyToken=30ad4fe6b2a6aeed, processorArchitecture=MSIL" />
<Reference Include="System" />
<Reference Include="System.Core">
<RequiredTargetFramework>3.5</RequiredTargetFramework>
</Reference>
<Reference Include="System.Data" />
<Reference Include="System.Data.DataSetExtensions" />
<Reference Include="System.Deployment" />
<Reference Include="System.Windows.Forms" />
<Reference Include="System.Xml" />
<Reference Include="System.Xml.Linq" />
</ItemGroup>
<ItemGroup>
<Import Include="System" />
<Import Include="System.Collections" />
<Import Include="System.Collections.Generic" />
<Import Include="System.Data" />
<Import Include="System.Diagnostics" />
<Import Include="System.Linq" />
<Import Include="System.Xml.Linq" />
<Import Include="Microsoft.VisualBasic" />
<Import Include="Microsoft.VisualStudio.TestTools.UnitTesting" />
</ItemGroup>
<ItemGroup>
<CodeAnalysisDependentAssemblyPaths Condition=" '$(VS100COMNTOOLS)' != '' " Include="$(VS100COMNTOOLS)..\IDE\PrivateAssemblies">
<Visible>False</Visible>
</CodeAnalysisDependentAssemblyPaths>
</ItemGroup>
<ItemGroup>
<Compile Include="My Project\AssemblyInfo.vb" />
<Compile Include="GlickoTest.vb" />
</ItemGroup>
<ItemGroup>
<ProjectReference Include="..\PepperBet\PepperBet.vbproj">
<Project>{F88AA82A-320E-4A3B-87A3-C07BFC6F3450}</Project>
<Name>PepperBet</Name>
</ProjectReference>
</ItemGroup>
<Import Project="$(MSBuildBinPath)\Microsoft.VisualBasic.targets" />
<!-- To modify your build process, add your task inside one of the targets below and uncomment it.
Other similar extension points exist, see Microsoft.Common.targets.
<Target Name="BeforeBuild">
</Target>
<Target Name="AfterBuild">
</Target>
-->
</Project>

View File

@ -0,0 +1,37 @@
Imports System
Imports System.Reflection
Imports System.Runtime.InteropServices
' General Information about an assembly is controlled through the following
' set of attributes. Change these attribute values to modify the information
' associated with an assembly.
' Review the values of the assembly attributes
<Assembly: AssemblyTitle("GlickoTest")>
<Assembly: AssemblyDescription("")>
<Assembly: AssemblyCompany("")>
<Assembly: AssemblyProduct("GlickoTest")>
<Assembly: AssemblyCopyright("Copyright © 2020")>
<Assembly: AssemblyTrademark("")>
<Assembly: CLSCompliant(True)>
<Assembly: ComVisible(False)>
'The following GUID is for the ID of the typelib if this project is exposed to COM
<Assembly: Guid("7116de55-d866-4034-9286-a8df9d2a8826")>
' Version information for an assembly consists of the following four values:
'
' Major Version
' Minor Version
' Build Number
' Revision
'
' You can specify all the values or you can default the Build and Revision Numbers
' by using the '*' as shown below:
' <Assembly: AssemblyVersion("1.0.*")>
<Assembly: AssemblyVersion("1.0.0.0")>
<Assembly: AssemblyFileVersion("1.0.0.0")>

View File

@ -5,7 +5,14 @@ Project("{F184B08F-C81C-45F6-A57F-5ABD9991F28F}") = "PepperBet", "PepperBet\Pepp
EndProject EndProject
Project("{F184B08F-C81C-45F6-A57F-5ABD9991F28F}") = "AutoUpdater", "AutoUpdater\AutoUpdater.vbproj", "{1E99431F-65AD-4CFD-9A8A-264CED54DAEB}" Project("{F184B08F-C81C-45F6-A57F-5ABD9991F28F}") = "AutoUpdater", "AutoUpdater\AutoUpdater.vbproj", "{1E99431F-65AD-4CFD-9A8A-264CED54DAEB}"
EndProject EndProject
Project("{F184B08F-C81C-45F6-A57F-5ABD9991F28F}") = "GlickoTest", "GlickoTest\GlickoTest.vbproj", "{E6794089-F810-402B-A3CE-0D7EA579108A}"
EndProject
Project("{2150E333-8FDC-42A3-9474-1A3956D46DE8}") = "Solution Items", "Solution Items", "{F59519B4-43BD-4F38-A7AB-8694B5014CB2}"
EndProject
Global Global
GlobalSection(TestCaseManagementSettings) = postSolution
CategoryFile = PepperBet.vsmdi
EndGlobalSection
GlobalSection(SolutionConfigurationPlatforms) = preSolution GlobalSection(SolutionConfigurationPlatforms) = preSolution
Debug|Any CPU = Debug|Any CPU Debug|Any CPU = Debug|Any CPU
Debug|x86 = Debug|x86 Debug|x86 = Debug|x86
@ -13,10 +20,12 @@ Global
Release|x86 = Release|x86 Release|x86 = Release|x86
EndGlobalSection EndGlobalSection
GlobalSection(ProjectConfigurationPlatforms) = postSolution GlobalSection(ProjectConfigurationPlatforms) = postSolution
{F88AA82A-320E-4A3B-87A3-C07BFC6F3450}.Debug|Any CPU.ActiveCfg = Debug|x86 {F88AA82A-320E-4A3B-87A3-C07BFC6F3450}.Debug|Any CPU.ActiveCfg = Debug|Any CPU
{F88AA82A-320E-4A3B-87A3-C07BFC6F3450}.Debug|Any CPU.Build.0 = Debug|Any CPU
{F88AA82A-320E-4A3B-87A3-C07BFC6F3450}.Debug|x86.ActiveCfg = Debug|x86 {F88AA82A-320E-4A3B-87A3-C07BFC6F3450}.Debug|x86.ActiveCfg = Debug|x86
{F88AA82A-320E-4A3B-87A3-C07BFC6F3450}.Debug|x86.Build.0 = Debug|x86 {F88AA82A-320E-4A3B-87A3-C07BFC6F3450}.Debug|x86.Build.0 = Debug|x86
{F88AA82A-320E-4A3B-87A3-C07BFC6F3450}.Release|Any CPU.ActiveCfg = Release|x86 {F88AA82A-320E-4A3B-87A3-C07BFC6F3450}.Release|Any CPU.ActiveCfg = Release|Any CPU
{F88AA82A-320E-4A3B-87A3-C07BFC6F3450}.Release|Any CPU.Build.0 = Release|Any CPU
{F88AA82A-320E-4A3B-87A3-C07BFC6F3450}.Release|x86.ActiveCfg = Release|x86 {F88AA82A-320E-4A3B-87A3-C07BFC6F3450}.Release|x86.ActiveCfg = Release|x86
{F88AA82A-320E-4A3B-87A3-C07BFC6F3450}.Release|x86.Build.0 = Release|x86 {F88AA82A-320E-4A3B-87A3-C07BFC6F3450}.Release|x86.Build.0 = Release|x86
{1E99431F-65AD-4CFD-9A8A-264CED54DAEB}.Debug|Any CPU.ActiveCfg = Debug|Any CPU {1E99431F-65AD-4CFD-9A8A-264CED54DAEB}.Debug|Any CPU.ActiveCfg = Debug|Any CPU
@ -27,6 +36,11 @@ Global
{1E99431F-65AD-4CFD-9A8A-264CED54DAEB}.Release|Any CPU.Build.0 = Release|Any CPU {1E99431F-65AD-4CFD-9A8A-264CED54DAEB}.Release|Any CPU.Build.0 = Release|Any CPU
{1E99431F-65AD-4CFD-9A8A-264CED54DAEB}.Release|x86.ActiveCfg = Release|x86 {1E99431F-65AD-4CFD-9A8A-264CED54DAEB}.Release|x86.ActiveCfg = Release|x86
{1E99431F-65AD-4CFD-9A8A-264CED54DAEB}.Release|x86.Build.0 = Release|x86 {1E99431F-65AD-4CFD-9A8A-264CED54DAEB}.Release|x86.Build.0 = Release|x86
{E6794089-F810-402B-A3CE-0D7EA579108A}.Debug|Any CPU.ActiveCfg = Debug|Any CPU
{E6794089-F810-402B-A3CE-0D7EA579108A}.Debug|Any CPU.Build.0 = Debug|Any CPU
{E6794089-F810-402B-A3CE-0D7EA579108A}.Debug|x86.ActiveCfg = Debug|Any CPU
{E6794089-F810-402B-A3CE-0D7EA579108A}.Release|Any CPU.ActiveCfg = Release|Any CPU
{E6794089-F810-402B-A3CE-0D7EA579108A}.Release|x86.ActiveCfg = Release|Any CPU
EndGlobalSection EndGlobalSection
GlobalSection(SolutionProperties) = preSolution GlobalSection(SolutionProperties) = preSolution
HideSolutionNode = FALSE HideSolutionNode = FALSE

224
PepperBet/Glicko.vb Executable file
View File

@ -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
''' <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

View File

@ -1,28 +1,21 @@
Module Pepperbet 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 'Seconds between updates
Const updatedelay = 2 Const updatedelay = 2
'Upset RD maximum increase factor (infinite matches, as a fraction of RD) Const version As String = "1.12"
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 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 Const versionurl As String = "https://long-cat.net/projects/pepperbet/version.txt?v=" & version
Const dbfilename As String = "pepperdata.xml"
Dim TheList As New List(Of Glicko) Dim TheList As New List(Of Glicko)
Dim match As Long = 0 Dim match As Long = 0
Dim names As New List(Of String) Dim names As New List(Of String)
Dim watching As Boolean = True Dim watching As Boolean = True
Dim autoupdate As Boolean = False Dim autoupdate As Boolean = False
Dim lastupdatecheck As New DateTime(0) Dim lastupdatecheck As New DateTime(0)
Dim accuracies(9) 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 Enum ModeTypes
Matchmaking Matchmaking
Tournament Tournament
@ -96,12 +89,12 @@
Console.ForegroundColor = ConsoleColor.White Console.ForegroundColor = ConsoleColor.White
Console.WriteLine(" ╟──────────────────────────────") Console.WriteLine(" ╟──────────────────────────────")
'DONT FORGET TO CHANGE IT UP IN THE CONST 'DONT FORGET TO CHANGE IT UP IN THE CONST
Console.WriteLine("──────────────────────────────╢ v" & version & " ╟──────────────────────────────") Console.WriteLine("──────────────────────────────╢ v" & version & " ╟──────────────────────────────")
'DONT FORGET TO CHANGE IT UP IN THE CONST 'DONT FORGET TO CHANGE IT UP IN THE CONST
Console.WriteLine(" ╚════════════════╝") Console.WriteLine(" ╚════════════════╝")
Console.WriteLine() Console.WriteLine()
Console.ForegroundColor = ConsoleColor.Gray Console.ForegroundColor = ConsoleColor.Gray
Console.WriteLine("(C) 2013-2018 by moose crap http://long-cat.net") Console.WriteLine("(c) 2013-2020 by moose crap http://long-cat.net")
Console.WriteLine("Thanks to Fredstonemason for help and testing") Console.WriteLine("Thanks to Fredstonemason for help and testing")
Console.WriteLine() Console.WriteLine()
helpstring() helpstring()
@ -111,7 +104,7 @@
If autoupdate Then If autoupdate Then
CheckForUpdates() CheckForUpdates()
End If End If
Console.WriteLine("{0} fighters loaded from data.xml.", TheList.Count) Console.WriteLine("{0} fighters loaded from " & dbfilename & ".", TheList.Count)
If names.Count > 0 Then If names.Count > 0 Then
Console.Write("Watching: ") Console.Write("Watching: ")
For Each x In names For Each x In names
@ -123,7 +116,7 @@
While xdoc Is Nothing While xdoc Is Nothing
Try Try
xdoc = Newtonsoft.Json.JsonConvert.DeserializeXmlNode(wc.DownloadString("http://www.saltybet.com/state.json"), "saltybet") xdoc = Newtonsoft.Json.JsonConvert.DeserializeXmlNode(wc.DownloadString("https://www.saltybet.com/state.json"), "saltybet")
Catch ex As Exception Catch ex As Exception
xdoc = Nothing xdoc = Nothing
System.Threading.Thread.Sleep(1500) System.Threading.Thread.Sleep(1500)
@ -137,7 +130,7 @@
If Not bootstrap Then 'dont reload state.json if we're in bootstrap mode If Not bootstrap Then 'dont reload state.json if we're in bootstrap mode
Try Try
xdoc = Newtonsoft.Json.JsonConvert.DeserializeXmlNode(wc.DownloadString("http://www.saltybet.com/state.json"), "saltybet") xdoc = Newtonsoft.Json.JsonConvert.DeserializeXmlNode(wc.DownloadString("https://www.saltybet.com/state.json"), "saltybet")
Catch ex As Exception Catch ex As Exception
xdoc = Nothing xdoc = Nothing
End Try End Try
@ -440,6 +433,14 @@
Console.Write("Automatic updates disabled") Console.Write("Automatic updates disabled")
End If End If
Console.CursorLeft = 0 Console.CursorLeft = 0
ElseIf tempkey.Key = ConsoleKey.R Then
Console.ForegroundColor = ConsoleColor.Gray
Console.BackgroundColor = ConsoleColor.Black
Console.WriteLine("Prediction accuracy")
For i = 0 To accuracies.Length - 1
Console.WriteLine("{0,5}: {1:0.000000}", accuracytimeconstants(i), accuracies(i))
Next
ElseIf tempkey.Key = ConsoleKey.C Then ElseIf tempkey.Key = ConsoleKey.C Then
Console.ForegroundColor = ConsoleColor.Gray Console.ForegroundColor = ConsoleColor.Gray
Console.BackgroundColor = ConsoleColor.Black Console.BackgroundColor = ConsoleColor.Black
@ -448,7 +449,7 @@
Dim rcount As Integer = 0 Dim rcount As Integer = 0
Dim j As Integer = 0 Dim j As Integer = 0
While j < TheList.Count While j < TheList.Count
If TheList(j).RD = 350 OrElse TheList(j).RD = 290.230506091092 OrElse TheList(j).K = 1500 OrElse TheList(j).K = 1662.2120026057642 OrElse TheList(j).K = 1337.7879973942358 OrElse (((match - TheList(j).LastMatch) > 60000) And (TheList(j).RD > 250)) Then If TheList(j).RD = 350 OrElse TheList(j).RD = 290.230506091092 OrElse TheList(j).K = 1500 OrElse TheList(j).K = 1662.2120026057642 OrElse TheList(j).K = 1337.7879973942358 Then
TheList.RemoveAt(j) TheList.RemoveAt(j)
rcount += 1 rcount += 1
Else Else
@ -633,6 +634,11 @@
If remaining <> "" Then If remaining <> "" Then
titlestr &= remaining titlestr &= remaining
End If End If
titlestr &= accuracies(0).ToString(" 0.000")
titlestr &= accuracies(3).ToString(" 0.000")
titlestr &= accuracies(6).ToString(" 0.000")
Console.Title = titlestr Console.Title = titlestr
End Sub End Sub
@ -654,7 +660,7 @@
End If End If
End While End While
If qstr = "" Then If qstr = "" Then
found = False found = False
@ -688,6 +694,14 @@
Dim p1rdi As Double = p1.RD Dim p1rdi As Double = p1.RD
Dim p2rdi As Double = p2.RD Dim p2rdi As Double = p2.RD
Dim result As Integer 'red, blue, draw Dim result As Integer 'red, blue, draw
Dim expectedresult As Integer
If p1ki > p2ki Then
expectedresult = 1
ElseIf p2ki > p1ki Then
expectedresult = 2
Else
expectedresult = 3
End If
Console.ForegroundColor = ConsoleColor.Gray Console.ForegroundColor = ConsoleColor.Gray
Console.BackgroundColor = ConsoleColor.Black Console.BackgroundColor = ConsoleColor.Black
If scorestr = "" Then If scorestr = "" Then
@ -806,6 +820,19 @@
Console.Write("{0,4:+###;-###;0}", p2.RD - p2rdi) Console.Write("{0,4:+###;-###;0}", p2.RD - p2rdi)
Console.ForegroundColor = ConsoleColor.Gray Console.ForegroundColor = ConsoleColor.Gray
Console.Write(")" + vbCrLf) Console.Write(")" + vbCrLf)
' Update prediction accuracies
Dim correct As Integer
If result = expectedresult Then
correct = 1
Else
correct = 0
End If
For i = 0 To accuracytimeconstants.Length - 1
Dim exp As Double = Math.Exp(1 / accuracytimeconstants(i))
accuracies(i) = accuracies(i) * (2 - exp) + correct * (exp - 1)
Next
End Sub End Sub
Private Sub DoMatchup(p1 As Glicko, p2 As Glicko, invcolors As Boolean, Optional skip As Boolean = False) Private Sub DoMatchup(p1 As Glicko, p2 As Glicko, invcolors As Boolean, Optional skip As Boolean = False)
@ -887,242 +914,6 @@
End Function 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
''' <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
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
''' <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
Private Sub Save() Private Sub Save()
Dim thr As New Threading.Thread(AddressOf SaveDelegate) Dim thr As New Threading.Thread(AddressOf SaveDelegate)
thr.Start() thr.Start()
@ -1141,29 +932,41 @@
Next Next
xd.Add(New XElement("watching", watching.ToString)) xd.Add(New XElement("watching", watching.ToString))
xd.Add(New XElement("autoupdate", autoupdate.ToString)) xd.Add(New XElement("autoupdate", autoupdate.ToString))
xd.Save("data.xml") For i = 0 To accuracies.Length - 1
xd.Add(New XElement("accuracy" & accuracytimeconstants(i), CStr(accuracies(i))))
Next
xd.Save(dbfilename)
End Sub End Sub
Private Sub Load() Private Sub Load()
If Not FileIO.FileSystem.FileExists("data.xml") Then If Not FileIO.FileSystem.FileExists(dbfilename) Then
Exit Sub Exit Sub
End If End If
Dim xd As New XDocument Dim xd As New XDocument
xd = XDocument.Load("data.xml") xd = XDocument.Load(dbfilename)
match = CLng(xd.<PepperBet>.<count>.First.Value) match = CLng(xd.<PepperBet>.<count>.First.Value)
For Each x In xd.<PepperBet>.<name> For Each x In xd.<PepperBet>.<name>
names.Add(x.Value) names.Add(x.Value)
Next Next
Try Try
watching = CBool(xd.<PepperBet>.<watching>.Value) watching = CBool(xd.<PepperBet>.<watching>.Value)
Catch Catch
End Try End Try
Try Try
autoupdate = CBool(xd.<PepperBet>.<autoupdate>.Value) autoupdate = CBool(xd.<PepperBet>.<autoupdate>.Value)
Catch Catch
End Try End Try
Try
For i = 0 To accuracies.Length - 1
accuracies(i) = CDbl(xd.Root.Element("accuracy" & accuracytimeconstants(i)).Value)
Next
Catch
End Try
For Each x In xd.<PepperBet>.<glicko> For Each x In xd.<PepperBet>.<glicko>
Dim temp As New Glicko(x.@name, CLng(x.@lastmatch)) Dim temp As New Glicko(x.@name, CLng(x.@lastmatch))
temp.K = CDbl(x.@k) temp.K = CDbl(x.@k)
@ -1244,6 +1047,7 @@
Console.WriteLine("[Enter/Esc] Enter/exit manual data entry") Console.WriteLine("[Enter/Esc] Enter/exit manual data entry")
Console.WriteLine("[Q]uery database") Console.WriteLine("[Q]uery database")
Console.WriteLine("[C]leanup database") Console.WriteLine("[C]leanup database")
Console.WriteLine("[R]eport accuracy")
Console.WriteLine("[N]ames (for bet watching)") Console.WriteLine("[N]ames (for bet watching)")
Console.WriteLine("[W]atch display toggle") Console.WriteLine("[W]atch display toggle")
Console.WriteLine("[A]utomatic updates toggle") Console.WriteLine("[A]utomatic updates toggle")

View File

@ -49,6 +49,28 @@
<PropertyGroup> <PropertyGroup>
<OptionInfer>On</OptionInfer> <OptionInfer>On</OptionInfer>
</PropertyGroup> </PropertyGroup>
<PropertyGroup Condition="'$(Configuration)|$(Platform)' == 'Debug|AnyCPU'">
<DebugSymbols>true</DebugSymbols>
<DefineDebug>true</DefineDebug>
<DefineTrace>true</DefineTrace>
<OutputPath>bin\Debug\</OutputPath>
<DocumentationFile>PepperBet.xml</DocumentationFile>
<NoWarn>42016,41999,42017,42018,42019,42032,42036,42020,42021,42022</NoWarn>
<DebugType>full</DebugType>
<PlatformTarget>AnyCPU</PlatformTarget>
<CodeAnalysisFailOnMissingRules>false</CodeAnalysisFailOnMissingRules>
</PropertyGroup>
<PropertyGroup Condition="'$(Configuration)|$(Platform)' == 'Release|AnyCPU'">
<DefineTrace>true</DefineTrace>
<OutputPath>bin\Release\</OutputPath>
<DocumentationFile>PepperBet.xml</DocumentationFile>
<Optimize>true</Optimize>
<NoWarn>42016,41999,42017,42018,42019,42032,42036,42020,42021,42022</NoWarn>
<DebugType>pdbonly</DebugType>
<PlatformTarget>AnyCPU</PlatformTarget>
<CodeAnalysisIgnoreBuiltInRuleSets>false</CodeAnalysisIgnoreBuiltInRuleSets>
<CodeAnalysisIgnoreBuiltInRules>false</CodeAnalysisIgnoreBuiltInRules>
</PropertyGroup>
<ItemGroup> <ItemGroup>
<Reference Include="Newtonsoft.Json, Version=4.5.0.0, Culture=neutral, PublicKeyToken=30ad4fe6b2a6aeed, processorArchitecture=MSIL"> <Reference Include="Newtonsoft.Json, Version=4.5.0.0, Culture=neutral, PublicKeyToken=30ad4fe6b2a6aeed, processorArchitecture=MSIL">
<SpecificVersion>False</SpecificVersion> <SpecificVersion>False</SpecificVersion>
@ -75,6 +97,7 @@
<Import Include="System.Xml.Linq" /> <Import Include="System.Xml.Linq" />
</ItemGroup> </ItemGroup>
<ItemGroup> <ItemGroup>
<Compile Include="Glicko.vb" />
<Compile Include="PepperBet.vb" /> <Compile Include="PepperBet.vb" />
<Compile Include="My Project\AssemblyInfo.vb" /> <Compile Include="My Project\AssemblyInfo.vb" />
<Compile Include="My Project\Application.Designer.vb"> <Compile Include="My Project\Application.Designer.vb">

View File

@ -1 +1 @@
1.9.12 1.10

5323
doc/pepperdata-example.xml Executable file

File diff suppressed because it is too large Load Diff

11429
doc/pepperdata-live.xml Executable file

File diff suppressed because it is too large Load Diff

BIN
lib/Newtonsoft.Json.pdb Executable file

Binary file not shown.