I want to compute for the binomial coefficient in Visual basic but I can only do the numerator part as I am lost on the denominator part. The equation that I am using is seen in the image below.
Equations
Looking at the C(n,k) equation, I can only do the numerator which is the n factorial. I am having trouble with the denominator. My code for the numerator (n!) is below:
Dim nfactorial As Integer = 1
For i As Integer = 1 To txt3.Text
nfactorial *= i
Next
What should I do about the denominator part? Thanks!
You can't separately calculate numerator and denominator. Have you try finding (30!) in .NET, especially with Integer ?
Is this a homework? Anyway, just take a look at following post: http://csharphelper.com/blog/2014/08/calculate-the-binomial-coefficient-n-choose-k-efficiently-in-c/
Code in vb:
Dim result As Decimal = 1
For i As Integer = 1 To K
result *= N - (K - i)
result /= i
Next
Return result
Try this:
'by example: C(5,3) = 10
Dim n, k As Integer
Dim result As String = ""
n = txt3.Text
For k = 0 To 3
result = result & "For C(" & n & "," & k & ")=" & C(n, k) & vbCrLf
Next
MsgBox(result)
.
.
.
Private Function C(n As Integer, k As Integer)
Dim result As Decimal = 1
For i As Integer = 1 To k
result *= n - (k - i)
result /= i
Next
Return result
End Function
EDIT: For k=0 to 3 and n entered by keyboard.
Related
I have queried a report that shows the width, height, and thickness of the windows which was in decimal format, until I inserted custom VB code in SSRS to change those decimals to fractions, And one particular fraction that suppose to say "5/23" is showing as "39/250" and I am wondering I can put a IF statement in to get 39/250 to say 5/23.
Fraction:
Function GetFraction(ByVal Num As Double) As String
If Num = 0# Then
GetFraction = "None"
Else
Dim WholeNumber As Integer
Dim DecimalNumber As Double
Dim Numerator As Double
Dim Denomenator As Double
Dim a, b, t As Double
WholeNumber = Fix(Decimal.Round(Convert.ToDecimal(Num,Nothing), 3))
DecimalNumber = Decimal.Round(Convert.ToDecimal(Num,Nothing),3) - Fix(Decimal.Round(Convert.ToDecimal(Num,Nothing),3))
Numerator = DecimalNumber *10 ^ (Len(CStr(DecimalNumber)) - 2)
Denomenator = 10 ^ (Len(CStr(DecimalNumber)) - 2)
If Numerator = 0 Then
GetFraction = WholeNumber
Else
a = Numerator
b = Denomenator
t = 0
While b <> 0
t = b
b = a Mod b
a = t
End While
If WholeNumber = 0 Then
GetFraction = CStr(Numerator / a) & "/" & CStr(Denomenator / a)
Else
GetFraction = CStr(WholeNumber) & " " & CStr(Numerator / a) & "/" & CStr(Denomenator / a)
End If
End If
End If
End Function
I'm guessing you really want 5/32, not the 5/23 because 5/23 = 0.2173913043478261 while 5/32 = 0.15625 which seems to be the number you want. What you need to do is adjust your rounding to five decimal points. I believe these two lines just need the 3s switched to 5s. It's possible you may need more like a 6 for this case, but since 5/32 has 5 digits right of the decimal point, I would guess this would fix your problem.
WholeNumber = Fix(Decimal.Round(Convert.ToDecimal(Num,Nothing), 5))
DecimalNumber = Decimal.Round(Convert.ToDecimal(Num,Nothing),5) - Fix(Decimal.Round(Convert.ToDecimal(Num,Nothing),5))
I have a set which has an unknown number of objects. I want to associate a label to each one of these objects. Instead of labeling each object with a number I want to label them with letters.
For example the first object would be labeled A the second B and so on.
When I get to Z, the next object would be labeled AA
AZ? then BA, BB, BC.
ZZ? then AAA, AAB, AAC and so on.
I'm working using Mapbasic (similar to VBA), but I can't seem to wrap my head around a dynamic solution. My solution assumes that there will be a max number of objects that the set may or may not exceed.
label = pos1 & pos2
Once pos2 reaches ASCII "Z" then pos1 will be "A" and pos2 will be "A". However, if there is another object after "ZZ" this will fail.
How do I overcome this static solution?
Basically what I needed was a Base 26 Counter. The function takes a parameter like "A" or "AAA" and determines the next letter in the sequence.
Function IncrementAlpha(ByVal alpha As String) As String
Dim N As Integer
Dim num As Integer
Dim str As String
Do While Len(alpha)
num = num * 26 + (Asc(alpha) - Asc("A") + 1)
alpha = Mid$(alpha, 2,1)
Loop
N = num + 1
Do While N > 0
str = Chr$(Asc("A") + (N - 1) Mod 26) & str
N = (N - 1) \ 26
Loop
IncrementAlpha = str
End Function
If we need to convert numbers to a "letter format" where:
1 = A
26 = Z
27 = AA
702 = ZZ
703 = AAA etc
...and it needs to be in Excel VBA, then we're in luck. Excel's columns are "numbered" the same way!
Function numToLetters(num As Integer) As String
numToLetters = Split(Cells(1, num).Address(, 0), "$")(0)
End Function
Pass this function a number between 1 and 16384 and it will return a string between A and XFD.
Edit:
I guess I misread; you're not using Excel. If you're using VBA you should still be able to do this will the help of an reference to an Excel Object Library.
This should get you going in terms of the logic. Haven't tested it completely, but you should be able to work from here.
Public Function GenerateLabel(ByVal Number As Long) As String
Const TOKENS As String = "ZABCDEFGHIJKLMNOPQRSTUVWXY"
Dim i As Long
Dim j As Long
Dim Prev As String
j = 1
Prev = ""
Do While Number > 0
i = (Number Mod 26) + 1
GenerateLabel = Prev & Mid(TOKENS, i, 1)
Number = Number - 26
If j > 0 Then Prev = Mid(TOKENS, j + 1, 1)
j = j + Abs(Number Mod 26 = 0)
Loop
End Function
I have this code below, and I'm getting an overflow error at the line:
s = s + (x Mod 10) [first line in the Do Loop]
Why? I declared x and s to be of type Double. Adding two doubles, why is this not working?
Thanks for your help.
Public Sub bidon1()
Dim i As Double, x As Double, s As Double, k As Byte, h As Byte
Dim y(1 To 6) As Double
For i = 1 To 1000000
x = i ^ 3
Do
s = s + (x Mod 10)
x = x \ 10
Loop Until x = 0
If s = x Then
k = k + 1
y(k) = x
If y(6) > 0 Then
For h = 1 To 6
Debug.Print y(h)
Next
Exit Sub
End If
End If
Next
End Sub
The problem is that the VBA mod operator coerces its arguments to be integers (if they are not already so). It is this implicit coercion which is causing the overflow. See this question: Mod with Doubles
On Edit:
Based on your comments, you want to be able to add together the digits in a largish integer. The following function might help:
Function DigitSum(num As Variant) As Long
'Takes a variant which represents an integer type
'such as Integer, Long or Decimal
'and returns the sum of its digits
Dim sum As Long, i As Long, s As String
s = CStr(num)
For i = 1 To Len(s)
sum = sum + Val(Mid(s, i, 1))
Next i
DigitSum = sum
End Function
The following test sub shows how it can be used to correctly get the sum of the digits in 999999^3:
Sub test()
Dim x As Variant, y As Variant
Debug.Print "Naive approach: " & DigitSum(999999 ^ 3)
y = CDec(999999)
x = y * y * y
Debug.Print "CDec approach: " & DigitSum(x)
End Sub
Output:
Naive approach: 63
CDec approach: 108
Since 999999^3 = 999997000002999999, only the second result is accurate. The first result is only the sum of the digits in the string representation of the double 999999^3 = 9.99997000003E+17
I am banging my head against the wall for a while now trying different techniques.
None of them are working well.
I have two strings.
I need to compare them and get an exact percentage of match,
ie. "four score and seven years ago" TO "for scor and sevn yeres ago"
Well, I first started by comparing every word to every word, tracking every hit, and percentage = count \ numOfWords. Nope, didn't take into account misspelled words.
("four" <> "for" even though it is close)
Then I started by trying to compare every char in each char, incrementing the string char if not a match (to count for misspellings). But, I would get false hits because the first string could have every char in the second but not in the exact order of the second. ("stuff avail" <> "stu vail" (but it would come back as such, low percentage, but a hit. 9 \ 11 = 81%))
SO, I then tried comparing PAIRS of chars in each string. If string1[i] = string2[k] AND string1[i+1] = string2[k+1], increment the count, and increment the "k" when it doesn't match (to track mispellings. "for" and "four" should come back with a 75% hit.) That doesn't seem to work either. It is getting closer, but even with an exact match it is only returns 94%. And then it really gets screwed up when something is really misspelled. (Code at the bottom)
Any ideas or directions to go?
Code
count = 0
j = 0
k = 0
While j < strTempName.Length - 2 And k < strTempFile.Length - 2
' To ignore non letters or digits '
If Not strTempName(j).IsLetter(strTempName(j)) Then
j += 1
End If
' To ignore non letters or digits '
If Not strTempFile(k).IsLetter(strTempFile(k)) Then
k += 1
End If
' compare pair of chars '
While (strTempName(j) <> strTempFile(k) And _
strTempName(j + 1) <> strTempFile(k + 1) And _
k < strTempFile.Length - 2)
k += 1
End While
count += 1
j += 1
k += 1
End While
perc = count / (strTempName.Length - 1)
Edit: I have been doing some research and I think I initially found the code from here and translated it to vbnet years ago. It uses the Levenshtein string matching algorithm.
Here is the code I use for that, hope it helps:
Sub Main()
Dim string1 As String = "four score and seven years ago"
Dim string2 As String = "for scor and sevn yeres ago"
Dim similarity As Single =
GetSimilarity(string1, string2)
' RESULT : 0.8
End Sub
Public Function GetSimilarity(string1 As String, string2 As String) As Single
Dim dis As Single = ComputeDistance(string1, string2)
Dim maxLen As Single = string1.Length
If maxLen < string2.Length Then
maxLen = string2.Length
End If
If maxLen = 0.0F Then
Return 1.0F
Else
Return 1.0F - dis / maxLen
End If
End Function
Private Function ComputeDistance(s As String, t As String) As Integer
Dim n As Integer = s.Length
Dim m As Integer = t.Length
Dim distance As Integer(,) = New Integer(n, m) {}
' matrix
Dim cost As Integer = 0
If n = 0 Then
Return m
End If
If m = 0 Then
Return n
End If
'init1
Dim i As Integer = 0
While i <= n
distance(i, 0) = System.Math.Max(System.Threading.Interlocked.Increment(i), i - 1)
End While
Dim j As Integer = 0
While j <= m
distance(0, j) = System.Math.Max(System.Threading.Interlocked.Increment(j), j - 1)
End While
'find min distance
For i = 1 To n
For j = 1 To m
cost = (If(t.Substring(j - 1, 1) = s.Substring(i - 1, 1), 0, 1))
distance(i, j) = Math.Min(distance(i - 1, j) + 1, Math.Min(distance(i, j - 1) + 1, distance(i - 1, j - 1) + cost))
Next
Next
Return distance(n, m)
End Function
Did not work for me unless one (or both) of following are done:
1) use option compare statement "Option Compare Text" before any Import declarations and before Class definition (i.e. the very, very first line)
2) convert both strings to lowercase using .tolower
Xavier's code must be correct to:
While i <= n
distance(i, 0) = System.Math.Min(System.Threading.Interlocked.Increment(i), i - 1)
End While
Dim j As Integer = 0
While j <= m
distance(0, j) = System.Math.Min(System.Threading.Interlocked.Increment(j), j - 1)
End While
i created a code in VBA to calculate the amount of combinations for stirling numbers of second kind. But in following example only half of the values are correct.
The result should be 1,7,6,1 if n is equal to 4. (Wikipedia stirling numbers
I get 1,7,6.5,4.16
Sub stirlingerzahlen()
Dim n As Integer
Dim sum As Double
Dim subsum As Double
Dim k As Long
Dim j As Long
n = 4
For k = 1 To n Step 1
For j = 0 To k Step 1
subsum = 1 / Application.WorksheetFunction.Fact(k) * (-1) ^ (k - j) * Application.WorksheetFunction.Fact(k) / Application.WorksheetFunction.Fact(j) * j ^ n
sum = sum + subsum
Next
Sheets("Tabelle2").Cells(k, 1) = sum
sum = 0
Next
End Sub
Can someone find the mistake?
There is another version of the formula which seems to be easier to implement:
http://home.mathematik.uni-freiburg.de/junker/ss10/DAS-SS10.pdf
(Page 13)
And here the updated code:
Sub stirlingerzahlen()
Dim n As Integer
Dim sum As Double
Dim subsum As Double
Dim k As Long
Dim j As Long
n = 4
For k = 1 To n Step 1
For j = 0 To k
subsum = (((-1) ^ (k - j)) * ((j ^ n) / (Application.WorksheetFunction.Fact(j) * Application.WorksheetFunction.Fact(k - j))))
sum = sum + subsum
Next
Sheets("Tabelle2").Cells(k, 1) = sum
sum = 0
Next
End Sub