VB: Calcute mean/average for udt array - vb6

I have an array of a struct
Private Type udtSingle
Dim Count As Long
Dim Value As Single
end Type
Private m(2) As udtSingle
Let's say the array is filled like this:
m(0).Count = 5
m(0).Value = 100
m(1).Value = 1
m(1).Count = 10
You can see that we have 5*100 and 1*10.
What would be the best way to calcuate the average?
for i as integer = 0 to m.upperbound()
cAll += m(i).Count * m(i).Value
iCount+=m(i).Count
next i
dim average as currency
average = cAll / iCount
That would work, but I have really many .Count and high .Value, and I am afraid of an overflow.
What else could I do, please?
If the array gets really huge, I will get an overflow anyway. Can I not calculate the average anew within the for-next-statement? I guess so, but I can think of an elegant solution.
ps: Yes, I know, the code is kind of pseudo-code...

Declare cAll as Double to avoid an overflow.
Dim cAll as Double
and then
cAll += Convert.ToDouble(m(i).Count) * Convert.ToDouble(m(i).Value)
Double range is up to approximately ±1.7 × 10^308.

Related

Elegant way to pass as an optional parameter to make the subroutine work as if it was omitted?

In VB6, the function Mid(string, start, [length]) has an optional parameter length. If omitted, the whole characters after the start bound will be passed.
Say I want this default behaviour only in a certain condition:
s = Mid(s, i, IIf(condition, j, TheValue)) ' What could be TheValue?
Since length is of Variant type, I tried Empty. It didn't work. Neither did -1 and Nothing.
I didn't want to duplicate to Mid call in an If-Then-Else clause or somehow else. Is this possible?
Here is a working sample with OP's s = Mid(s, i, IIf(condition, j, TheValue)) line
Option Explicit
Property Get TheValue(Optional RetVal As Variant)
TheValue = RetVal
End Property
Private Sub Form_Load()
Dim s As String
Dim i As Long
Dim j As Long
Dim condition As Boolean
s = "test test test"
i = 6: j = 3
condition = False
s = Mid(s, i, IIf(condition, j, TheValue)) '<--- this works!
Debug.Print s
End Sub
Notice how TheValue returns a "missing" Variant i.e. one which tests positive for IsMissing and can be used in place of optional parameters instead of not passing actual argument.
No such value exists. When you omit the length parameter, the compiler chooses a different path through the VBRT -- it produces different code. If you want to emulate that, you need to do the same thing, using an If-Else or similar construct to handle the two cases, like #ÉtienneLaneville suggests
As an alternative to #Étienne's solution, VB provides the IsMissing method:
Public Function Mid(p_sString As String, p_iStart As Integer, Optional p_iLength As Integer) As String
If IsMissing(p_iLength) Then
Mid = VBA.Mid(p_sString, p_iStart)
Else
Mid = VBA.Mid(p_sString, p_iStart, p_iLength)
End If
End Function
And as this wrapper method returns a string, I suggest using the String verions of Mid, which is Mid$. The later is slightly faster than the Variant version (Mid)
This was nicely explained at this site, but at the time of this posting, the request times out. Not sure if gone forever or just a temporary problem.
You could define your own Mid function:
Public Function Mid(p_sString As String, p_iStart As Integer, Optional p_iLength As Integer = -1) As String
If p_iLength < 0 Then
Mid = VBA.Mid(p_sString, p_iStart)
Else
Mid = VBA.Mid(p_sString, p_iStart, p_iLength)
End If
End Function
This should work with the code from your question, using -1 (or any negative integer) as TheValue.
In c++, std::string these optional arguments are represented by either 0 when the default effect is zero position or length or std::string::npos when it is "infinite" length. You can explicitly supply that value and get the same behaviour.
I don't know what the equivalent constant is in m/s strings [In fact it is a different function definition, so there isn't one]. The alternative would be to pass in the string length, as that is the longest length currently possible.
The ?: ternary operator is an easy way to present 2 values with a condition to choose between them.

Generating Random Numbers and Letters

