Need a little VB.Net help. TheFinder was attempting to find a good solution to a lottery number picking problem. He needed to pick 6 numbers, each from 1 to 50 but no two duplicating. The six numbers had to total to a target value input by the user between 21 and 285.

I developed an algorithm (in GetSix below) that I believe will give a quick and simple solution to the problem. Unfortunately, I’m not VB.Net adept and I don’t have VB. If someone would like to fix up this code and give us a little idea of the performance (time and/or number of loops), that would be interesting.

[Code]

.. mainline

Dim targetValue as Integer

Dim Num1, Num2, Num3, Num4, Num5, Num6 as Integer

Dim CountOfTries as Integer targetValue = 98 // targetValue would be user input between 21 and 285

If GetSix(targetValue, Num1, Num2, Num3, Num4, Num5, Num6, CountOfTries)

// here we’ve got 6 good values and the CountOfTries

Else

// here we’ve got an error

Endif

Public Function GetSix(ByVal target As Integer ByRef N1 As Integer, ByRef N2 As Integer, ByRef N3 As Integer, ByRef N4 As Integer, ByRef N5 As Integer, ByRef N6 As Integer, ByRef CountLoop As Integer) as Boolean

Dim Success as Boolean = true

CountLoop = 0 Do until ((N1<>N2 and N1<>N3 and N1<>N4 and N1<>N5 and N1<>N6 and N2<>N3 and N2<>N4 and N2<>N5 and N2<>N6 and N3<>N4 and N3<>N5 and N3<>N6 and N4<>N5 and N4<>N6 and N5<>N6) or Success = False) CountLoop += 1 // CountLoop saves us from an endless loop – but that shouldn’t happen

N1 = RandomBetween(Max(target-240,1),Min(50,target-15)) N2=RandomBetween(Max(target-N1-194,1),Min(50,target-10-N1)) N3= RandomBetween(Max(target-N1-N2-147,1),Min(50,target-6-N1-N2))

N4=RandomBetween(Max(target-N1-N2-N3-99,1),Min(target-3-N1-N2-N3))

N5=RandomBetween(Max(target-N1-N2-N3-N4-50,1),Max(50,target-1-N1-N2-N3-N4))

N6=target-(N1+N2+N3+N4+N5)

If CountLoop > 250

Success = False

Endif Loop

Return Success

End Function

Public Function RandomBetween(ByVal Min As Integer, ByVal Max As Integer) As Integer

Dim MyRandom As System.Random = New System.Rando()

Return MyRandom.Next(Min, Max)

End Function

[/ECODE] Now I've Messed up the formating replacing iif clauses with min and max -- thanks Tom, I didn't think about this touch.

Software/Hardware used:

VB.Net 9</pre>

I developed an algorithm (in GetSix below) that I believe will give a quick and simple solution to the problem. Unfortunately, I’m not VB.Net adept and I don’t have VB. If someone would like to fix up this code and give us a little idea of the performance (time and/or number of loops), that would be interesting.

[Code]

.. mainline

Dim targetValue as Integer

Dim Num1, Num2, Num3, Num4, Num5, Num6 as Integer

Dim CountOfTries as Integer targetValue = 98 // targetValue would be user input between 21 and 285

If GetSix(targetValue, Num1, Num2, Num3, Num4, Num5, Num6, CountOfTries)

// here we’ve got 6 good values and the CountOfTries

Else

// here we’ve got an error

Endif

Public Function GetSix(ByVal target As Integer ByRef N1 As Integer, ByRef N2 As Integer, ByRef N3 As Integer, ByRef N4 As Integer, ByRef N5 As Integer, ByRef N6 As Integer, ByRef CountLoop As Integer) as Boolean

Dim Success as Boolean = true

CountLoop = 0 Do until ((N1<>N2 and N1<>N3 and N1<>N4 and N1<>N5 and N1<>N6 and N2<>N3 and N2<>N4 and N2<>N5 and N2<>N6 and N3<>N4 and N3<>N5 and N3<>N6 and N4<>N5 and N4<>N6 and N5<>N6) or Success = False) CountLoop += 1 // CountLoop saves us from an endless loop – but that shouldn’t happen

N1 = RandomBetween(Max(target-240,1),Min(50,target-15)) N2=RandomBetween(Max(target-N1-194,1),Min(50,target-10-N1)) N3= RandomBetween(Max(target-N1-N2-147,1),Min(50,target-6-N1-N2))

N4=RandomBetween(Max(target-N1-N2-N3-99,1),Min(target-3-N1-N2-N3))

N5=RandomBetween(Max(target-N1-N2-N3-N4-50,1),Max(50,target-1-N1-N2-N3-N4))

