- Home
- Premium Memberships
- Lottery Results
- Forums
- Predictions
- Lottery Post Videos
- News
- Search Drawings
- Search Lottery Post
- Lottery Systems
- Lottery Charts
- Lottery Wheels
- Worldwide Jackpots
- Quick Picks
- On This Day in History
- Blogs
- Online Games
- Premium Features
- Contact Us
- Whitelist Lottery Post
- Rules
- Lottery Book Store
- Lottery Post Gift Shop
The time is now 2:29 am
You last visited
April 20, 2024, 2:18 am
All times shown are
Eastern Time (GMT-5:00)
VB Program to see Number Frequencies for KenoPrev TopicNext Topic
-
I'm not a fan of picking numbers by how frequent a set of numbers has appeared in the past, especially with Keno games. But after having spent some time on this board there seem to be a lot of people who like picking numbers that way.
I had some extra time while I'm waiting for some other data to process so I thought I would try my hand at writing something to dynamically track all combinations of numbers without having to keep massive amounts of historical data for every combination of numbers.
Unfortunately there are some memory limits that I still have to work around, but for now it can track up to 7 digits out of an 80 digit pool of numbers and would work on the P5 andP6 games as well.
In this example I tracked the to 20 pairs of digits that appeared in the last 365 drawings. As you can see it processed all of the drawings in less than a minute.
Here is another example looking at 6 digits and it took just about 2 minutes to run.
The drawing data is stored in my database using this format:
Here is the code that I used to build it:
Private Sub See_Number_Freq()
tblNumSet.Clear()
bsTotals.Sort = ""
bsTotals.DataSource = ""
bsTotals.DataSource = tblNumSet
dgvTotals.DataSource = ""
dgvTotals.DataSource = bsTotals
bsTotals.Sort = "Ranking"
Dim TargetDigits As Byte = tbCondition1.Text
Dim TopX As Integer = tbCondition2.Text
If TargetDigits > 7 Then
MsgBox("Digits cannot exceed 7", MsgBoxStyle.Critical, "Too many digits.")
Exit Sub
End If
Dim tblTracker As New dsWork.tblNumSetDataTable
Dim StartDrwing As Integer = tbStartDrwing.Text
Dim EndDrwing As Integer = StartDrwing + CInt(tbDrwings.Text) - 1
Dim Cntr As Integer = 0
Dim BreakCntr As Integer = 0
Dim DYS As Integer = 0
Application.DoEvents()
Dim MinHits As Integer = 0
Dim Combos As New clNumUtilities(WinDigits, TargetDigits)
Dim NumConv As New clNumberConversion()
NumConv.PID_For_Seq_Nums_Initialize(NumBase, TargetDigits)
NumConv.Calc_Permutations(NumBase, TargetDigits)
Dim BlockSize As Long = 2400000
Dim BlockCount As Integer = NumConv.Get_Increment_Multiplier(NumConv.TotalCombos, BlockSize)
Dim NumSets(BlockCount) As ClNumSetBlocks
For DC = 1 To BlockCount
NumSets(DC) = New ClNumSetBlocks(BlockSize)
Application.DoEvents()
Next
MasterDrwings.Load_tblDrawings(StartDrwing, EndDrwing)
Dim Interval As New clIntervalTimer
For Each DrwingRW As dsWork.tblDrawingsRow In MasterDrwings.tblDrawings
MasterDrwings.Load_NumData(DrwingRW.Drwing, DrwingRW.Drwing)
For Each WinRW As DataRow In MasterDrwings.tblWinNums.Rows
For DC = 1 To WinDigits
Dim N0 As Byte = WinRW("N" & DC)
Combos.Add_Num(DC, N0)
Next
For PID = 1 To Combos.TotalCombos
Dim NumStr As String = ""
For DC = 1 To TargetDigits
Dim N0 As Byte = Combos.Combos_Seq_Next_DigitByNums(DC, PID)
NumConv.Set_Num(DC, N0)
NumStr = NumStr & "," & N0
Next
Dim ID As Long = NumConv.Calc_PID_For_Seq_Nums
Dim BlockID As Integer = NumConv.Get_Increment_Multiplier(ID, BlockSize)
Dim TrackID As Integer = ID - (BlockSize * (BlockID - 1))
NumSets(BlockID).Process_Drwing(DrwingRW.Drwing, TrackID)
Dim Hits As Integer = NumSets(BlockID).Get_Num_Set_Hits(TrackID)
Dim NumRW As dsWork.tblNumSetRow = tblTracker.FindByBlockIDTrackID(BlockID, TrackID)
Dim DataUpdate As Boolean = False
If NumRW IsNot Nothing Then
NumRW.Hits = Hits
NumRW.LastDrwing = DrwingRW.Drwing
DataUpdate = True
ElseIf Hits > MinHits Or tblTracker.Rows.Count < TopX Then
NumStr = NumStr.Substring(1)
tblTracker.AddtblNumSetRow(0, NumStr, Hits, NumSets(BlockID).Get_Num_Set_FirstDrwing(TrackID), NumSets(BlockID).Get_Num_Set_LastDrwing(TrackID), BlockID, TrackID)
DataUpdate = True
End If
If DataUpdate Then
Dim DeleteRows As New List(Of dsWork.tblNumSetRow)
Dim Sorted() As dsWork.tblNumSetRow = tblTracker.Select("", "Hits Desc, LastDrwing desc")
Dim Ranking As Integer = 0
For Each RW In Sorted
Ranking += 1
RW.Ranking = Ranking
If Ranking > TopX Then
DeleteRows.Add(RW)
Else
MinHits = RW.Hits
End If
Next
For Each RW In DeleteRows
RW.Delete()
Next
End If
Application.DoEvents()
Next
Next
Cntr += 1
tblNumSet.Clear()
For Each RW As dsWork.tblNumSetRow In tblTracker.Rows
Dim NR As dsWork.tblNumSetRow = tblNumSet.NewtblNumSetRow
For Each CLM As DataColumn In tblNumSet.Columns
NR(CLM.ColumnName) = RW(CLM.ColumnName)
Next
tblNumSet.AddtblNumSetRow(NR)
Next
If dgvTotals.Rows.Count > 0 Then dgvTotals.FirstDisplayedCell = dgvTotals.Rows(0).Cells(0)
lbResults.Items.Insert(0, DrwingRW.Drwing & " " & Cntr & " of " & MasterDrwings.tblDrawings.Rows.Count & Interval.CurrentIntervalWithTimeEstimate(MasterDrwings.tblDrawings.Rows.Count, Cntr))
Application.DoEvents()
If Abort Then
lbResults.Items.Insert(0, "Aborted." & Interval.CurrentInterval)
Exit Sub
End If
Next
lbResults.Items.Insert(0, "All Done." & Interval.CurrentInterval)
End Sub
Public Class clNumberConversion
Private m_PidBase As Byte
Private m_DigitsPerLevel(10, 80) As Long
Private m_Base As Byte
Private m_Digits As Byte
Private m_Nums(10) As Byte
Private m_PID As Long
Private m_NumString As String = ""
Private m_TotalCombos As Long
Public Sub New()
End Sub
Public ReadOnly Property NumStr As String
Get
Return m_NumString
End Get
End Property
Public ReadOnly Property TotalCombos As Long
Get
Return m_TotalCombos
End Get
End Property
Public Sub Set_Nums_From_String(NumString As String)
Dim Pos As Byte = 0
For Each RW In NumString.Split(",")
Pos += 1
Set_Num(Pos, RW)
Next
End Sub
Public Sub Set_Num(Pos As Byte, N0 As Byte)
m_Nums(Pos) = N0
End Sub
Public Function Get_Num(Pos As Byte) As Byte
Return m_Nums(Pos)
End Function
Public Sub PID_For_Seq_Nums_Initialize(Base As Byte, Digits As Byte)
m_Base = Base
m_Digits = Digits
ReDim m_Nums(m_Digits)
ReDim m_DigitsPerLevel(m_Digits, m_Base)
m_PidBase = (m_Base - m_Digits)
Dim PidChangeSum As Long
For DC = 0 To m_PidBase
m_DigitsPerLevel(m_Digits, DC) = 1
Next DC
For DC = m_Digits - 1 To 1 Step -1
For N = 0 To m_PidBase
PidChangeSum = 0
For Z = N To m_PidBase
PidChangeSum = PidChangeSum + m_DigitsPerLevel(DC + 1, Z)
Next Z
m_DigitsPerLevel(DC, N) = PidChangeSum
Next N
Next DC
End Sub
Public Function Calc_PID_For_Seq_Nums() As Long
Dim StartDigit As Integer
Dim StartBlock As Integer
Dim Diff As Long
Dim LastDiff As Long
m_PID = 0
If m_Nums(m_Digits) <> m_Digits Then
StartDigit = 1
Do While StartDigit - m_Nums(StartDigit) = 0
StartDigit = StartDigit + 1
Loop
StartBlock = 0
LastDiff = 0
For DC = StartDigit To m_Digits
Diff = m_Nums(DC) - DC
If LastDiff <> Diff Then
For Z = StartBlock To Diff - 1
m_PID = m_PID + m_DigitsPerLevel(DC, Z)
Next Z
End If
StartBlock = Diff
LastDiff = Diff
Next DC
End If
m_PID += 1
Return m_PID
End Function
Public Function Calc_Seq_Nums_From_PID(PID As Long) As String
m_PID = PID
Dim Rot(20) As Integer
Dim StartDigit As Integer = 1
For DC = m_Digits To 1 Step -1
If m_DigitsPerLevel(DC, 0) < m_PID Then StartDigit = DC
Next DC
If StartDigit <> m_Digits Then
Dim CPID As Long = 0
Dim StartBlock As Long = 0
Dim LastDiff As Long = 0
For DC = StartDigit To m_Digits
Dim CD As Long = StartBlock
Do While CPID < m_PID
CPID = CPID + m_DigitsPerLevel(DC, CD)
CD = CD + 1
Loop
StartBlock = CD - 1
Rot(DC) = CD - 1
CPID = CPID - m_DigitsPerLevel(DC, CD - 1)
Next DC
Else
Rot(m_Digits) = m_PID - 1
End If
m_NumString = ""
For DC = 1 To m_Digits
m_Nums(DC) = DC + Rot(DC)
m_NumString = m_NumString & "," & m_Nums(DC)
Next DC
m_NumString = m_NumString.Substring(1)
Return m_NumString
End Function
Public Function Get_Increment_Block(Num As Long, BaseValue As Long) As Long
Dim F As Double
Dim R1 As Double
Dim R2 As Double
R1 = ((Num / BaseValue)) * BaseValue
R2 = (Int(Num / BaseValue)) * BaseValue
F = R2
If R1 > R2 Or Num = 1 Or R2 = 0 Then F = R2 + BaseValue
If BaseValue = 1 And Num = 1 Then F = 1
Return F
End Function
Public Function Get_Increment_Multiplier(ByVal Num As Long, ByVal BaseValue As Long) As Long
Return Get_Increment_Block(Num, BaseValue) / BaseValue
End Function
Public Function Calc_Permutations(ByVal Base As Integer, ByVal Digits As Integer) As Long
m_Base = Base
m_Digits = Digits
Dim BaseSum As Double = 1
Dim DigitsSum As Double = 1
For DC = 0 To Digits - 1
BaseSum = BaseSum * (Base - DC)
DigitsSum = DigitsSum * (Digits - DC)
Next
m_TotalCombos = BaseSum / DigitsSum
Return m_TotalCombos
End Function
End Class
Public Class ClNumSetBlocks
Private m_NumSets(1) As clNumSetTracker
Public Sub New(BlockSize As Integer)
ReDim m_NumSets(BlockSize)
End Sub
Public Sub Process_Drwing(Drwing As Integer, TrackID As Long)
If m_NumSets(TrackID) Is Nothing Then
m_NumSets(TrackID) = New clNumSetTracker(Drwing)
Else
m_NumSets(TrackID).Process_Drwing(Drwing)
End If
End Sub
Public Function Get_Num_Set_Hits(TrackID As Long) As Integer
If m_NumSets(TrackID) Is Nothing Then
Return 0
Else
Return m_NumSets(TrackID).Hits
End If
End Function
Public Function Get_Num_Set_LastDrwing(TrackID As Long) As Integer
If m_NumSets(TrackID) Is Nothing Then
Return 0
Else
Return m_NumSets(TrackID).LastDrwing
End If
End Function
Public Function Get_Num_Set_FirstDrwing(TrackID As Long) As Integer
If m_NumSets(TrackID) Is Nothing Then
Return 0
Else
Return m_NumSets(TrackID).FirstDrwing
End If
End Function
End Class
Public Class clNumSetTracker
Private m_LastDrwing As Integer = 0
Private m_FirstDrwing As Integer = 0
Private m_Hits As Integer = 0
Public Sub New(Drwing As Integer)
m_FirstDrwing = Drwing
m_LastDrwing = Drwing
m_Hits = 1
End Sub
Public Sub Process_Drwing(Drwing As Integer)
m_Hits += 1
If m_FirstDrwing = 0 Then m_FirstDrwing = Drwing
m_LastDrwing = Drwing
End Sub
Public ReadOnly Property Hits As Integer
Get
Return m_Hits
End Get
End Property
Public ReadOnly Property LastDrwing As Integer
Get
Return m_LastDrwing
End Get
End Property
Public ReadOnly Property FirstDrwing As Integer
Get
Return m_FirstDrwing
End Get
End Property
End Class
Any thoughts on how to get to being able to handle 10 digits or more would be greatly apprerciated.
-
-
I don't pick using this method as I don't like methods based on the historical frequency of a number. In all my testing it has always been among the most unreliable way of picking.
I have yet to settle on a long term strategy. Part of the fun for me is finding new strategies. Out of the 3-4 thousand dollars that have spent, I am above the statistical averages of the higher end prizes and running about even on the mid range ones. I am however well below the statistical average on 0's. In the grand scheme of things makes sense given the methods that I use for picking are more likely to turn up a number that than not.
Yes, the above code can be used on a pick 5 game. I don't currently track any pick 5 games, but here it is against NY P6 through 3/1.
-
-
-
-
In reviewing the code I noticed I had not cleaned out of of my reusable objects. I cleaned all of that out and everything needed is now included.
This class handles all of the number conversions
Public Class clNumberConversion
Private m_PidBase As Byte
Private m_DigitsPerLevel(10, 80) As Long
Private m_Base As Byte
Private m_Digits As Byte
Private m_Nums(10) As Byte
Private m_PID As Long
Private m_NumString As String = ""
Private m_TotalCombos As Long
Private m_Digit(80) As Byte
Private m_Rot(100) As Long
Private m_RotCap(100) As Long
Private m_RotVal(100) As Long
Private m_ResultNums(80) As Byte
Public Sub New()
End Sub
Public ReadOnly Property NumStr As String
Get
Return m_NumString
End Get
End Property
Public ReadOnly Property TotalCombos As Long
Get
Return m_TotalCombos
End Get
End Property
Public Sub Set_Nums_From_String(NumString As String)
Dim Pos As Byte = 0
For Each RW In NumString.Split(",")
Pos += 1
Set_Num(Pos, RW)
Next
End Sub
Public Sub Set_Num(Pos As Byte, N0 As Byte)
m_Nums(Pos) = N0
End Sub
Public Function Get_Num(Pos As Byte) As Byte
Return m_Nums(Pos)
End Function
Public Sub PID_For_Seq_Nums_Initialize(Base As Byte, Digits As Byte)
m_Base = Base
m_Digits = Digits
ReDim m_Nums(m_Digits)
ReDim m_DigitsPerLevel(m_Digits, m_Base)
m_PidBase = (m_Base - m_Digits)
Dim PidChangeSum As Long
For DC = 0 To m_PidBase
m_DigitsPerLevel(m_Digits, DC) = 1
Next DC
For DC = m_Digits - 1 To 1 Step -1
For N = 0 To m_PidBase
PidChangeSum = 0
For Z = N To m_PidBase
PidChangeSum = PidChangeSum + m_DigitsPerLevel(DC + 1, Z)
Next Z
m_DigitsPerLevel(DC, N) = PidChangeSum
Next N
Next DC
End Sub
Public Function Calc_PID_For_Seq_Nums() As Long
Dim StartDigit As Integer
Dim StartBlock As Integer
Dim Diff As Long
Dim LastDiff As Long
m_PID = 0
If m_Nums(m_Digits) <> m_Digits Then
StartDigit = 1
Do While StartDigit - m_Nums(StartDigit) = 0
StartDigit = StartDigit + 1
Loop
StartBlock = 0
LastDiff = 0
For DC = StartDigit To m_Digits
Diff = m_Nums(DC) - DC
If LastDiff <> Diff Then
For Z = StartBlock To Diff - 1
m_PID = m_PID + m_DigitsPerLevel(DC, Z)
Next Z
End If
StartBlock = Diff
LastDiff = Diff
Next DC
End If
m_PID += 1
Return m_PID
End Function
Public Function Calc_Seq_Nums_From_PID(PID As Long) As String
m_PID = PID
Dim Rot(20) As Integer
Dim StartDigit As Integer = 1
For DC = m_Digits To 1 Step -1
If m_DigitsPerLevel(DC, 0) < m_PID Then StartDigit = DC
Next DC
If StartDigit <> m_Digits Then
Dim CPID As Long = 0
Dim StartBlock As Long = 0
Dim LastDiff As Long = 0
For DC = StartDigit To m_Digits
Dim CD As Long = StartBlock
Do While CPID < m_PID
CPID = CPID + m_DigitsPerLevel(DC, CD)
CD = CD + 1
Loop
StartBlock = CD - 1
Rot(DC) = CD - 1
CPID = CPID - m_DigitsPerLevel(DC, CD - 1)
Next DC
Else
Rot(m_Digits) = m_PID - 1
End If
m_NumString = ""
For DC = 1 To m_Digits
m_Nums(DC) = DC + Rot(DC)
m_NumString = m_NumString & "," & m_Nums(DC)
Next DC
m_NumString = m_NumString.Substring(1)
Return m_NumString
End Function
Public Function Get_Increment_Block(Num As Long, BaseValue As Long) As Long
Dim F As Double
Dim R1 As Double
Dim R2 As Double
R1 = ((Num / BaseValue)) * BaseValue
R2 = (Int(Num / BaseValue)) * BaseValue
F = R2
If R1 > R2 Or Num = 1 Or R2 = 0 Then F = R2 + BaseValue
If BaseValue = 1 And Num = 1 Then F = 1
Return F
End Function
Public Function Get_Increment_Multiplier(ByVal Num As Long, ByVal BaseValue As Long) As Long
Return Get_Increment_Block(Num, BaseValue) / BaseValue
End Function
Public Function Calc_Permutations(ByVal Base As Integer, ByVal Digits As Integer) As Long
m_Base = Base
m_Digits = Digits
Dim BaseSum As Double = 1
Dim DigitsSum As Double = 1
For DC = 0 To Digits - 1
BaseSum = BaseSum * (Base - DC)
DigitsSum = DigitsSum * (Digits - DC)
Next
m_TotalCombos = BaseSum / DigitsSum
Return m_TotalCombos
End Function
Public Sub Combos_Seq_Initialize(ByVal Base As Integer, ByVal Digits As Byte)
m_Base = Base
m_Digits = Digits
ReDim m_Nums(m_Base)
m_TotalCombos = Calc_Permutations(m_Base, m_Digits)
For DC = 1 To m_Digits
m_RotVal(DC) = DC
m_RotCap(DC) = m_Base - (m_Digits - DC)
Next
m_RotVal(m_Digits + 1) = 1
m_RotCap(m_Digits + 1) = 1
End Sub
Public Function Get_ResultNums(ByVal Pos As Byte) As Byte
Return m_ResultNums(Pos)
End Function
Public Function Combos_Seq_Next_DigitByNums(ByVal DC As Byte, ByVal PID As Long) As Integer
Dim Digit As Integer = m_RotVal(DC)
m_Digit(DC) = Digit
If m_RotVal(DC + 1) + 1 > m_RotCap(DC + 1) Then
m_RotVal(DC) += 1
If m_RotVal(DC) > m_RotCap(DC) Then
m_RotVal(DC) = m_RotVal(DC - 1) + 1
End If
End If
Dim N0 As Byte = m_Nums(Digit)
m_ResultNums(DC) = N0
Return N0
End Function
End Class
Public Class ClNumSetBlocks
Private m_NumSets(1) As clNumSetTracker
Public Sub New(BlockSize As Integer)
ReDim m_NumSets(BlockSize)
End Sub
Public Sub Process_Drwing(Drwing As Integer, TrackID As Long)
If m_NumSets(TrackID) Is Nothing Then
m_NumSets(TrackID) = New clNumSetTracker(Drwing)
Else
m_NumSets(TrackID).Process_Drwing(Drwing)
End If
End Sub
Public Function Get_Num_Set_Hits(TrackID As Long) As Integer
If m_NumSets(TrackID) Is Nothing Then
Return 0
Else
Return m_NumSets(TrackID).Hits
End If
End Function
Public Function Get_Num_Set_LastDrwing(TrackID As Long) As Integer
If m_NumSets(TrackID) Is Nothing Then
Return 0
Else
Return m_NumSets(TrackID).LastDrwing
End If
End Function
Public Function Get_Num_Set_FirstDrwing(TrackID As Long) As Integer
If m_NumSets(TrackID) Is Nothing Then
Return 0
Else
Return m_NumSets(TrackID).FirstDrwing
End If
End Function
End Class
Public Class clNumSetTracker
Private m_LastDrwing As Integer = 0
Private m_FirstDrwing As Integer = 0
Private m_Hits As Integer = 0
Public Sub New(Drwing As Integer)
m_FirstDrwing = Drwing
m_LastDrwing = Drwing
m_Hits = 1
End Sub
Public Sub Process_Drwing(Drwing As Integer)
m_Hits += 1
If m_FirstDrwing = 0 Then m_FirstDrwing = Drwing
m_LastDrwing = Drwing
End Sub
Public ReadOnly Property Hits As Integer
Get
Return m_Hits
End Get
End Property
Public ReadOnly Property LastDrwing As Integer
Get
Return m_LastDrwing
End Get
End Property
Public ReadOnly Property FirstDrwing As Integer
Get
Return m_FirstDrwing
End Get
End Property
End Class
This class is the timer
Public Class clIntervalTimer
Private m_StartTime As DateTime
Private m_LastStart As DateTime
Private m_TimeStop As DateTime
Private m_SecondPerSegment As Double
Private m_LastProgress As Long = 0
Private m_TimeInMilliSec As Long
Private mlngStart As Long
Private Declare Function GetTickCount Lib "kernel32" () As Long
Public Sub New()
Call Reset_Timer()
End Sub
Public ReadOnly Property TimeInMilliSec() As Long
Get
Return m_TimeInMilliSec
End Get
End Property
Public ReadOnly Property CurrentInterval() As String
Get
Return GetCurrent() & " " & m_TimeStop.ToLocalTime
Call StartTimer()
End Get
End Property
Public Function CurrentIntervalWithTimeEstimate(ByVal TotalCombos As Long, ByVal Progress As Long) As String
Dim result As String = GetCurrent()
If Progress < m_LastProgress Then m_LastProgress = 0
Dim SegCount As Long = Progress - m_LastProgress
Dim RemainingTotal As Long = TotalCombos - Progress
Dim Cycles As Long = RemainingTotal / IIf(SegCount = 0, 1, SegCount)
Dim FinishTime As DateTime = Now
Try
Dim ProcessTime As Double = m_SecondPerSegment
If ProcessTime <= 0 Then ProcessTime = 0.001
FinishTime = DateAdd(DateInterval.Second, ProcessTime * Cycles, Now)
Catch ex As Exception
End Try
m_LastProgress = Progress
Call StartTimer()
Return result & " " & m_TimeStop.ToLocalTime & " Est: " & FinishTime
End Function
Public Sub StartTimer()
mlngStart = GetTickCount
End Sub
Public Function EndTimer() As Double
m_TimeInMilliSec = (GetTickCount - mlngStart)
EndTimer = m_TimeInMilliSec
End Function
Public Sub Reset_Timer()
m_StartTime = Now()
m_LastStart = Now()
Call StartTimer()
End Sub
Private Function GetCurrent() As String
Dim AllMinutes As Double
Dim SegMinutes As Double
m_TimeStop = Now
m_SecondPerSegment = EndTimer() / 1000
AllMinutes = DateDiff(DateInterval.Minute, m_StartTime, m_TimeStop)
SegMinutes = DateDiff(DateInterval.Second, m_LastStart, m_TimeStop)
If SegMinutes > 60 Then SegMinutes = Math.Round(SegMinutes / 60, 2)
GetCurrent = " - Min: " & AllMinutes & " Hours: " & Math.Round(AllMinutes / 60, 2) & " Time/Seg: " & SegMinutes
m_LastStart = Now()
End Function
End Class
tblNumSet is a data table in a dataset object with the following structure:
This is the code that goes on the form:
Public Class frmStats
Dim Abort As Boolean = False
Private tblNumSet As New dsWork.tblNumSetDataTable
Dim NumBase As Byte = My.Settings.NumBase
Dim WinDigits As Byte = My.Settings.WinDigits
Dim PickDigits As Byte = My.Settings.PickDigits
Private Sub frmFormClosing(ByVal sender As Object, ByVal e As
End Sub
Private Sub frmForm_Load(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles MyBase.Load
Me.Text = My.Application.Info.AssemblyName & " " & Application.ExecutablePath
End Sub
Private Sub cbOperation_TextChanged(ByVal sender As Object, ByVal e As System.EventArgs) Handles cbOperation.TextChanged
Call Select_Process(False)
End Sub
Private Sub bnRunAnalysis_Click(ByVal sender As Object, ByVal e As System.EventArgs) Handles bnRunAnalysis.Click
lblFeedback.Text = cbOperation.Text & " started at " & Now
Application.DoEvents()
Call Select_Process(True)
End Sub
Private Sub bnMultiToggle_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles bnMultiToggle.Click
If dgvTotals.MultiSelect Then
dgvTotals.MultiSelect = False
Else
dgvTotals.MultiSelect = True
End If
End Sub
Private Sub bnAbort_Click(ByVal sender As Object, ByVal e As System.EventArgs) Handles bnAbort.Click
Abort = True
bnAbort.Tag = "T"
End Sub
Private Sub bnCopySelection_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles bnCopySelection.Click
Dim theBuilder As New System.Text.StringBuilder()
For Each currentItem As String In lbResults.SelectedItems
theBuilder.Append(currentItem)
theBuilder.Append(Environment.NewLine)
Next
Clipboard.SetText(theBuilder.ToString)
End Sub
Private Sub Select_Process(ByVal RunAnalysis As Boolean)
Abort = False
bnAbort.Tag = "F"
dgvTotals.MultiSelect = False
Select Case cbOperation.Text
Case "See_Number_Freq"
If RunAnalysis Then
Call See_Number_Freq()
Else
tbStartDrwing.Text = 1
tbDrwings.Text = 10
tbCondition1.Text = "6"
tbCondition2.Text = "100"
tbCondition3.Text = ""
tbCondition4.Text = ""
tbCondition5.Text = ""
tbCondition6.Text = ""
lblCondition1.Text = "Target Digits (7 Max)"
lblCondition2.Text = "Top X"
lblCondition3.Text = ""
lblCondition4.Text = ""
lblCondition5.Text = ""
lblCondition6.Text = ""
End If
End Select
dgvTotals.MultiSelect = True
lblListBoxRowCount.Text = "Row Count: " & dgvTotals.Rows.Count
End Sub
Private Sub See_Number_Freq()
tblNumSet.Clear()
bsTotals.Sort = ""
bsTotals.DataSource = ""
bsTotals.DataSource = tblNumSet
dgvTotals.DataSource = ""
dgvTotals.DataSource = bsTotals
bsTotals.Sort = "Ranking"
Dim TargetDigits As Byte = tbCondition1.Text
Dim TopX As Integer = tbCondition2.Text
If TargetDigits > 7 Then
MsgBox("Digits cannot exceed 7", MsgBoxStyle.Critical, "Too many digits.")
Exit Sub
End If
Dim tblTracker As New dsWork.tblNumSetDataTable
Dim StartDrwing As Integer = tbStartDrwing.Text
Dim EndDrwing As Integer = StartDrwing + CInt(tbDrwings.Text) - 1
Dim Cntr As Integer = 0
Dim BreakCntr As Integer = 0
Dim DYS As Integer = 0
Dim MinHits As Integer = 0
Dim Combos As New clNumberConversion
Combos.Combos_Seq_Initialize(WinDigits, TargetDigits)
Dim NumConv As New clNumberConversion()
NumConv.PID_For_Seq_Nums_Initialize(NumBase, TargetDigits)
NumConv.Calc_Permutations(NumBase, TargetDigits)
Dim BlockSize As Long = 2400000
Dim BlockCount As Integer = NumConv.Get_Increment_Multiplier(NumConv.TotalCombos, BlockSize)
Dim NumSets(BlockCount) As ClNumSetBlocks
For DC = 1 To BlockCount
NumSets(DC) = New ClNumSetBlocks(BlockSize)
Application.DoEvents()
Next
Dim QryWinNums As String = ""
Dim tblWinNums As New DataTable
tblWinNums.Columns.Add("Drwing", Type.GetType("System.Int32"))
tblWinNums.Columns.Add("dteDate", Type.GetType("System.DateTime"))
QryWinNums = ""
For DC = 1 To WinDigits
tblWinNums.Columns.Add("N" & DC, Type.GetType("System.Byte"))
QryWinNums = QryWinNums & ",N" & DC
Next
QryWinNums = "Select Drwing, dteDate " & QryWinNums & " from tblwinnums where drwing between " & StartDrwing & " and " & EndDrwing
Dim Adp As New SqlClient.SqlDataAdapter(QryWinNums, My.Settings.csNumData)
Adp.Fill(tblWinNums)
Dim Interval As New clIntervalTimer
For Each DrwingRW As DataRow In tblWinNums.Rows
For DC = 1 To WinDigits
Dim N0 As Byte = DrwingRW("N" & DC)
Combos.Set_Num(DC, N0)
Next
For PID = 1 To Combos.TotalCombos
Dim NumStr As String = ""
For DC = 1 To TargetDigits
Dim N0 As Byte = Combos.Combos_Seq_Next_DigitByNums(DC, PID)
NumConv.Set_Num(DC, N0)
NumStr = NumStr & "," & N0
Next
Dim ID As Long = NumConv.Calc_PID_For_Seq_Nums
Dim BlockID As Integer = NumConv.Get_Increment_Multiplier(ID, BlockSize)
Dim TrackID As Integer = ID - (BlockSize * (BlockID - 1))
NumSets(BlockID).Process_Drwing(DrwingRW("Drwing"), TrackID)
Dim Hits As Integer = NumSets(BlockID).Get_Num_Set_Hits(TrackID)
Dim NumRW As dsWork.tblNumSetRow = tblTracker.FindByBlockIDTrackID(BlockID, TrackID)
Dim DataUpdate As Boolean = False
If NumRW IsNot Nothing Then
NumRW.Hits = Hits
NumRW.LastDrwing = DrwingRW("Drwing")
DataUpdate = True
ElseIf Hits > MinHits Or tblTracker.Rows.Count < TopX Then
NumStr = NumStr.Substring(1)
tblTracker.AddtblNumSetRow(0, NumStr, Hits, NumSets(BlockID).Get_Num_Set_FirstDrwing(TrackID), NumSets(BlockID).Get_Num_Set_LastDrwing(TrackID), BlockID, TrackID)
DataUpdate = True
End If
If DataUpdate Then
Dim DeleteRows As New List(Of dsWork.tblNumSetRow)
Dim Sorted() As dsWork.tblNumSetRow = tblTracker.Select("", "Hits Desc, LastDrwing desc")
Dim Ranking As Integer = 0
For Each RW In Sorted
Ranking += 1
RW.Ranking = Ranking
If Ranking > TopX Then
DeleteRows.Add(RW)
Else
MinHits = RW.Hits
End If
Next
For Each RW In DeleteRows
RW.Delete()
Next
End If
Application.DoEvents()
Next
Cntr += 1
tblNumSet.Clear()
For Each RW As dsWork.tblNumSetRow In tblTracker.Rows
Dim NR As dsWork.tblNumSetRow = tblNumSet.NewtblNumSetRow
For Each CLM As DataColumn In tblNumSet.Columns
NR(CLM.ColumnName) = RW(CLM.ColumnName)
Next
tblNumSet.AddtblNumSetRow(NR)
Next
If dgvTotals.Rows.Count > 0 Then dgvTotals.FirstDisplayedCell = dgvTotals.Rows(0).Cells(0)
lbResults.Items.Insert(0, DrwingRW("Drwing") & " " & Cntr & " of " & tblWinNums.Rows.Count & Interval.CurrentIntervalWithTimeEstimate(tblWinNums.Rows.Count, Cntr))
Application.DoEvents()
If Abort Then
lbResults.Items.Insert(0, "Aborted." & Interval.CurrentInterval)
Exit Sub
End If
Next
lbResults.Items.Insert(0, "All Done." & Interval.CurrentInterval)
End Sub
End Class
-
-
-
-
-
-