Keep getting this error sometimes when mid is ZERO:
Invalid procedure call or argument: 'Mid'
How would I fix this?
Function CreateRandomString(iSize)
Const VALID_TEXT = "abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ1234567890"
Dim sNewSearchTag
Dim I
For I = 0 To iSize
Randomize
sNewSearchTag = sNewSearchTag & Mid(VALID_TEXT,Round(Rnd * Len(VALID_TEXT)),1)
Next
CreateRandomString = sNewSearchTag
End Function
For the random range to be correct you need to make sure the random value generated is between 1 and the length of the VALID_TEXT string value.
The simple formula to do this using Rnd() is
(Rnd() * Len(VALID_TEXT)) + 1
also move Randomize() outside the loop, as it is you'll just make it less random as you're resetting the seed with every iteration of the loop.
The reason for the error is Mid() expects a valid start and size, which a zero value is not. See this question for more information.
More information about random number ranges can be found in this answer to another question.
The second argument of Mid is 1 based. That means that if you did:
Mid(VALID_TEXT,1,1)
you will get "a", not "b" as you might be expecting.
An easy fix would be to add 1 to the second argument, but then you'll run into the same problem on the top end. Typically people will round a random number down after multiplying it instead of using Math.Round, either view Math.Floor or Integer truncation.

How to choose an random object depending on its attribute

I have an array filled with objects, each object has an attribute named amount. I want to subtract a given number evenly from random objects based on the amount.
I'll better explain it on the following example:
Dim subtractBy as integer = 5 'means i want to substract a total of 5
Dim Generator As System.Random = New System.Random()
While (subtractBy > 0)
Dim randomItem = array2(Generator.Next(0, array2.Count))
If (randomItem.amount > 0 ) Then
randomItem.changeAmountBy(-1)
subtractBy = subtractBy - 1
End If
End While
The problem with that example is, every object has the same chance to be choosen for substraction. I want that every object gets higher chances linear to the amount atribute. So an object with amount=6 has 6x higher chance to be selected than the object with amount=1 and so on.
(Althought the example is in VB, I appreciate also general non-code answers)
Thank you

How to decrease a value in a text box in VB6

I am a noob to VB and I need to know how its done.
Haven't done VB in 3 years cannot remember much of it.
The textbox has a value in it (5.43), and it needs to be decreased by 0.34.
But this is the code:
TextBox3.Text = Val(TextBox3.Text) -0.34
How do I do this?
THIS IS VB 6 by the way
TextBox3.Text = CDbl(TextBox3.Text) - 0.34
Because your initial value has parenthesis (5.34) you must convert it to a specific number before operating on in.
Val does not recognize values in parens being negative. The Val() function in your original example is converting it to 0 in the same way that val("abcd") will also return 0 because it assumes both are strings.
You can test these conditions in the immediate window to quickly see the results.
Haven't tried it, but could be:
TextBox3.Text = Cdbl(TextBox3.Text) -0.34
The following code will do it:
TextBox3.Text = Cstr(CDbl(TextBox3.Text) - 0.34)
But you should be aware what is going on.
The TextBox does not store a double type, it stores a string type. The above code attempts to convert the string to a double, subtract your constant value from it, and convert it back to a string.
You should ask yourself what should happen if the string in the text box is not a valid number. In the above code, Double.Parse() will throw an exception. Double.TryParse() will return whether the conversion was successful.
Or is it impossible to enter a non-number into the text box? In which case, the safety check is unnecessary, though advisable.
You need to ask these questions when doing type conversions, or your program will behave unpredictably when a value is not convertible to the type you expected.
A safer way to decrement it would be:
Const DECREMENT_VALUE As Double = 0.34
Dim isDouble As Boolean
isDouble = IsNumeric(TextBox3.Text)
If isDouble Then
Dim newValue As Double
newValue = CDbl(TextBox3.Text)
newValue = newValue - DECREMENT_VALUE
TextBox3.Text = CStr(newValue)
Else
MsgBox "The Value was not a Double! Could not Decrement!"
End If
Try this.. It might just work
Dim TxtValue as Integer
TxtValue = TextBox3.Text
Since TxtValue is Integer, the decimal will be automatically dropped.
Like this??
TextBox3.Text=Double.Parse(TextBox3.Text)-0.43
This will work in C#
double number = Convert.ToDouble(textBox1.Text);
number = number - .34;

What's the best way of hashing this complex structure in VB6?

