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.
Related
I'm trying to list all numbers with 3 digits where the individual digits sum to a given number.
So far I can return a list of all numbers using this Visual Basic code:
target = 17
i = 1
j = 1
k = 1
Do While i < 10
Do While j < 10
Do While k < 10
r = i + j + k
If r = target Then
If i <> j And j <> k And k <> i Then
lsNumbers.Add(i & j & k )
End If
End If
k += 1
Loop
If k = 10 Then k = 1
j += 1
Loop
If j = 10 Then j = 1
i += 1
Loop
But I want only unique, non repeating combinations.
For example for the target number 17:
179, 197, 269, 278, 287...
I want to be able to test the current number before I add it to the list, to check if it is a combination of a number already in the list - so 197 would fail because of 179, and 287 would fail because of 278
Observations
Just curious, is excluding the 0 digit on purpose?
To iterate through the possible digits, a well suited instruction pair is FOR NEXT. Definitely simpler than the DO WHILE that you used.
Loop
If k = 10 Then k = 1
Loop
If j = 10 Then j = 1
Upon loop completion, the iterator is sure to contain 10. The IF is redundant.
Solution
In order to check if a number, that obeys the condition, is unique in the sense that it is not composed of the same 3 digits as an already validated number, you could consult a 3-D array. If the new number corresponds to a non-zero element in this array, it means that the new number would be using the same digits as an earlier number. That's reason to reject it.
Next code runs in QBasic. You'll have no trouble rewriting it for Visual BASIC.
DIM r%(1 TO 9, 1 TO 9, 1 TO 9)
FOR i% = 1 TO 9
FOR j% = 1 TO 9
FOR k% = 1 TO 9
r%(i%, j%, k%) = 0
NEXT
NEXT
NEXT
target% = 17
FOR i% = 1 TO 9
FOR j% = 1 TO 9
FOR k% = 1 TO 9
IF i% + j% + k% = target% THEN
IF r%(i%, j%, k%) = 0 THEN
PRINT i% * 100 + j% * 10 + k%; " ";
r%(i%, j%, k%) = 1 ' Could do without this one because of the ascending order
r%(i%, k%, j%) = 1
r%(j%, i%, k%) = 1
r%(j%, k%, i%) = 1
r%(k%, i%, j%) = 1
r%(k%, j%, i%) = 1
END IF
END IF
NEXT
NEXT
NEXT
This is my output of valid numbers:
179 188 269 278 359 368 377 449 458 467 557 566
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 am looping through a card number finding all the odd numbers and multiplying them by the card digits. Its kind of hard to explain. I am having trouble multiplying the odd number and the card number. Here's an example my teacher gave me. You multiply card number 1 and and odd number 1 and so forth. I am not getting any errors, it just kind of freezes.
Sums
Card #: 1 2 3 4 5 6 7 8 9 0 1 2 3 4 5 6
Multiples 1 2 3 4 5 6 7 8
Evens: 2 4 6 8 0 2 4 6 32 =Sum 1
Odds: 1 6 15 28 45 6 21 40 162 =Sum 2
Sum 3: 194
194 =Sum 3
Step 4: =1+9+4 = 14
= 1 + 4 = 5 = check digit
Public Class Payment
Private Sub OK_Click(sender As Object, e As EventArgs) Handles OK.Click
Dim Sum1 = 0
Dim Sum2 = 0
Dim Sum3 = 0
Dim ready As Boolean
Dim ccnumb = CardNumber.Text
Format(CardNumber.Text, "################")
Dim exp = Mid(ExpDate.Text, 1, 3)
Dim checkdigit = 0
If FullName.TextLength = 0 Or cardtype.Text.Length = 0 And ccnumb.Length <= 16 Or exp.Length = 2 Then
MessageBox.Show("Please enter all credit card information before proceeding.")
ready = False
Else ready = True
End If
If ready = True Then
For Each num As Char In ccnumb
If CInt(CStr(num)) Mod 2 <> 0 Then
Sum1 += CInt(CStr(num)) * CInt(CStr(num)) Mod 2 <> 0
Else
Sum2 += CInt(CStr(num))
End If
Next
Sum3 = Sum1 + Sum2
Do While Sum3 > 10
For j = 0 To Sum3.ToString.Length - 1
For k = 1 To Sum3.ToString.Length - 1
Sum3 = j + k
Next
Next
Loop
Do While exp.Length > 1
checkdigit = Mid(ExpDate.Text, 1, 1) + Mid(ExpDate.Text, 1, 2)
Loop
If Sum3 = checkdigit Then
MessageBox.Show("Congratulations! Your payment was successful.")
CustInv.Show()
Else MessageBox.Show("The checkdigit," & Space(1) & Sum3 & Space(1) & "does not match the month code," & Space(1) & checkdigit & "." & Space(1) & "Please reenter your card information.")
End If
End If
End Sub
"it kind of freezes" is lay speak for "my code enters an infinite loop".
This looks suspicious:
Do While Sum3 > 10
For j = 0 To Sum3.ToString.Length - 1
For k = 1 To Sum3.ToString.Length - 1
Sum3 = j + k
Next
Next
Loop
To enter the loop, Sum3 must be greater than 10. For the loop to exit, Sum3 must not be greater than 10, but your code only increments Sum3, so Sum3 can only stay greater than 10.
This means that once entered, this loop is infinite.
If changing outer loop to inside loop doesn't help you
Try this
Do While Sum3 > 10 and j < sum3 ' adding j < sum3 might stop the loop
For j = 0 To Sum3.ToString.Length - 1
For k = 1 To Sum3.ToString.Length - 1
Sum3 = j + k
Next
Next
Loop
I have this crazy array.
ReDim arrayDeCeldas(filas - 1, columnas - 1)
For i = 0 To filas - 1
For j = 0 To columnas - 1
arrayDeCeldas(i, j) = i & j
Debug.Write(arrayDeCeldas(i, j) & " ")
Next j
Debug.WriteLine("")
Next i
And I'm trying to link it to a number of conditions and is not well to do
I'm trying to try to get 6 index from array
The number can't repeat and it are pick horizontally or vertically randomly
0 1 2 3 4 5 6 7
10 11 12 13 14 15 16 17
20 21 22 23 24 25 26 27
30 31 32 33 34 35 36 37
40 41 42 43 44 45 46 47
This example about i'm try.
It can be seen, there are a total of 6 items with different sizes
Actually my code, it's getting huge
Private Sub setBarco()
Dim numeroRandom As New System.Random()
Dim indiceA, indiceB As Integer
For b = 1 To barcos
Randomize()
Dim value As Integer = CInt(Int((2 * Rnd() + 1)))
indiceA = numeroRandom.Next(0, filas)
indiceB = numeroRandom.Next(0, columnas)
Select Case b
Case 1
If arrayDeCeldas(indiceA, indiceB) = 0 Then
arrayDeCeldas(indiceA, indiceB) = b & 1
End If
Case 2
Select Case value
Case 1
For c = 0 To 1
If indiceB + c < columnas Then
If arrayDeCeldas(indiceA, indiceB + c) = 0 Then
arrayDeCeldas(indiceA, indiceB + c) = b & c
End If
Else
If arrayDeCeldas(indiceA, indiceB - c) = 0 Then
arrayDeCeldas(indiceA, indiceB - c) = b & c
End If
End If
Next
Case 2
For c = 0 To 1
If indiceA + c < filas Then
If arrayDeCeldas(indiceA + c, indiceB) = 0 Then
arrayDeCeldas(indiceA + c, indiceB) = b & c
Else
End If
Else
End If
Next
End Select
Case 3
Case 4
Case 5
Case 6
End Select
Next b
End Sub
Based on your comment-reply, I understand the program must:
Pick at random any six elements from a 2D-array, and each element or value must be selected only once.
That's fairly straightforward: here's a pseudo-code implementation:
Perform some initial computation:
Get the bounds of the 2D array
Seed a random number generator:
Create a HashSet instance
Get six pairs of coordinates:
Loop continuously until HashSet has 6 elements in it:
Generate a coordinate pair within the bounds of the array found in Step 1.
Get the value from the coordinate pair
Check to see if we've seen the value before (by looking at the HashSet). If we've not seen it before, then add it to the HashSet and continue, otherwise ignore it and try again.
Return the contents of the HashSet
In C# this would be:
Int32[,] numbers = new Int32[] { ... };
Int32 maxY = numbers.GetUpperBound(0); // y-axis in dimension 0
Int32 maxX = numbers.GetUpperBound(1); // x-axis in dimension 1
Random rng = new Random();
HashSet<Int32> values = new HashSet<Int32>();
while( values.Count < 6 ) {
Int32 x = rng.Next( maxX + 1 ); // Random.Next is upperbound exclusive, hence +1
Int32 y = rng.Next( maxY + 1 );
Int32 value = numbers[ y, x ];
if( !values.Contains( value ) ) values.Add( value );
}
return values.ToArray();
Note that by keeping track of observed values, instead of coordinates, we can simultaneously avoid duplicate values and duplicate coordinates: as duplicate coordinates will give you duplicate values anyway.
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