so i need to find the limit of object and prove it
so i have done this
Dim D3 As New CLdevoire
Dim i As Int64
Dim j As Int64
Dim R As Int64
R = 9223372036854775807
For i = 1 To R
D3 = New CLdevoire
Console.WriteLine(i)
Next
For i = 1 To R
For j = 1 To R
D3 = New CLdevoire
Console.WriteLine(i)
Next
Next
but either my computer crash because i don't have enough ram or if i have a swap because the disk and ram are
does anyone have a way to reach it ? (since for my teacher they are a limit before the system limit of 2^64
Related
I have a 182.123 size array and I want to sort them by an specific attribute of the class of the array. The class is called CFlujo and the property I want to sort them by is by a string called id_flujo. So far I'm doing a bubble sort like this but it just takes too long:
Sub sort_arreglo(arreglo As Variant)
For x = LBound(arreglo) To UBound(arreglo)
For y = x To UBound(arreglo)
Dim aux As CFlujo
aux = New CFlujo
If UCase(arreglo(y).id_flujo) < UCase(arreglo(x).id_flujo) Then
Set aux = arreglo(y)
Set arreglo(y) = arreglo(x)
Set arreglo(x) = aux
End If
Next y
Next x
End Sub
So far I've researched the Selection Sort but I know you can't delete items from an array so I can't make two lists to sort the values from one to the other. I could put my data in collection but I have had trouble regarding the quality of the data unless I alocate the memory beforehand (like in an array).
There's a couple of things you can do to improve the execution time:
Load all the properties in an array
Sort some pointers instead of the objects
Use a better algorithm like QucikSort
With you example:
Sub Sort(arreglo As Variant)
Dim cache, vals(), ptrs() As Long, i As Long
ReDim vals(LBound(arreglo) To UBound(arreglo))
ReDim ptrs(LBound(arreglo) To UBound(arreglo))
' load the properties and fill the pointers
For i = LBound(arreglo) To UBound(arreglo)
vals(i) = UCase(arreglo(i).id_flujo)
ptrs(i) = i
Next
' sort the pointers
QuickSort vals, ptrs, 0, UBound(vals)
' make a copy
cache = arreglo
' set the value for each pointer
For i = LBound(arreglo) To UBound(arreglo)
Set arreglo(i) = cache(ptrs(i))
Next
End Sub
Private Sub QuickSort(vals(), ptrs() As Long, ByVal i1 As Long, ByVal i2 As Long)
Dim lo As Long, hi As Long, p As Long, tmp As Long
lo = i1
hi = i2
p = ptrs((i1 + i2) \ 2)
Do
While vals(ptrs(lo)) < vals(p): lo = lo + 1: Wend
While vals(ptrs(hi)) > vals(p): hi = hi - 1: Wend
If lo <= hi Then
tmp = ptrs(hi)
ptrs(hi) = ptrs(lo)
ptrs(lo) = tmp
lo = lo + 1
hi = hi - 1
End If
Loop While lo <= hi
If i1 < hi Then QuickSort vals, ptrs, i1, hi
If lo < i2 Then QuickSort vals, ptrs, lo, i2
End Sub
so I am creating a piece of software that in short, has a list of original byte sequences and new sequences that those bytes need to be changed into, kinda like this in text form "original location(currently irrelevant as sequence can be in different places) $ 56,69,71,73,75,77 : 56,69,71,80,50,54"
I already have code that works fine, however there can be up to 600+ of these sequences to find and change and in some cases it is taking a really really long time 15 mins +, i think it is down to how long it is taking to find the sequences to them change so i am trying to find a better way to do this as currently it is unusable due to how long it takes.
I have copied the whole code for this function below in hopes one of you kind souls can have a look and help =)
Dim originalbytes() As Byte
Dim fd As OpenFileDialog = New OpenFileDialog()
fd.Title = "Select the file"
fd.Filter = "All files (*.*)|*.*|All files (*.*)|*.*"
fd.FilterIndex = 2
If fd.ShowDialog() = DialogResult.OK Then
TextBox2.Text = fd.FileName
originalbytes = File.ReadAllBytes(fd.FileName)
End If
Dim x As Integer = 0
Dim y As Integer = 0
Dim textbox1array() = TextBox1.Lines
Dim changedbytes() = originalbytes
Dim startvalue As Integer = 0
Dim databoxarray() As String
Dim databoxarray2() As String
While x < textbox1array.Length - 1
'for each change to make
databoxarray = textbox1array(x).Replace(" $ ", vbCr).Replace(" : ", vbCr).Split
databoxarray2 = databoxarray(1).Replace(",", vbCr).Split
Dim databox2bytes() As String = databoxarray2
'copy original bytes line to databox2 lines
y = 0
While y < (originalbytes.Length - databox2bytes.Length)
'repeat for all bytes in ori file - size of data to find
If originalbytes(y) = databox2bytes(0) Then
startvalue = y
Dim z As String = 1
Dim samebytecounter As Integer = 1
While z < databox2bytes.Length
'repeat for all ori bytes
If originalbytes(y + z) = databox2bytes(z) Then
samebytecounter = samebytecounter + 1
End If
z = z + 1
End While
If samebytecounter = databox2bytes.Length Then
'same original data found, make changes
Dim bytestoinsert() As String = databoxarray(2).Replace(",", vbCr).Split
Dim t As Integer = 0
While t < bytestoinsert.Length
changedbytes(startvalue + t) = bytestoinsert(t)
t = t + 1
End While
End If
End If
y = y + 1
End While
x = x + 1
End While
File.WriteAllBytes(TextBox2.Text & " modified", changedbytes)
Let 's take a look at that inner while loop in your code, there are some things that can be optimized:
There is no need to check the total length all the time
Dim length as Integer = originalbytes.Length - databox2bytes.Length
While y < length
'repeat for all bytes in ori file - size of data to find
If originalbytes(y) = databox2bytes(0) Then
startvalue = y
z is not necessary, samebytecounter does exactly the same
Dim samebytecounter As Integer = 1
This while loop is a real bottleneck, since you always check the full length of your databox2bytes, you should rather quit the while loop when they don't match
While samebytecounter < databox2bytes.Length AndAlso originalbytes(y + samebytecounter ) = databox2bytes(samebytecounter )
samebytecounter = samebytecounter + 1
End While
This seems fine, but you already splitted the data at the top of your while loop, so, no need to create another array that does the same operation again
If samebytecounter = databox2bytes.Length Then
'same original data found, make changes
Dim t As Integer = 0
While t < databoxarray2.Length
changedbytes(startvalue + t) = databoxarray2(t)
t = t + 1
End While
End If
End If
y = y + 1
End While
For the rest I would agree that the algorithm you created is hugely inefficient, theoretically your code could have been rewritten like eg: (didn't really test this code)
Dim text = System.Text.Encoding.UTF8.GetString(originalbytes, 0, originalbytes.Length)
dim findText = System.Text.Encoding.UTF8.GetString(stringToFind, 0, stringToFind.Length)
dim replaceWith = System.Text.Encoding.UTF8.GetString(stringToSet, 0, stringToSet.Length)
text = text.Replace( findText, replaceWith )
dim outbytes = System.Text.Encoding.UTF8.GetBytes(text)
which would probably be a huge time saver.
For the rest your code seems to be created in such a way that nobody will really understand it if it's laying around for a month or so, I would say, including yourself
please help me with this problem. I'm just starting to use VBA and after searching the forum was not able to find a solution. I have 1000 single digit numbers in my spreadsheet. 20 rows of 50 numbers in each. my program suppose to find the largest product. For some reason my final answer is 0. I've done some debugging and the program goes through all the loops and iterations as expected. I suspect that my function does not pass the value back to my main
Public Sub problem8()
Dim product, i, j, maxproduct As Long
maxproduct = product = 1
For i = 1 To 20
For j = 1 To 50
product = calcproduct(i, j)
If product > maxproduct Then maxproduct = product
Next j
Next i
Range("AY1").Value = maxproduct
End Sub
Function calcproduct(ByVal a As Long, ByVal b As Long) As Long
Dim i, j, count As Long
counter = calcproduct = 1
For i = a To 20
For j = b To 50
calcproduct = Cells(i, j).Value * calcproduct
counter = counter + 1
If counter = 13 Then Exit Function
Next j
Next i
End Function
Change:
Dim product, i, j, maxproduct As Long
to:
Dim product as long, i as long, j as long, maxproduct As Long
and:
Dim i, j, count As Long
to:
Dim i as long, j as long, count As Long
I used to think putting it on the end applied it to everything on the row but it doesn't and I encountered a similar issue to you.
I might add though, the way you have done this (assigning i and j to new variables a and b then using i and j in the second routine) is extremely confusing and I would strongly recommend against it.
First off, this is the wrong way to express what you are trying to accomplish.
maxproduct = product = 1
This says "maxproduct is equal to False". product was just declared so it is for all intents and purposes a zero and not equal to 1. You wanted to say,
maxproduct = 1
product = 1
If you really need to put those last two on a single line then use a colon like this,
maxproduct = 1: product = 1
The same holds true for the similar syntax in the function.
Now it is important to understand that VBA treats True as -1 and False as 0 (zero). Since you are essentially initializing maxproduct and product as zeroes, you can multiply anything you want by it and you will still end up with zero. Again, the same holds true for the way this similar variable assignment was handled in the function.
Here is my take on your project.
Option Explicit
Public Const maxA As Long = 20
Public Const maxB As Long = 50
Public Const cntC As Long = 13
Public Sub problem8()
Dim product As Long, i As Long, j As Long, maxproduct As Long
maxproduct = 1: product = 1
For i = 1 To maxA
For j = 1 To maxB
product = calcproduct(i, j)
If product > maxproduct Then maxproduct = product
Next j
Next i
Range("AY1").Value = maxproduct
End Sub
Function calcproduct(ByVal a As Long, ByVal b As Long) As Long
Dim i As Long, j As Long, counter As Long
counter = 1: calcproduct = 1
For i = a To maxA
For j = b To maxB
calcproduct = Cells(i, j).Value * calcproduct
counter = counter + 1
If counter = cntC Then Exit Function
Next j
Next i
End Function
I moved the limits to public constants which make it easier to modify for different sized regions. In your function you declared a count then started using a var called counter so I changed that to suit. As mentioned in another post, the variable declaration needs to be specific or you end up with a bunch of variants and a few longs.
I have a problem in VB 2008 that gives me an error: " OverflowException was unhandled. "
in that piece of code: The error is highlights the Next b
Dim gfx As Graphics
Dim a,r,g,b As byte
Dim left As Integer
Dim lStep As Integer = 1
For left = 0 To Me.ClientRectangle.Height Step lStep
For a = 1 To 255
For r = 1 To 255
For g = 1 To 255
For b = 1 To 255
gfx.DrawLine(New Pen(Color.FromArgb(a, r, g, b)), 0, left, Me.ClientRectangle.Width, left)
Next b
Next g
Next r
Next a
Dim a,r,g,b As byte
That's where your problem started. Your For loops increment from 1 to 255, stopping when the value reaches 256. But that is not possible for a Byte, it can only store a value between 0 and 255. Kaboom when the Next statement tries to increment it from 255 to 256.
Simply declare them As Integer. It not only solves the overflow problem, it is also faster.
The way this file works is there is a null buffer, then a user check sum then a byte that gives you the user name letter count, then a byte for how many bytes to skip to the next user and a byte for which user file the user keeps their settings in.
the loop with the usersm variable in the IF statement sets up the whole file stream for extraction. However with almost the exact same code the else clause specifically the str.Read(xnl, 0, usn - 1) in the else code appears to be reading the very beginning of the file despite the position of the filestream being set earlier, anyone know whats happening here?
this is in vb2005
Private Sub readusersdata(ByVal userdatafile As String)
ListView1.BeginUpdate()
ListView1.Items.Clear()
Using snxl As IO.Stream = IO.File.Open(userdatafile, IO.FileMode.Open)
Using str As New IO.StreamReader(snxl)
str.BaseStream.Position = 4
Dim usersm As Integer = str.BaseStream.ReadByte()
Dim users As Integer = usersm
While users > 0
If usersm = users Then
Dim trailtouser As Integer = 0
str.BaseStream.Position = 6
Dim ust As Integer = str.BaseStream.ReadByte()
str.BaseStream.Position = 8
Dim snb(ust - 1) As Char
str.ReadBlock(snb, 0, ust)
Dim bst = New String(snb)
If usersm = 1 Then
str.BaseStream.Position = 16
Else
str.BaseStream.Position = 15
End If
cLVN(ListView1, bst, str.BaseStream.ReadByte)
str.BaseStream.Position = 8 + snb.Length
str.BaseStream.Position += str.BaseStream.ReadByte + 1
Else
Dim usn As Integer = str.BaseStream.ReadByte
str.BaseStream.Position += 2
Dim chrpos As Integer = str.BaseStream.Position
Dim xnl(usn - 1) As Char
str.Read(xnl, 0, usn - 1)
Dim skpbyte As Integer = str.BaseStream.ReadByte
str.BaseStream.Position += 3
Dim udata As Integer = str.BaseStream.ReadByte
End If
users -= 1
End While
End Using
End Using
ListView1.EndUpdate()
End Sub
When you change the position of the underlying stream, the StreamReader doesn't know you've done that. If it's previously read "too much" data (deliberately, for the sake of efficiency - it tries to avoid doing lots of little reads on the underlying stream) then it will have buffered data that it'll use instead of talking directly to the repositioned stream. You need to call StreamReader.DiscardBufferedData after repositioning the stream to avoid that.