vb.net array.sort() parameters why 1 short? - vb.net

I'm sorting an array using code like this:
Array.Sort(arr, 0, intEndingPosition, New myIComparer)
I want the sorting to start with index 0 and end with index intEndingPosition. However, the last element arr(intEndingPosition) was left out and did not get sorted. Why?
intEndingPosition is calculated beforehand like this:
Dim StringOfConcern As String
Dim OneChar(65534), FrqOne(65534) As String
Dim CntNewOnes, CntRptOnes As Integer
Dim c As Char
Dim i, j As Integer
Dim isNew As Boolean
StringOfConcern = TextBox1.Text
OneChar(0) = CStr(StringOfConcern(0))
FrqOne(0) = 1
i = 0
j = 0
For Each c In StringOfConcern.Substring(1)
isNew = True
For j = 0 To i Step 1
If CStr(c) = OneChar(j) Then
isNew = False
FrqOne(j) += 1
Exit For
End If
Next j
If isNew = True Then
i += 1
OneChar(i) = CStr(c)
FrqOne(i) = 1
End If
Next c
CntNewOnes = i + 1
CntRptOnes = 0
For i = 0 To CntNewOnes - 1 Step 1
If FrqOne(i) > 1 Then CntRptOnes += 1
Next i
The sorting follows here. The code in my original question is only illustrative. The actual sorting is:
Array.Sort(FrqOne, OneChar, 0, CntNewOnes - 1)
Array.Reverse(FrqOne, 0, CntNewOnes - 1)
Array.Reverse(OneChar, 0, CntNewOnes - 1)

Note the method declaration for Array.Sort
Public Shared Sub Sort (
array As Array,
index As Integer,
length As Integer,
comparer As IComparer
)
The third parameter is the number of elements in the range to sort (length) not the end index as you suggest.
So let's assume for a minute that your intEndingPosition is 4. This means you're expecting to sort 5 elements i.e. elements at indices 0, 1, 2, 3, 4. However, the number 4 is the length and not the end index thus you're only sorting elements at indices 0, 1, 2, 3.
This explains why you're observing that the elements being sorted is one shorter than you expected.
Put it simply the third parameter should specify the length of elements to sort and not the end index.
Another Example:
Consider the Substring method of the String class:
Public Function Substring (
startIndex As Integer,
length As Integer
) As String
Then assume we have this piece of code:
Dim temp As String = "testing"
Dim result As String = temp.Substring(0, 4)
result is now a string containing 4 characters as 4 in the Substring call indicates the length that should be retrieved as opposed to the end index.
Had 4 been the end index then you'd expect result to contain 5 characters.

Related

Label a set of objects with (A->Z,AA->ZZ, AAA->ZZZ) in VBA

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

Return dynamic array from function VBA

