Results 1 to 18 of 18

Thread: VB6 Bubble Sort

  1. #1

    Thread Starter
    New Member
    Join Date
    Jul 2020
    Posts
    8

    VB6 Bubble Sort

    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.

    Thanks for the help...

  2. #2
    VB-aholic & Lovin' It LaVolpe's Avatar
    Join Date
    Oct 2007
    Location
    Beside Waldo
    Posts
    19,541

    Re: VB6 Bubble Sort

    Welcome to the forums

    Are you sure your bubble sort is coded correctly? FYI, here is a link in this forum with several different sort algos.

    Other than that, pseudo code doesn't help us help you. We to see actual code related to the problem.
    Insomnia is just a byproduct of, "It can't be done"

    Classics Enthusiast? Here's my 1969 Mustang Mach I Fastback. Her sister '67 Coupe has been adopted

    Newbie? Novice? Bored? Spend a few minutes browsing the FAQ section of the forum.
    Read the HitchHiker's Guide to Getting Help on the Forums.
    Here is the list of TAGs you can use to format your posts
    Here are VB6 Help Files online


    {Alpha Image Control} {Memory Leak FAQ} {Unicode Open/Save Dialog} {Resource Image Viewer/Extractor}
    {VB and DPI Tutorial} {Manifest Creator} {UserControl Button Template} {stdPicture Render Usage}

  3. #3

    Thread Starter
    New Member
    Join Date
    Jul 2020
    Posts
    8

    Re: VB6 Bubble Sort

    [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

  4. #4

    Thread Starter
    New Member
    Join Date
    Jul 2020
    Posts
    8

    Re: VB6 Bubble Sort

    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

  5. #5
    Sinecure devotee
    Join Date
    Aug 2013
    Location
    Southern Tier NY
    Posts
    6,582

    Re: VB6 Bubble Sort

    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

  6. #6

    Thread Starter
    New Member
    Join Date
    Jul 2020
    Posts
    8

    Re: VB6 Bubble Sort

    Quote Originally Posted by passel View Post
    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.

  7. #7

    Thread Starter
    New Member
    Join Date
    Jul 2020
    Posts
    8

    Re: VB6 Bubble Sort

    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.

  8. #8
    PowerPoster
    Join Date
    Nov 2017
    Posts
    3,116

    Re: VB6 Bubble Sort

    Code:
    xTop = sumTopR / vcount
    xTop = Int(xTop * rndM(imkt))
    xTop = Round(xTop / (mintic(imkt) * rndM(imkt))) * (mintic(imkt) * (rndM(imkt))) / rndM(imkt)
    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.

  9. #9

    Thread Starter
    New Member
    Join Date
    Jul 2020
    Posts
    8

    Re: VB6 Bubble Sort

    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

  10. #10

    Thread Starter
    New Member
    Join Date
    Jul 2020
    Posts
    8

    Re: VB6 Bubble Sort

    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.

  11. #11
    PowerPoster Elroy's Avatar
    Join Date
    Jun 2014
    Location
    Near Nashville TN
    Posts
    9,853

    Re: VB6 Bubble Sort

    Hi Clark,

    Welcome to VB Forums.

    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.

  12. #12
    Sinecure devotee
    Join Date
    Aug 2013
    Location
    Southern Tier NY
    Posts
    6,582

    Re: VB6 Bubble Sort

    Quote Originally Posted by Clark Collins View Post
    ...
    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

  13. #13

    Thread Starter
    New Member
    Join Date
    Jul 2020
    Posts
    8

    Re: VB6 Bubble Sort

    Quote Originally Posted by Elroy View Post
    Hi Clark,

    Welcome to VB Forums.

    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
    
    
    
    Thanks I will take a look at it.

  14. #14
    PowerPoster
    Join Date
    Feb 2006
    Posts
    24,482

    Re: VB6 Bubble Sort

    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.

    Name:  sshot.png
Views: 703
Size:  6.3 KB

    Please excuse the crudity of this model. I didn't have time to build it to scale or to paint it.
    Attached Files Attached Files
    Last edited by dilettante; Jul 25th, 2020 at 10:35 PM.

  15. #15
    PowerPoster
    Join Date
    Feb 2006
    Posts
    24,482

    Re: VB6 Bubble Sort

    Adding the Low Price daily values to the chart is easy enough. Just modify a Command for the additional column:

    Code:
        Set RangeQueryCommand = New ADODB.Command
        With RangeQueryCommand
            .Name = "RangeQuery"
            .CommandType = adCmdText
            .CommandText = "SELECT Format$([Market Date],'Short Date')," _
                         & "[Low Price],[High Price],?,? " _
                         & "FROM [comma delimited.txt] " _
                         & "WHERE [Market Date] BETWEEN ? AND ?"
            Set .ActiveConnection = Connection
        End With
    ... and then define the new series in the chart.

    I also tweaked some of the colors and marker shapes:

    Name:  sshot.png
Views: 685
Size:  7.2 KB

    And of course you could toss out the entire chart and just show a grid of values.

  16. #16
    PowerPoster
    Join Date
    Feb 2006
    Posts
    24,482

    Re: VB6 Bubble Sort

    I've played around a bit, adding a statline for "average of low 10" days and using a Jet MDB.

    Name:  sshot.png
Views: 669
Size:  6.2 KB

    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.

  17. #17
    Lively Member
    Join Date
    Jan 2020
    Posts
    120

    Re: VB6 Bubble Sort

    Code:
    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

  18. #18
    PowerPoster
    Join Date
    Feb 2006
    Posts
    24,482

    Re: VB6 Bubble Sort

    Here's a No SQL approach, based on ADO Recordset capabilities.
    Attached Files Attached Files
    Last edited by dilettante; Jul 27th, 2020 at 11:06 PM.

Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts
  •  



Click Here to Expand Forum to Full Width