I have the following structures defined (names are anonymised, but data types are correct):
Public Type ExampleDataItem
Limit As Integer ' could be any value 0-999
Status As Integer ' could be any value 0-2
ValidUntil As Date ' always a valid date
End Type
Public Type ExampleData
Name As String ' could be 5-20 chars long
ValidOn As Date ' could be valid date or 1899-12-30 representing "null"
Salt As Integer ' random value 42-32767
Items(0 To 13) As ExampleDataItem
End Type
I would like to generate a 32-bit hash code for an ExampleData instance. Minimising hash collisions is important, performance and data order is not important.
So far I have got (in pseudocode):
Serialise all members into one byte array.
Loop through the byte array, reading 4 bytes at a time into a Long value.
XOR all the Long values together.
I can't really post my code because it's heavily dependent on utility classes to do the serialisation, but if anyone wants to see it regardless then I will post it.
Will this be OK, or can anyone suggest a better way of doing it?
EDIT:
This code is being used to implement part of a software licensing system. The purpose of the hash is to confirm whether the data entered by the end user equals the data entered by the tech support person. The hash must therefore:
Be very short. That's why I thought 32 bits would be most suitable, because it can be rendered as a 10-digit decimal number on screen. This is easy, quick and unambiguous to read over the telephone and type in.
Be derived from all the fields in the data structure, with no extra artificial keys or any other trickery.
The hash is not required for lookup, uniqueness testing, or to store ExampleData instances in any kind of collection, but only for the one purpose described above.
Can you use the CRC32? Steve McMahon has an implementation. Combine that with a bit of base32 encoding and you've got something short enough to read over the phone.
Considering that performance is not an objective, if file size is not important and you want a unique value for each item. Just add an ID field. It data type is a string. Then use this function to generate a GUID. This will be a unique ID. Use it as a key for a dictonary or collection.
Public Type GUID
Data1 As Long
Data2 As Integer
Data3 As Integer
Data4(7) As Byte
End Type
Public Type GUID2 '15 BYTES TOTAL
Data1(14) As Byte
End Type
Public Declare Function CoCreateGuid Lib "OLE32.DLL" (pGuid As GUID) As Long
Public Function GetGUID() As String
Dim VBRIG_PROC_ID_STRING As String
VBRIG_PROC_ID_STRING = "GetGUID()"
Dim lResult As Long
Dim lguid As GUID
Dim MyguidString As String
Dim MyGuidString1 As String
Dim MyGuidString2 As String
Dim MyGuidString3 As String
Dim DataLen As Integer
Dim StringLen As Integer
Dim i As Integer
On Error GoTo error_olemsg
lResult = CoCreateGuid(lguid)
If lResult = 0 Then
MyGuidString1 = Hex$(lguid.Data1)
StringLen = Len(MyGuidString1)
DataLen = Len(lguid.Data1)
MyGuidString1 = LeadingZeros(2 * DataLen, StringLen) & MyGuidString1
'First 4 bytes (8 hex digits)
MyGuidString2 = Hex$(lguid.Data2)
StringLen = Len(MyGuidString2)
DataLen = Len(lguid.Data2)
MyGuidString2 = LeadingZeros(2 * DataLen, StringLen) & Trim$(MyGuidString2)
'Next 2 bytes (4 hex digits)
MyGuidString3 = Hex$(lguid.Data3)
StringLen = Len(MyGuidString3)
DataLen = Len(lguid.Data3)
MyGuidString3 = LeadingZeros(2 * DataLen, StringLen) & Trim$(MyGuidString3)
'Next 2 bytes (4 hex digits)
GetGUID = MyGuidString1 & MyGuidString2 & MyGuidString3
For i = 0 To 7
MyguidString = MyguidString & Format$(Hex$(lguid.Data4(i)), "00")
Next i
'MyGuidString contains last 8 bytes of Guid (16 hex digits)
GetGUID = GetGUID & MyguidString
Else
GetGUID = "00000000" ' return zeros if function unsuccessful
End If
Exit Function
error_olemsg:
GetGUID = "00000000"
Exit Function
End Function
Public Function LeadingZeros(ExpectedLen As Integer, ActualLen As Integer) As String
LeadingZeros = String$(ExpectedLen - ActualLen, "0")
End Function
EDIT: the question has now been edited to clarify that the goal is detecting typing errors, not minimizing collisions between totally different values. In that case Dan F's answer is the best one IMHO, not my offering below (wonderful though it is).
You could use the Microsoft CryptoAPI rather than rolling your own hash algorithm.
For instance this Microsoft article on using CryptoAPI from VB6 should get you started.
Or this from Edanmo on mvps.org for hashing a string in VB6.
EDIT: Following comment. If you insist on a 32-bit value, it will be hard to minimize hash collisions. My algorithm book suggests using Horner's method as a decent general purpose hashing algorithm. I don't have time right now to find out more information and implement in VB6. CopyMemory would probably be useful :)
You may be overthinking it, or I'm not understanding the issue. You could essentially just
hash(CStr(Salt) + Name + CStr(ValidOn) + Anyotherstrings
There is no particular need to go through the process of serializing into byte array and XORing values. Infact XORing values together in that way is more likely to create hash collisions where you aren't intending them.
Edit: I think I understand now. You're creating your own hash value by XORing the data together? It's unfortunately quite likely to give collisions. I know VB6 doesn't include any hashing algorithms, so you may be best importing and using something like Phil Fresle's SHA256 implementation.

Resources