I am trying to create a function that outputs an array.
However, I got the Function call on left-hand side must return Variant or
Object. How can I return a dynamic array from this function?
Public Function Fibonacci_Array(max As Integer) As Integer
Dim result() As Variant
ReDim result(0 To max)
'' Array indices.
Dim i1 As Integer
Dim i2 As Integer
Dim i As Integer
i1 = 0
i2 = 1
'' Array values.
Dim newVal As Long
Dim prev2 As Long
Dim prev As Long
prev2 = 0
prev = 1
'' Loop through
While prev <= max
result(i1) = prev2
result(i2) = prev
newVal = prev + prev2
''Debug.Print newVal
prev2 = prev
prev = newVal
i1 = i1 + 1
i2 = i2 + 1
Wend
'' Problem here.
Fibonacci_Array() = result
End Function
Variant is the most flexible type when it comes to passing arrays to or from functions.
Replace
Public Function Fibonacci_Array(max As Integer) As Integer
by
Public Function Fibonacci_Array(max As Integer) As Variant
Replace
Dim result() As Variant
by
Dim result As Variant
and replace
Fibonacci_Array() = result
by
Fibonacci_Array = result
That will make it compile, but you seem to need a bit of debugging, since when I then type
?Join(Fibonacci_Array(10),", ")
in the Immediate Window, I get:
0, 1, 1, 2, 3, 5, 8, , , ,
(This might be what you want if you want the Fibonacci numbers which are less than max, but then you might want to use a ReDim Preserve to pare the array down to size before returning it. If your intention was to get the first max Fibonacci numbers, the culprit is the line While prev <= max -- it isn't prev that you would want to compare to max).
On Edit I thought it would be fun to write a VBA function which returns the array of all Fibonacci numbers whose size is <= a given max. Since Fibonacci numbers grow rapidly, I decided to use Long rather than Integer, and also to use Binet's formula to calculate the size of the array (possibly +1 for safety) before filling the array, so we don't allocate an array which is much too large:
Function FibNums(max As Long) As Variant
'returns array consisting of all Fibonacci numbers <= max
'max is assumed to be >= 1
Dim i As Long, n As Long, F As Long
Dim Fibs As Variant
'come up with an upper bound on size of array:
n = 1 + Int(Log(Sqr(5) * max) / Log((1 + Sqr(5)) / 2))
ReDim Fibs(1 To n)
Fibs(1) = 1
Fibs(2) = 1
i = 2
Do While Fibs(i) <= max
F = Fibs(i - 1) + Fibs(i)
If F <= max Then
i = i + 1
Fibs(i) = F
Else
Exit Do 'loop is finished
End If
Loop
'at this stage, Fibs contains i numbers
If i < n Then ReDim Preserve Fibs(1 To i)
FibNums = Fibs
End Function
For example:
?Join(Fibnums(100000),", ")
1, 1, 2, 3, 5, 8, 13, 21, 34, 55, 89, 144, 233, 377, 610, 987, 1597, 2584, 4181, 6765, 10946, 17711, 28657, 46368, 75025
Your return type should be the same and you don't need the parenthesis when you assign the value of the function:
Public Function Fibonacci_Array(max As Integer) As Long()
Dim result() As Long
ReDim result(0 To max)
'' Array indices.
Dim i1 As Integer
Dim i2 As Integer
Dim i As Integer
i1 = 0
i2 = 1
'' Array values.
Dim newVal As Long
Dim prev2 As Long
Dim prev As Long
prev2 = 0
prev = 1
'' Loop through
While prev <= max
result(i1) = prev2
result(i2) = prev
newVal = prev + prev2
''Debug.Print newVal
prev2 = prev
prev = newVal
i1 = i1 + 1
i2 = i2 + 1
Wend
'' Problem here.
Fibonacci_Array = result
End Function
Sub a()
Dim b() As Long
b() = Fibonacci_Array(100)
End Sub

Simple sort algortihm not working - Index issues

I am trying to sort an array using an algorithm, but I am having trouble with my index.
Sub Main()
Dim List() As Integer = {9, 8, 5, 6}
Dim InnerPointer As Integer = 0
Dim CurrentValue As Integer
For OutPointer = 1 To List.Length - 1
CurrentValue = List(OutPointer)
While InnerPointer > 0 And List(InnerPointer) > CurrentValue
List(InnerPointer + 1) = List(InnerPointer)
InnerPointer = InnerPointer - 1
End While
List(InnerPointer + 1) = CurrentValue
Next
For Each element In List
Console.WriteLine(element)
Next
Console.ReadKey()
End Sub
I define InnerPointer as 0 because my array is 0 index based, but this means my While Loop wont kick in...and yet I do want to compare index 0 with index 1 to determine which number is bigger. I cant for the life of me work out where the logical fallacy is

How to Add the value from combobox

Is there any other way to sum all the items on the combo box
I'm trying to sum all the value on the combo box
this is my code:
For a As Integer = 0 To ComboBox1.Items.Count - 1
Dim b As Integer
b = ComboBox1.Items(a)
MetroLabel12.Text = ComboBox1.Items.Count(0) + b
Next b
The following code will take the string value of each item and try to convert it to integer. If successful, it will add the result to result.
Dim result as Integer = 0
Dim num as Integer = 0
For Each s As String In ComboBox1.Items
num = 0
If Integer.TryParse(s, num) Then
result = result + num;
End If
Next s

How to compare Strings for Percentage Match using vb.net?

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