How to split a string into an array of individual characters - vb6

I have this textbox named txtnum in which I have to enter a 15 digit number and allocate it to variable num. I want to split the number into individual characters so that j can carry out calculations on each. Something like: product= arraynum[2]*2 . how do I split the string in the text box into array characters?

Nothing is built-in (as far as I know), but it I easy enough to write a function which takes a string and returns an array of characters:
Function ToArray(s As String) As Variant
Dim A As Variant
Dim i As Long, n As Long
n = Len(s)
ReDim A(0 To n - 1)
For i = 0 To n - 1
A(i) = Mid(s, i + 1, 1)
Next i
ToArray = A
End Function
Having done this, there is little actual gain from using a function like this as opposed to simply using Mid().

Here is another option:
Dim s As Variant
s = "012345678901234"
s = StrConv(s, vbUnicode)
s = Split(s, vbNullChar)
s will contain an array of characters.

Related

Finding the sum of characters in a text box

I have a text box with characters got from a calculation in my code . the textbox specifically contains only integers... Is there a way I can sum up the integers in the text box? Eg. If my textbox has 123456, the code should find the sum of 1+2+3+4+5+6 and then display the sum in another text box. Thank you in advance
VB6
Public Sub Calculate()
Dim i As Integer
Dim sum As Integer
Dim length As Integer
i = 1
sum = 0
length = Len(TextBox1.Text)
While i <= length
sum = sum + Mid(TextBox1.Text, i, 1)
i = i + 1
Wend
TextBox2.Text = sum
End Sub
Use Mid$() and Len() functions to retrieve number by number and add it (+) to the Total (sum).
EDIT:
Dim total As Integer, i As Integer
For i = 1 To Len(Trim$(Text1.Text))
total = total + CInt(Mid$(Text1.Text, i, 1))
Next i
Text2.Text = total

Convert alphanumeric string to given values for each, then add them for a total number

I'm having a difficult time wording exactly what I'm doing, but basically I have variable length alphanumeric data being fed to a program, and I want to find out the total "pixel width" of the string, based on a fixed list of A = 3 pxl, B = 3 pxl, I = 1 pxl, etc...
I would list all of the pixel values of each letter and number, and then would like the script to take the input: ex. "THIS IS THE STRING", and convert it to the numbers I've assigned add them up and total them giving me the total sum as an output (I would also assign a number for a space " " and punctuation).
So: "THIS IS A STRING" would be "3+3+1+3+2+1+3+2+3+3+3+2+3+3+3+1+3+3 = 45"
You need a table/array of pixel widthes indexed by ASCII codes. Then you can loop over the string's characters and sum the widthes. Like:
>> Dim a(255)
>> a(65) = 3
>> a(66) = 3
>> a(Asc("I")) = 1
>> s = "AIB"
>> n = 0
>> For p = 1 To Len(s)
>> n = n + a(Asc(Mid(s, p, 1)))
>> Next
>> WScript.Echo n
>>
7

Generate first 10 numbers of a sequence

I have been trying to create this sequence:
2,7,17,37,67,...
I have to print first 10 numbers of the series.
To do this, I have created the following:
option explicit
Dim m,n,i,str,d
m=2
d=10
n=7
For i=0 to 10
n=n+d
d=d+10
str=str&n&vbcrlf
msgbox str
next
I am unable to print first two numbers, 2 and 7, as they are declared before the for loop. Even if I store them in a variable called str, they get printed after every execution. Is there a way to add these two and print them only once.
You could add your initial value of m to your string before you start running your sequence. Then, append the value of n to your string at the start of your loop instead of the end so that you capture n's initial value. For example:
m=2: d=10: n=7
str = m & vbCrLf ' Capture initial value of m
For i = 1 to 9
str = str & n & vbCrLf ' Capture initial value of n
n = n + d
d = d + 10
Next
MsgBox str
Note that you're only looping 9 times now, since you've already captured the first number in your sequence (m) prior to your loop.
I also moved MsgBox outside your loop so that it only appears once, after the full 10-number sequence has been generated.

Combining two lists with minimum distance between elements

