Hello,
I am hoping someone can help me with a bubble sort I am trying to use to sort price data.
I am reading in the data and looping through day by day for analysis.
I am trying to use "bubble sort" to sort the highest 10 prices over a rolling 20 day window and then average those 10 prices. for some reason I just cannot get the sorting correctly when I go day to day.
So each day I read the new close price in a loop
gosub readdata
for iday=1 to ndays
gosub bubble sort
print new averages for day
next iday
readdata: bring all historical prices into an array.
[QUOTE=Clark Collins;5488143]Hello,
I am hoping someone can help me with a bubble sort I am trying to use to sort price data.
I am reading in the data and looping through day by day for analysis.
I am trying to use "bubble sort" to sort the highest 10 prices over a rolling 20 day window and then average those 10 prices. for some reason I just cannot get the sorting correctly when I go day to day.
sort:
rcount = 20: vcount = 10: sumTopR = 0 'dr is the value of the high price-low price of day which is read into array
iMin = nrec - (rcount - 1)
iMax = nrec
If ydatex(nrec) >= 20150411 Then
Do
blnSwapped = False
For i = iMin To iMax Step 1
If dr(i + 1) > dr(i) Then
varswap = dr(i + 1)
dr(i + 1) = dr(i)
dr(i) = varswap
blnSwapped = True
End If
Next
Loop Until Not blnSwapped
For b = iMin To iMin + (vcount - 1) 'trying to print out top 10 of 20 ranked/sorted to create average of the 10
sumTopR = sumTopR + dr(b)
'Debug.Print dr(b)
ddd = ddd + 1
Next b
xTop = sumTopR / vcount
xTop = Int(xTop * rndM(imkt))
xTop = Round(xTop / (mintic(imkt) * rndM(imkt))) * (mintic(imkt) * (rndM(imkt))) / rndM(imkt)
End If
Return
sort:
rcount = 20: vcount = 10: sumTopR = 0 'dr is the value of the high price-low price of day which is read into array
iMin = nrec - (rcount - 1)
iMax = nrec
If ydatex(nrec) >= 20150411 Then
Do
blnSwapped = False
For i = iMin To iMax Step 1
If dr(i + 1) > dr(i) Then
varswap = dr(i + 1)
dr(i + 1) = dr(i)
dr(i) = varswap
blnSwapped = True
End If
Next
Loop Until Not blnSwapped
For b = iMin To iMin + (vcount - 1) 'trying to print out top 10 of 20 ranked/sorted to create average of the 10
sumTopR = sumTopR + dr(b)
'Debug.Print dr(b)
ddd = ddd + 1
Next b
xTop = sumTopR / vcount
xTop = Int(xTop * rndM(imkt))
xTop = Round(xTop / (mintic(imkt) * rndM(imkt))) * (mintic(imkt) * (rndM(imkt))) / rndM(imkt)
End If
Return
So, when you step through the code in the debugger and examine the values and see what the code does at each step, is it what you expect it to do?
Can you see where it doesn't do what you expect and can determine why?
Being able to watch the code work step by step and examine the values is one of the greatest strengths of the VB6 IDE.
In a lot of cases, you can see where something goes wrong, fix the line, and set the "Next Statement" to re-execute the line and continue debugging.
Being able to change the code as you debug and continue executing is a big time saver compared to many other programming environments.
I'm not sure what the lower part of the code is trying to do. It seems odd to keep modifying the xTop value, but perhaps that is what you want to do.
If you step through the code and examine each of the values as you go through each statement, perhaps you can understand where what it does is different from what you expected it to do.
"Anyone can do any amount of work, provided it isn't the work he is supposed to be doing at that moment" Robert Benchley, 1930
So, when you step through the code in the debugger and examine the values and see what the code does at each step, is it what you expect it to do?
Can you see where it doesn't do what you expect and can determine why?
Being able to watch the code work step by step and examine the values is one of the greatest strengths of the VB6 IDE.
In a lot of cases, you can see where something goes wrong, fix the line, and set the "Next Statement" to re-execute the line and continue debugging.
Being able to change the code as you debug and continue executing is a big time saver compared to many other programming environments.
I'm not sure what the lower part of the code is trying to do. It seems odd to keep modifying the xTop value, but perhaps that is what you want to do.
If you step through the code and examine each of the values as you go through each statement, perhaps you can understand where what it does is different from what you expected it to do.
The sorting seems to work fine but when I step through the bottom section to sum and average the top 10 values it blows up either not counting correctly or adding values not in the top 10. I have stepped through and debugged dozens and dozens of times and just cannot get the top 10 to print and average correctly.
The sorting seems to work fine but when I step through the bottom section to sum and average the top 10 values it blows up either not counting correctly or adding values not in the top 10. I have stepped through and debugged dozens and dozens of times and just cannot get the top 10 to print and average correctly.
If this is your code to calculate the average, then you need to explain what things like imkt, rndM and mintic are. Whatever they are, they don't show up in any preceding code you have posted to indicate what value(s) they may have when those lines of code are executed, so we have no idea.
Here's a tip: an average is (Sum of all values) / (Count of all values)
If your "average" code is more complicated than that (as it appears to be), then you are likely doing it wrong.
Actually the sorting works only on first run. by the end of say 1000 daily loops the sorting somehow does not work. which is why the bottom portion printing out the top 10 doesnt generate the right numbers
it is just a rounding process. The average doesnt change from the very first average calculation. just truncates decimals out past 1000'th place.
It is the sorting that is the issue. Just ran the code to bottom of array and although it works on the first run, something blows up and I get bad data when sorting well down the list in the array.
I've written many sorting algorithms in my day. However (and admittedly, not really an answer to your question), I tend to lean on something that's already available to me these days, to do these sorts. Two things immediately come to mind: 1) Just throw a hidden Listbox on your form, with Sorted=True, and use it to do your sorting; or, 2) instantiate a Collection and use that Collection object to do your sorting (using the key for the sort, and maybe using the data field to store extra data that goes with each key).
Personally, I'd tend to use the Collection approach. However, if you're not familiar with Collections, the Listbox may be more obvious to you.
Good Luck,
Elroy
EDIT: I'm not up for testing, but I'm betting either of those approaches will be substantially faster than your bubble sort.
EDIT2: I suppose you would need something like the following to use a Collection (after you've stuffed it all in):
Code:
Option Explicit
'
Private Declare Function GetMem4 Lib "msvbvm60.dll" (ByRef Source As Any, ByRef Dest As Any) As Long
'
Public Function collSortedKeys(c As Collection, Optional bReverse As Boolean) As String()
' Originally written by Wqweto, tweaked by Elroy.
' Returns 0 to -1 array on empty Collection.
' This is particularly nice when you want to use the Collection for nothing but sorting.
' Does NOT return items with no key.
'
Dim iRootPtr As Long
Dim iEofPtr As Long
Dim iCount As Long
Dim iFirstOffset As Long
Dim iSecondOffset As Long
'
If c Is Nothing Then
collSortedKeys = Split(vbNullString)
Exit Function
End If
'
GetMem4 ByVal PtrAdd(ObjPtr(c), &H24&), iRootPtr
iEofPtr = EndPointer(c)
'
If iRootPtr = iEofPtr Or c.Count = 0 Then
collSortedKeys = Split(vbNullString)
Exit Function
End If
'
' Offsets that determine forward or reverse.
If Not bReverse Then
iFirstOffset = &H28& ' pLeftBranch
iSecondOffset = &H24& ' pRightBranch
Else
iFirstOffset = &H24& ' pRightBranch
iSecondOffset = &H28& ' pLeftBranch
End If
'
' Gather the keys.
ReDim collSortedKeys(1 To c.Count)
GatherKeysInOrder iRootPtr, iEofPtr, collSortedKeys, iCount, iFirstOffset, iSecondOffset
If iCount < c.Count Then ReDim Preserve collSortedKeys(1& To iCount)
End Function
'
' These are just support for the above collSortedKeys procedure.
'
Private Sub GatherKeysInOrder(ByVal iItemPtr As Long, iEofPtr As Long, sKeysArray() As String, iCount As Long, iFirstOffset As Long, iSecondOffset As Long)
' Originally written by Wqweto, tweaked by Elroy.
Dim iNewPtr As Long
Dim sKeyTemp As String
'
' Traverse left (or right, if reverse) branch if present.
GetMem4 ByVal PtrAdd(iItemPtr, iFirstOffset), iNewPtr
If iNewPtr <> iEofPtr Then GatherKeysInOrder iNewPtr, iEofPtr, sKeysArray, iCount, iFirstOffset, iSecondOffset
'
' Collect current key.
iCount = iCount + 1&
GetMem4 ByVal PtrAdd(iItemPtr, &H10&), ByVal VarPtr(sKeyTemp)
sKeysArray(iCount) = sKeyTemp
GetMem4 0&, ByVal VarPtr(sKeyTemp)
'
' Traverse right (or left, if reverse) branch if present.
GetMem4 ByVal PtrAdd(iItemPtr, iSecondOffset), iNewPtr
If iNewPtr <> iEofPtr Then GatherKeysInOrder iNewPtr, iEofPtr, sKeysArray, iCount, iFirstOffset, iSecondOffset
End Sub
Private Function PtrAdd(iPtr As Long, iOffset As Long) As Long
PtrAdd = (iPtr Xor &H80000000) + iOffset Xor &H80000000
End Function
Private Function EndPointer(c As Collection) As Long
' This is effectively an EOF (or end-of-branch) marker that's used by VB6's Collections.
' They DON'T use zero for this, and each Collection will have a different value.
' It's basically a pointer back to the bottom of the Collection header.
GetMem4 ByVal PtrAdd(ObjPtr(c), &H28&), EndPointer ' VbCollectionHeader.pEndTreePtr
End Function
Last edited by Elroy; Jul 25th, 2020 at 11:32 AM.
Any software I post in these forums written by me is provided "AS IS" without warranty of any kind, expressed or implied, and permission is hereby granted, free of charge and without restriction, to any person obtaining a copy. To all, peace and happiness.
...
I am trying to use "bubble sort" to sort the highest 10 prices over a rolling 20 day window and then average those 10 prices.
...
So, are you trying to get the highest price from each day, for 20 days, and then average the highest 10 of those?
Or are you trying to find the highest 10 prices in a 20 day period, regardless of the day they occurred in, i.e. the highest 10 prices may have been on one particular good day, and the none of the other 19 days had a price that reached the top 10?
If it is the first, then you wouldn't even need a bubble sort.
Just start with the an array of 20 slots, and loop through the each day's prices once to find the highest price and put it in to corresponding slot.
Now you have your 20 day running history.
You leave this array alone so that when you want to do the next 20 day run (i.e. remove the first day and add the 21st day) you just shift the 19 days in the array up, and loop through prices of the the day being added to find the highest price, and put it the 20th slot.
Now that you got your rolling 20 day window set up, you can find the highest 10 prices in that array, copying them to a new 10-slot array and do your average.
If you need to do the second, i.e. find the highest 10 prices in a 20 day period, regardless of the day they occurred, then it becomes more complicated. Rather than cover that, especially if you don't need it, we'll wait to see if that is what you need.
"Anyone can do any amount of work, provided it isn't the work he is supposed to be doing at that moment" Robert Benchley, 1930
I've written many sorting algorithms in my day. However (and admittedly, not really an answer to your question), I tend to lean on something that's already available to me these days, to do these sorts. Two things immediately come to mind: 1) Just throw a hidden Listbox on your form, with Sorted=True, and use it to do your sorting; or, 2) instantiate a Collection and use that Collection object to do your sorting (using the key for the sort, and maybe using the data field to store extra data that goes with each key).
Personally, I'd tend to use the Collection approach. However, if you're not familiar with Collections, the Listbox may be more obvious to you.
Good Luck,
Elroy
EDIT: I'm not up for testing, but I'm betting either of those approaches will be substantially faster than your bubble sort.
EDIT2: I suppose you would need something like the following to use a Collection (after you've stuffed it all in):
Code:
Option Explicit
'
Private Declare Function GetMem4 Lib "msvbvm60.dll" (ByRef Source As Any, ByRef Dest As Any) As Long
'
Public Function collSortedKeys(c As Collection, Optional bReverse As Boolean) As String()
' Originally written by Wqweto, tweaked by Elroy.
' Returns 0 to -1 array on empty Collection.
' This is particularly nice when you want to use the Collection for nothing but sorting.
' Does NOT return items with no key.
'
Dim iRootPtr As Long
Dim iEofPtr As Long
Dim iCount As Long
Dim iFirstOffset As Long
Dim iSecondOffset As Long
'
If c Is Nothing Then
collSortedKeys = Split(vbNullString)
Exit Function
End If
'
GetMem4 ByVal PtrAdd(ObjPtr(c), &H24&), iRootPtr
iEofPtr = EndPointer(c)
'
If iRootPtr = iEofPtr Or c.Count = 0 Then
collSortedKeys = Split(vbNullString)
Exit Function
End If
'
' Offsets that determine forward or reverse.
If Not bReverse Then
iFirstOffset = &H28& ' pLeftBranch
iSecondOffset = &H24& ' pRightBranch
Else
iFirstOffset = &H24& ' pRightBranch
iSecondOffset = &H28& ' pLeftBranch
End If
'
' Gather the keys.
ReDim collSortedKeys(1 To c.Count)
GatherKeysInOrder iRootPtr, iEofPtr, collSortedKeys, iCount, iFirstOffset, iSecondOffset
If iCount < c.Count Then ReDim Preserve collSortedKeys(1& To iCount)
End Function
'
' These are just support for the above collSortedKeys procedure.
'
Private Sub GatherKeysInOrder(ByVal iItemPtr As Long, iEofPtr As Long, sKeysArray() As String, iCount As Long, iFirstOffset As Long, iSecondOffset As Long)
' Originally written by Wqweto, tweaked by Elroy.
Dim iNewPtr As Long
Dim sKeyTemp As String
'
' Traverse left (or right, if reverse) branch if present.
GetMem4 ByVal PtrAdd(iItemPtr, iFirstOffset), iNewPtr
If iNewPtr <> iEofPtr Then GatherKeysInOrder iNewPtr, iEofPtr, sKeysArray, iCount, iFirstOffset, iSecondOffset
'
' Collect current key.
iCount = iCount + 1&
GetMem4 ByVal PtrAdd(iItemPtr, &H10&), ByVal VarPtr(sKeyTemp)
sKeysArray(iCount) = sKeyTemp
GetMem4 0&, ByVal VarPtr(sKeyTemp)
'
' Traverse right (or left, if reverse) branch if present.
GetMem4 ByVal PtrAdd(iItemPtr, iSecondOffset), iNewPtr
If iNewPtr <> iEofPtr Then GatherKeysInOrder iNewPtr, iEofPtr, sKeysArray, iCount, iFirstOffset, iSecondOffset
End Sub
Private Function PtrAdd(iPtr As Long, iOffset As Long) As Long
PtrAdd = (iPtr Xor &H80000000) + iOffset Xor &H80000000
End Function
Private Function EndPointer(c As Collection) As Long
' This is effectively an EOF (or end-of-branch) marker that's used by VB6's Collections.
' They DON'T use zero for this, and each Collection will have a different value.
' It's basically a pointer back to the bottom of the Collection header.
GetMem4 ByVal PtrAdd(ObjPtr(c), &H28&), EndPointer ' VbCollectionHeader.pEndTreePtr
End Function
Seems like an obvious candidate for a few SQL queries to me, but maybe I have missed the intent. If it doesn't do what you are after exactly perhaps you can tweak it, like doing for "Low Price" what it is doing with just the "High Price" column now.
The code here is almost entirely UI-management for the Slider and MSChart controls. It is also faster if you use a Jet MDB or something instead of making so many passes over the text file this demo uses.
Please excuse the crudity of this model. I didn't have time to build it to scale or to paint it.
Last edited by dilettante; Jul 25th, 2020 at 10:35 PM.
I've played around a bit, adding a statline for "average of low 10" days and using a Jet MDB.
Lots of querying now per slider change, but at least using the database the program keeps up with left-arrow/right-arrow day by day changes of the range.
And yes, the slider and chart controls were just my way of seeing the results I was getting. You probably had entirely something else in mind to use them for.
Public Sub Array_BubbleSort(ByRef vArrayName As Variant, _
Optional ByVal lUpper As Long = -1, _
Optional ByVal lLower As Long = -1)
Dim vtemp As Variant
Dim i As Long
Dim j As Long
If IsEmpty(vArrayName) = True Then Exit Sub
If lLower = -1 Then lLower = LBound(vArrayName, 1)
If lUpper = -1 Then lUpper = UBound(vArrayName, 1)
For i = lLower To (lUpper - 1)
For j = i To lUpper
If (vArrayName(j) < vArrayName(i)) Then
vtemp = vArrayName(i)
vArrayName(i) = vArrayName(j)
vArrayName(j) = vtemp
End If
Next j
Next i
End Sub