Combinations of 4-digit numbers whose individual digits sum to 5 - vba

I'm working on a scorecard at work which has columns representing 4 possible outcomes, for example:
Successful,
unsuccessful,
Exceptional,
Other
Each staff member is assessed 5 times in the month against those ratings. So 1 person might have 3 successful, 2 exceptional, 0 unsuccessful, 0 other.
So the max instances of each outcome is 5 but the total sum of instances can't be more than 5.
I could try to type out all the combinations (and get them wrong) - is there any function/formula/VBA that anyone knows of that will list out all of the possible combinations of outcomes for me?
e.g. 5000,4100,4010,4001,3200,3020,3002,3110,3011, etc...

Since your numbers can range from 0005 to 5000, you could just write a simple loop that tests each number to see if the digits total 5:
Sub GetPermutations()
Dim i As Long
For i = 5 To 5000
If SumDigits(i) = 5 Then Debug.Print Format$(i, "0000")
Next
End Sub
Function SumDigits(s As Variant) As Long
Dim i As Long
For i = 1 To Len(s)
SumDigits = SumDigits + CLng(Mid$(s, i, 1))
Next
End Function
Alternatively:
Dim w As Long, x As Long, y As Long, z As Long
For w = 0 To 5
For x = 0 To 5
For y = 0 To 5
For z = 0 To 5
If w + x + y + z = 5 Then Debug.Print w & x & y & z
Next
Next
Next
Next

c#:
// numbering 1 to 4 - i.e.
// 1 sucessful, 2 unsucessful, 3 exception, 4 other
for(int i=1;i<4;i++)
{
for(int n=1;n<4;n++)
{
for(int d=1;d<4;d++)
{
for(int q=1;q<4;q++)
{
if(i+d+n+q<=5)
Console.WriteLine(i+n+d+q+", ");
}
}
}
}
EDIT: just saw you asked for vba:
For number1 As Integer = 1 To 4 Step 1
For number2 As Integer = 1 To 4 Step 1
For number3 As Integer = 1 To 4 Step 1
For number4 As Integer = 1 To 4 Step 1
if(number1+number2+number3+number4<=5) Then
Debug.WriteLine(number1.ToString & number2.toString &number3.toString &number4.ToString & ",");
End If
Next number4
Next number3
Next number2
Next number1
The most simple solution I could think of, there's probably better though.

Thanks for your help everyone - i managed to use a combination of suggestions by starting with the number 1, auto-filling down to 5000, then "text to columns", fixed width to separate the digits, sum to 5, filter and hey presto! Seems to have produced the right number of possible combinations adding up to 5.
Thanks again for your help!

Related

BigInteger Innacuracy

In the following project euler program #56, Considering natural numbers of the form, a^b, where a, b < 100, what is the maximum digital sum?
so I wrote the following code:
Dim num As System.Numerics.BigInteger
Dim s As String
Dim sum As Integer
Dim record As Integer
For a = 2 To 99
For b = 1 To 99
num = a ^ b
s = num.ToString
For i = 0 To s.Length - 1
sum += CInt(s.Substring(i, 1))
Next
sum = 0
Next
Next
The answer I got from the program was not the correct answer, so I wrote the following code so I can see what numbers set a new high value and see if something is wrong.
If sum > record Then
record = sum
Console.WriteLine(a & "," & b)
End If
One of the answers was a=10 b= 81. Obviously that doesn't make sense, because that value is 1 + 81 "0" = 1, but watching the result of 10^81, was 999999999999999921281879895665782741935503249059183851809998224123064148429897728
I searched about the accuracy of BigInteger but couldn't find anything, is there something that I'm missing?

EXPLAIN what this VB CODE means

Function convertToText(ByVal data As String) As String
Dim result As String = Nothing
Dim i As Integer = 0
Dim j As Integer = 0
For Each c As Char In data.ToCharArray
j *= 2
If c = "1"c Then j += 1
i += 1
If i = 8 Then
i = 0
result &= Chr(j)
j = 0
End If
Next
Return result
End Function
It converts binary to text but its a bit difficult for me to understand the logic behind it.
Someone please help.
The code seems to convert a text containing a binary number representing 8 bit character codes to a string containing these characters.
The for each loop loops over all binary digits ("0" or "1") of the input. The code of each result character is computed and after every 8 input characters the code is considered to be complete and the new character whose code was determined is added to the result (result &= Chr(j) is the same as result = result & Chr(j). Chr(j) converts an Integer containing a character code into a character). The variable i counts the bits.
The variable j holds the character code. If a bit is "1", then 1 is added to j (j += 1 is the same as j = j + 1), but not if it is "0".
A "1" in the right most bit position has a (decimal) value of 1. The next to its left a value of 2. The next 4 and so on. The value doubles for each position until it reaches 128 for the left most bit of an 8 bit number. Therefore j is doubled on each loop (j *= 2 is the same as j = j * 2).
Example with just 4 bits:
data = "1010"
The binary number 1010 means
1 * 8 + 0 * 4 + 1 * 2 + 0 * 1 = (decimal)10
The code does this
j = 0 => 0
j *= 2 => 0
j += 1 => 1 'since c = "1"
j *= 2 => 2
'no += 1 since c = "0"
j *= 2 => 4
j += 1 => 5 'since c = "1"
j *= 2 => 10
'no += 1 since c = "0"
The first 1 we added is doubled 3 times and becomes 8. The second 1 we added is doubled only once and becomes 2. 8 + 2 = 10.