I have to lists like these:
a = ["1a","2a","3a","4a","5a","6a","7a","8a","9a","10a","11a","12a","13a","14a"]
b = ["1b","2b","3b","4b","5b","6b","7b","8b","9b","10b","11b","12b","13b","14b"]
And what I want is to combine them, so that there is at least a difference of n elements between an element from a and it's corresponding element in b.
As an example, if my n is 10, and "3a" is in position 3 and "3b" is in position 5, that isn't a solution since there's only a distance of 2 between these corresponding elements.
I have already solved this for the purpose I want through a brute force method: shuffle the union of the two arrays and see if the constraint is met; if not, shuffle again and so on... Needless to say, that for 14 elements array, sometimes there is 5 to 10 second computation to yield a solution with a minimum distance of 10. Even though that's kind of ok for what I am looking for, I am curious about how I could solve this in a more optimized way.
I am currently using Python, but code in any language (or pseudo-code) is more than welcomed.
EDIT: The context of this problem is something like a questionnarie, in which around 100 participants are expected to join in. Therefore, I am not necessarily interested in all the solutions, but rather something like the first 100.
Thanks.
For your specific scenario, you could use a randomized approach -- though not as random as what you've already tried. Something like this:
start with a random permutation of the items in both lists
create a new permutation by creating a copy of the other and randomly swapping two items
measure the quality of the permutations, e.g., the sum of the distances of each pair of related items, or the minimum of such distances
if the quality of the new permutation is better than that of the original permutation, keep the new one, otherwise discard the new one and continue with the original permutation
repeat from 2. until each distance is at least 10 or until quality does not improve over a number of iterations
The difference to shuffling the whole list in each iteration (as in your approach) is that in each iteration the permutation can only get better, until a satisfying solution is found.
Each time you run this algorithm, the result will be slightly different, so you can run it 100 times for 100 different solutions. Of course, this algorithm does not guarantee to find a solution (much less all such solutions), but it should be fast enough so that you could just restart it in case it fails.
In Python, this could look somewhat like this (slightly simplified, but still working):
def shuffle(A, B):
# original positions, i.e. types of questions
kind = dict([(item, i) for i, item in list(enumerate(A)) + list(enumerate(B))])
# get positions of elements of kinds, and return sum of their distances
def quality(perm):
pos = dict([(kind[item], i) for i, item in enumerate(perm)])
return sum(abs(pos[kind[item]] - i) for i, item in enumerate(perm))
# initial permutation and quality
current = A + B
random.shuffle(current)
best = quality(current)
# improve upon initial permutation by randomly swapping items
for g in range(1000):
i = random.randint(0, len(current)-1)
j = random.randint(0, len(current)-1)
copy = current[:]
copy[i], copy[j] = copy[j], copy[i]
q = quality(copy)
if q > best:
current, best = copy, q
return current
Example output for print shuffle(a, b):
['14b', '2a', '13b', '3a', '9b', '4a', '6a', '1a', '8a', '5b', '12b', '11a', '10b', '7b', '4b', '11b', '5a', '7a', '8b', '12a', '13a', '14a', '1b', '2b', '3b', '6b', '10a', '9a']
As I understand from your question, it is possible to perform all the ordering by relying exclusively on the indices of the arrays (i.e., on pure integers) and thus the problem can be reduced to create (valid) ranges instead of analysing each element.
for each a <= total_items-n , valid b = if(a + n == total_items){total_items} else{[a + n, total_items]}
For example:
n = 10;
total_items = 15;
for a = 1 -> valid b = [11, 15]
for a = 2 -> valid b = [12, 15]
, etc.
This would be perfomed 4 times: forwards and backwards for a respect to b and the same for b respect to a.
In this way you would reduce the number of iterations to its minimum expression and would get, as an output, a set of "solutions" for each position, rather than a one-to-one binding (that is what you have right now, isn't it?).
If there are equivalents in Python to .NET's Lists and LINQ, then you may be able to directly convert the following code. It generates up to 100 lists really quickly: I press "debug" to run it and up pops a windows with the results in much less than a second.
' VS2012
Option Infer On
Module Module1
Dim minDistance As Integer = 10
Dim rand As New Random ' a random number generator
Function OkToAppend(current As List(Of Integer), x As Integer) As Boolean
' see if the previous minDistance values contain the number x
Return Not (current.Skip(current.Count - minDistance).Take(minDistance).Contains(x))
End Function
Function GenerateList() As List(Of String)
' We don't need to start with strings: integers will make it faster.
' The "a" and "b" suffixes can be sprinkled on at random once the
' list is created.
Dim numbersToUse() As Integer = {1, 2, 3, 4, 5, 6, 7, 8, 9, 10, 11, 12, 13, 14}
Dim pool As New List(Of Integer)
' we need all the numbers twice
pool.AddRange(numbersToUse)
pool.AddRange(numbersToUse)
Dim newList As New List(Of Integer)
Dim pos As Integer
For i = 0 To pool.Count - 1
' limit the effort it puts in
Dim sanity As Integer = pool.Count * 10
Do
pos = rand.Next(0, pool.Count)
sanity -= 1
Loop Until OkToAppend(newList, pool(pos)) OrElse sanity = 0
If sanity > 0 Then ' it worked
' append the value to the list
newList.Add(pool(pos))
' remove the value which has been used
pool.RemoveAt(pos)
Else ' give up on this arrangement
Return Nothing
End If
Next
' Create the final list with "a" and "b" stuck on each value.
Dim stringList As New List(Of String)
Dim usedA(numbersToUse.Length) As Boolean
Dim usedB(numbersToUse.Length) As Boolean
For i = 0 To newList.Count - 1
Dim z = newList(i)
Dim suffix As String = ""
If usedA(z) Then
suffix = "b"
ElseIf usedB(z) Then
suffix = "a"
End If
' rand.Next(2) generates an integer in the range [0,2)
If suffix.Length = 0 Then suffix = If(rand.Next(2) = 1, "a", "b")
If suffix = "a" Then
usedA(z) = True
Else
usedB(z) = True
End If
stringList.Add(z.ToString & suffix)
Next
Return stringList
End Function
Sub Main()
Dim arrangements As New List(Of List(Of String))
For i = 1 To 100
Dim thisArrangement = GenerateList()
If thisArrangement IsNot Nothing Then
arrangements.Add(thisArrangement)
End If
Next
'TODO: remove duplicate entries and generate more to make it up to
' the required quantity.
For Each a In arrangements
' outputs the elements of a with ", " as a separator
Console.WriteLine(String.Join(", ", a))
Next
' wait for user to press enter
Console.ReadLine()
End Sub
End Module

Algorithms for "fuzzy matching" strings

By fuzzy matching I don't mean similar strings by Levenshtein distance or something similar, but the way it's used in TextMate/Ido/Icicles: given a list of strings, find those which include all characters in the search string, but possibly with other characters between, preferring the best fit.
I've finally understood what you were looking for. The issue is interesting however looking at the 2 algorithms you found it seems that people have widely different opinions about the specifications ;)
I think it would be useful to state the problem and the requirements more clearly.
Problem:
We are looking for a way to speed up typing by allowing users to only type a few letters of the keyword they actually intended and propose them a list from which to select.
It is expected that all the letters of the input be in the keyword
It is expected that the letters in the input be in the same order in the keyword
The list of keywords returned should be presented in a consistent (reproductible) order
The algorithm should be case insensitive
Analysis:
The first two requirements can be sum up like such: for an input axg we are looking for words matching this regular expression [^a]*a[^x]*x[^g]*g.*
The third requirement is purposely loose. The order in which the words should appear in the list need being consistent... however it's difficult to guess whether a scoring approach would be better than alphabetical order. If the list is extremy long, then a scoring approach could be better, however for short list it's easier for the eye to look for a particular item down a list sorted in an obvious manner.
Also, the alphabetical order has the advantage of consistency during typing: ie adding a letter does not completely reorder the list (painful for the eye and brain), it merely filters out the items that do not match any longer.
There is no precision about handling unicode characters, for example is à similar to a or another character altogether ? Since I know of no language that currently uses such characters in their keywords, I'll let it slip for now.
My solution:
For any input, I would build the regular expression expressed earlier. It suitable for Python because the language already features case-insensitive matching.
I would then match my (alphabetically sorted) list of keywords, and output it so filtered.
In pseudo-code:
WORDS = ['Bar', 'Foo', 'FooBar', 'Other']
def GetList(input, words = WORDS):
expr = ['[^' + i + ']*' + i for i in input]
return [w for w in words if re.match(expr, w, re.IGNORECASE)]
I could have used a one-liner but thought it would obscure the code ;)
This solution works very well for incremental situations (ie, when you match as the user type and thus keep rebuilding) because when the user adds a character you can simply refilter the result you just computed. Thus:
Either there are few characters, thus the matching is quick and the length of the list does not matter much
Either there are a lots of characters, and this means we are filtering a short list, thus it does not matter too much if the matching takes a bit longer element-wise
I should also note that this regular expression does not involve back-tracking and is thus quite efficient. It could also be modeled as a simple state machine.
Levenshtein 'Edit Distance' algorithms will definitely work on what you're trying to do: they will give you a measurement of how closely two words or addresses or phone numbers, psalms, monologues and scholarly articles match each other, allowing you you rank the results and choose the best match.
A more lightweight appproach is to count up the common substrings: it's not as good as Levenshtein, but it provides usable results and runs quickly in slow languages which have access to fast 'InString' functions.
I published an Excel 'Fuzzy Lookup' in Excellerando a few years ago, using 'FuzzyMatchScore' function that is, as far as I can tell, exactly what you need:
http://excellerando.blogspot.com/2010/03/vlookup-with-fuzzy-matching-to-get.html
It is, of course, in Visual Basic for Applications. Proceed with caution, crucifixes and garlic:
Public Function SumOfCommonStrings( _
ByVal s1 As String, _
ByVal s2 As String, _
Optional Compare As VBA.VbCompareMethod = vbTextCompare, _
Optional iScore As Integer = 0 _
) As Integer
Application.Volatile False
' N.Heffernan 06 June 2006
' THIS CODE IS IN THE PUBLIC DOMAIN
' Function to measure how much of String 1 is made up of substrings found in String 2
' This function uses a modified Longest Common String algorithm.
' Simple LCS algorithms are unduly sensitive to single-letter
' deletions/changes near the midpoint of the test words, eg:
' Wednesday is obviously closer to WedXesday on an edit-distance
' basis than it is to WednesXXX. So it would be better to score
' the 'Wed' as well as the 'esday' and add up the total matched
' Watch out for strings of differing lengths:
'
' SumOfCommonStrings("Wednesday", "WednesXXXday")
'
' This scores the same as:
'
' SumOfCommonStrings("Wednesday", "Wednesday")
'
' So make sure the calling function uses the length of the longest
' string when calculating the degree of similarity from this score.
' This is coded for clarity, not for performance.
Dim arr() As Integer ' Scoring matrix
Dim n As Integer ' length of s1
Dim m As Integer ' length of s2
Dim i As Integer ' start position in s1
Dim j As Integer ' start position in s2
Dim subs1 As String ' a substring of s1
Dim len1 As Integer ' length of subs1
Dim sBefore1 ' documented in the code
Dim sBefore2
Dim sAfter1
Dim sAfter2
Dim s3 As String
SumOfCommonStrings = iScore
n = Len(s1)
m = Len(s2)
If s1 = s2 Then
SumOfCommonStrings = n
Exit Function
End If
If n = 0 Or m = 0 Then
Exit Function
End If
's1 should always be the shorter of the two strings:
If n &GT; m Then
s3 = s2
s2 = s1
s1 = s3
n = Len(s1)
m = Len(s2)
End If
n = Len(s1)
m = Len(s2)
' Special case: s1 is n exact substring of s2
If InStr(1, s2, s1, Compare) Then
SumOfCommonStrings = n
Exit Function
End If
For len1 = n To 1 Step -1
For i = 1 To n - len1 + 1
subs1 = Mid(s1, i, len1)
j = 0
j = InStr(1, s2, subs1, Compare)
If j &GT; 0 Then
' We've found a matching substring...
iScore = iScore + len1
' Now clip out this substring from s1 and s2...
' And search the fragments before and after this excision:
If i &GT; 1 And j &GT; 1 Then
sBefore1 = left(s1, i - 1)
sBefore2 = left(s2, j - 1)
iScore = SumOfCommonStrings(sBefore1, _
sBefore2, _
Compare, _
iScore)
End If
If i + len1 &LT; n And j + len1 &LT; m Then
sAfter1 = right(s1, n + 1 - i - len1)
sAfter2 = right(s2, m + 1 - j - len1)
iScore = SumOfCommonStrings(sAfter1, _
sAfter2, _
Compare, _
iScore)
End If
SumOfCommonStrings = iScore
Exit Function
End If
Next
Next
End Function
Private Function Minimum(ByVal a As Integer, _
ByVal b As Integer, _
ByVal c As Integer) As Integer
Dim min As Integer
min = a
If b &LT; min Then
min = b
End If
If c &LT; min Then
min = c
End If
Minimum = min
End Function
Two algorithms I've found so far:
LiquidMetal
Better Ido Flex-Matching
I'm actually building something similar to Vim's Command-T and ctrlp plugins for Emacs, just for fun. I have just had a productive discussion with some clever workmates about ways to do this most efficiently. The goal is to reduce the number of operations needed to eliminate files that don't match. So we create a nested map, where at the top-level each key is a character that appears somewhere in the search set, mapping to the indices of all the strings in the search set. Each of those indices then maps to a list of character offsets at which that particular character appears in the search string.
In pseudo code, for the strings:
controller
model
view
We'd build a map like this:
{
"c" => {
0 => [0]
},
"o" => {
0 => [1, 5],
1 => [1]
},
"n" => {
0 => [2]
},
"t" => {
0 => [3]
},
"r" => {
0 => [4, 9]
},
"l" => {
0 => [6, 7],
1 => [4]
},
"e" => {
0 => [9],
1 => [3],
2 => [2]
},
"m" => {
1 => [0]
},
"d" => {
1 => [2]
},
"v" => {
2 => [0]
},
"i" => {
2 => [1]
},
"w" => {
2 => [3]
}
}
So now you have a mapping like this:
{
character-1 => {
word-index-1 => [occurrence-1, occurrence-2, occurrence-n, ...],
word-index-n => [ ... ],
...
},
character-n => {
...
},
...
}
Now searching for the string "oe":
Initialize a new map where the keys will be the indices of strings that match, and the values the offset read through that string so far.
Consume the first char from the search string "o" and look it up in the lookup table.
Since strings at indices 0 and 1 match the "o", put them into the map {0 => 1, 1 => 1}.
Now search consume the next char in the input string, "e" and loo it up in the table.
Here 3 strings match, but we know that we only care about strings 0 and 1.
Check if there are any offsets > the current offsets. If not, eliminate the items from our map, otherwise update the offset: {0 => 9, 1 => 3}.
Now by looking at the keys in our map that we've accumulated, we know which strings matched the fuzzy search.
Ideally, if the search is being performed as the user types, you'll keep track of the accumulated hash of results and pass it back into your search function. I think this will be a lot faster than iterating all search strings and performing a full wildcard search on each one.
The interesting thing about this is that you could also efficient store the Levenstein Distance along with each match, assuming you only care about insertions, not substitutions or deletions. Though perhaps it's not hard to get that logic added too.
I recently had to solve the same problem. My solution involves scoring strings with consecutively matched letters highly and excluding strings that don't contain the typed letters in order.
I've documented the algorithm in detail here: http://blog.kazade.co.uk/2014/10/a-fuzzy-filename-matching-algorithm.html
If your text is predominantly English then you may try your hand at various Soundex algorithms
1. Classic soundex
2. Metafone
These algorithms will let you choose words which sound like each other and will be a good way to find misspelled words.

Resources