N6=target-(N1+N2+N3+N4+N5)

If CountLoop > 250

Success = False

Endif Loop

Return Success

End Function

Public Function RandomBetween(ByVal Min As Integer, ByVal Max As Integer) As Integer

Dim MyRandom As System.Random = New System.Rando()

Return MyRandom.Next(Min, Max)

End Function

[/ECODE] Now I've Messed up the formating replacing iif clauses with min and max -- thanks Tom, I didn't think about this touch.

Software/Hardware used:

VB.Net 9</pre>

Asked:
January 16, 2012 2:57 AM
Last updated:
February 28, 2012 11:39 AM

Thanks. We'll let you know when a new response is added.

## Discuss This Question: 50 Replies

Register Here

or login if you are already a member

...in 16+secondsNote that it is "point 1 6", i.e., less than two-tenths of a second for the REXX, most of which is in the I/O. I certainly expect that that's a high limit and that other solutions would be even faster. TomCool Flash, POINT 16 seconds,...Yeah, that's why I wasn't sure way back at the beginning why some general discussion points seemed unacceptable. Without serious context, it's not clear if the requirement is actually more like .000016 (or less) seconds. Certainly if this was to be a part of some encryption/decryption algorithm that must be applied for many rounds or some other highly repetitive operation, for example, then maybe true high-speed really needs to be part of it. OTOH, I didn't want to leave the question behind because sometimes routines can be "good enough". We all decide for ourselves where the point of "good enough" is. Working much past that point gives diminishing returns. But that's a significant part of programming -- making that judgment. Tom(And TheFinder is probably unaware of the existence of this thread).I was going to post my code when the weekend arrived, but the thread had been deleted. Since I had the page already opened in a previous tab, I considered creating a new question that had the same subject in order to be an eye-catcher. Then I saw Phil's post. Ah, well. TomHe needed to pick 6 numbers, each from 1 to 50 but no two duplicating.One part that wasn't clear in the original request was how the new six numbers needed to differ from the old six numbers. It was clear that the new set of six couldn't equal the old set of six; but could any individual members of the two sets be equal? The sample logic ensured that none of the first five new numbers matched any of the old six, but I chose to ignore the sixth number and allowed it to be a duplicate. For that logic, adding an outer test for the final remainder would allow catching that final equality. In test runs, it didn't happen often enough for a specific one of the six (the last one) for me to worry about it. Duplicates did happen often enough during generation of all numbers, though. Tom50 the lottery has balls labeled 1 to 50. My logic computes the max but the .next method uses Max - 1. Behind it is the old rand fuction which requried the same adjustment. thanksPublic Function GetSix(ByVal target As Integer, ByRef N1 As Integer, ByRef N2 As Integer, _ByRef N3 As Integer, ByRef N4 As Integer, ByRef N5 As Integer, ByRef N6 As Integer, _ ByRef CountLoop As Integer) As Boolean Dim Success As Boolean = True Dim rnd1 As New Random() CountLoop = 0 Do Until ((N1 <> N2 And N1 <> N3 And _ N1 <> N4 And N1 <> N5 And _ N1 <> N6 And N2 <> N3 And _ N2 <> N4 And N2 <> N5 And _ N2 <> N6 And N3 <> N4 And _ N3 <> N5 And N3 <> N6 And _ N4 <> N5 And N4 <> N6 And _ N5 <> N6) Or Success = False) ‘Loop CountLoop += 1 ‘CountLoop saves us from an endless loop – but that shouldn’t happen N1 = rnd1.next(MAX( target - 239, 1), MIN( 50, target - 13) + 1 ) N2 = rnd1.next(MAX( target - N1 - 193, 1), MIN(50, target - 9 - N1) + 1) N3 = rnd1.next(MAX( target - N1 - N2 - 146, 1), MIN(50, target - 6 - N1 - N2) + 1) N4 = rnd1.next(MAX( target - N1 - N2 - N3 - 99, 1), MIN(50, target - 3 - N1 - N2 - N3) +1) N5 = rnd1.next(MAX( target - N1 - N2 - N3 - N4 - 50, 1), MIN(50, target - 1 - N1 - N2 - N3 - N4) +1) N6 = MAX( target - (N1 + N2 + N3 + N4 + N5), 1) If CountLoop > 25000 Then Success = False End If LoopI don’t have or can’t find the “Add to my Watch list” button...Try the browser Ctrl-F ('Find') function to find "watch" on the page. Or use Phil's profile to track where he's been hanging out. Tomtrack where he’s been hanging out.Do I have the video-cam on again? Phil