Project Euler 3

I have been trying to solve question 3 on project euler with the following vb code but I do not under stand why it is not working. Can someone please point me in the right direction?
Sub Main()
Dim p As Int64 = 600851475143
Dim y As Integer
For i As Int64 = p / 2 To 1 Step -1
If p Mod i = 0 Then
y = 0
For n As Int64 = 1 To Math.Floor(i ^ 0.5) Step 1
If i Mod n = 0 Then
y = y + 1
End If
Next
If y = 0 Then
Console.WriteLine(i)
Console.ReadLine()
End If
End If
Next
End Sub
The question is "The prime factors of 13195 are 5, 7, 13 and 29.
What is the largest prime factor of the number 600851475143 ?"
For n As Int64 = 1 To Math.Floor(i ^ 0.5) Step 1
If i Mod n = 0 Then
You start with n=1. Every number divides evenly by 1.
(so y = y+1 every time, and If y = 0 Then can never happen).

Randomly divide a whole number m into n parts such that the parts are whole numbers and each part lies between x and y

As an example. I want to randomly hand out 100 chocolates to 25 kids. I cannot give any kid more than 10 chocolates.
So here m = 100, n = 25, x = 1 and y = 12.
I have checked these questions.
Dividing a number into m parts uniformly randomly
Dividing a number into random unequal parts
They do give some idea but in these questions x and y are not specified.
So basically,
1) Total No. of Chocolates = 100
2) I can only give minimum 1 and maximum 12 chocolates to each kid
3) Chocolates should be distributed between 25 kids
4) I do not want any distribution (uniform or normal) - it should be purely random. (I am willing to exclude this condition if all else fails.)
Private Function divideUniformlyRandomly(n As Integer, m As Integer) As Integer()
Dim rRandom As New Random
Dim fences As Integer() = New Integer(m - 2) {}
For i As Integer = 0 To m - 3
fences(i) = rRandom.Next(0, n - 1)
Next
[Array].Sort(fences)
Dim result As Integer() = New Integer(m - 1) {}
result(0) = fences(0)
For i As Integer = 1 To m - 3
result(i) = fences(i + 1) - fences(i)
Next
result(m - 1) = n - 1 - fences(m - 2)
Return result
End Function
This does work but I get 0 and 13 as well. I cannot ensure x and y here.
Give each child x chocolate. This will leave you with m - (n * x) to distribute randomly. Keep distributing to children that have less than y chocolates, until there are no more chocolates.
Private Function divideUniformlyRandomly(n As Integer, m As Integer, x As Integer, y As Integer) As Integer()
Dim rRandom As New Random
Dim aResult As Integer() = New Integer(n - 1) {}
Dim i As Integer = 0
Dim remaining As Integer = m
' Every n must have a min of x.
For i = 0 To n - 1
aResult(i) = x
remaining -= x
Next
' distribute the remaining m over the children randomly
While remaining > 0
' pick a child randomly
i = rRandom.Next(0, n)
' if the child has less than y, give them one
If aResult(i) < y Then
aResult(i) += 1
remaining -= 1
End If
End While
' Debug
Dim sum As Integer = 0
For i = 0 To n - 1
Console.WriteLine("{0}: {1}", i, aResult(i))
sum += aResult(i)
Next
Console.WriteLine("Sum: {0}", sum)
divideUniformlyRandomly = aResult
End Function

How to get the multiples of 3 or 5 in vb.net?

How can I get the multiples of 3 or 5 in vb.net? I have this code but it gives me different output. Please help me.
Dim x As Integer
For x = 3 To 10
If x Mod 2 <> 0 Then
Dim sum As Integer
sum += x
MsgBox(x)
End If
Next
The output will be 3,5,7,9. The expected output should be 3,5,6,9. So any help?
x Mod 2 <> 0 gives you all numbers except numbers that are divisible by 2. But you want all numbers that are divisible by 3 or 5.
So this gives you the expected output:
For x = 3 To 9
If x Mod 3 = 0 OrElse x Mod 5 = 0 Then
' ... '
Note that my loops ends with 9 instead of 10 since 10 would be divisible by 5 but you dont expect it.
For Each i As Integer In Enumerable.Range(1,10) _
.Where(Function(i) i Mod 3 = 0 OrElse i Mod 5 = 0)
MsgBox(i)
Next i
Why do you check x Mod 2 <> 0, when you need multiplies of 3 and 5? Try following:
Dim x As Integer
For x = 3 To 10
If x Mod 3 = 0 OrElse x Mod 5 = 0 Then
Dim sum As Integer
sum += x
MsgBox(x)
End If
Next