Shakersort & my modifications that don't work :(
 

Excel 2003

The function below is a shaker sort, adapted from the website referenced in
the code. I need to make two changes to it;
(1) I'll be feeding this two different arrays and I need to sort them both
the same way (as if it were a 2D array), so I added a second array and
related sorting based on any sorts that occur to the first array, and
(2) I need to have these modifications persist back to the calling
procedure. I thought ByVal would change the "real" array in memory, but if
that doesn't work I need to pass both arrays back to the calling procedure.

So first, using the full sample below, the messagebox is returning the
original array order, not a revised order. I don't know if there is something
wrong with the code, or if ByRef doesn't mean what I think it means?

Second, I tried a few syntax options to have the function return the arrays
as a 1D array of arrays (as a backup, in case I can't just have the changes
persist directly in the original array) but I couldn't get that working
either.

Any advice greatly appreciated!
Keith

Full code sample- just copy/paste into your code module, and run the sub.


Option Base 1

Sub test()

Dim TargetArray(1 To 3) As Long
Dim CategoryArray(1 To 3) As String

TargetArray(1) = 9
TargetArray(2) = 6
TargetArray(3) = 3
CategoryArray(1) = "Zebra"
CategoryArray(2) = "Walrus"
CategoryArray(3) = "Primate"
X = BSortArray(TargetArray, CategoryArray)
End Sub

Private Function BSortArray(ByRef TargetArray() As Long, ByRef
CatagoryArray() As String) As Variant 'will variant allow me to return an
array of arrays automagically?

'Sort multiple parallel 1-D Arrays based on 1-D Shaker Sort
'based on ShakerSort sample from
http://www.xtremevbtalk.com/showthread.php?t=78889
'This is a serious resource on array sorting, and reading it makes my brain
hurt.

'Public Sub ShakerSort(ByRef lngArray() As Long)

Dim iLower As Long
Dim iUpper As Long
Dim iInner As Long
Dim iLBound As Long
Dim iUBound As Long
Dim iTemp As Long
Dim iTemp2 As String
Dim iMax As Long
Dim iMin As Long

iLBound = LBound(TargetArray)
iUBound = UBound(TargetArray)

iLower = iLBound - 1
iUpper = iUBound + 1

Do While iLower < iUpper

iLower = iLower + 1
iUpper = iUpper - 1

iMax = iLower
iMin = iLower

'Find the largest and smallest values in the subarray
For iInner = iLower To iUpper
If TargetArray(iInner) TargetArray(iMax) Then
iMax = iInner
ElseIf TargetArray(iInner) < TargetArray(iMin) Then
iMin = iInner
End If
Next iInner

'Swap the largest with last slot of the subarray
iTemp = TargetArray(iMax)
TargetArray(iMax) = TargetArray(iUpper)
TargetArray(iUpper) = iTemp
'Then do the exact same thing for the parallel array of category
titles/references
iTemp2 = CatagoryArray(iMax)
CatagoryArray(iMax) = CatagoryArray(iUpper)
CatagoryArray(iUpper) = iTemp2

'Swap the smallest with the first slot of the subarray
iTemp = TargetArray(iMin)
TargetArray(iMin) = TargetArray(iLower)
TargetArray(iLower) = iTemp
'Then do the exact same thing for the parallel array of category
titles/references
iTemp2 = CatagoryArray(iMin)
CatagoryArray(iMin) = CatagoryArray(iLower)
CatagoryArray(iLower) = iTemp2

Loop

'XL doesn't like my attempts to return the function results as an array of
arrays
' BSortArray(1) = TargetArray
' BSortArray(2) = CatagoryArray

'Just verify that the sort itself works
'but it doesn't, the msgbox shows everything in the original order?
MsgBox TargetArray(1) & " " & TargetArray(2) & " " & TargetArray(3) &
Chr(13) & Chr(13) & _
CatagoryArray(1) & " " & CatagoryArray(2) & " " & CatagoryArray(3)

End Function

Shakersort & my modifications that don't work :(
 

ker,

You picked a bad code source to use as the basis of your code.

If, as in your case, the Max is in the first position and the Min is in the
last, the swapping code blows it by doing the same swap twice, reverting the
data to their original positions. The coder clearly did not check all cases.
The code blows it on other subsequent internal sorts as well.

You can fix the code by checking for that case and only doing the swap once:

'Check if the largest and smallest are in each other's positions
If iMax = iLower And iMin = iUpper Then
iTemp = lngArray(iMax)
lngArray(iMax) = lngArray(iMin)
lngArray(iMin) = iTemp
Else
'Swap the largest with last slot of the subarray
iTemp = lngArray(iMax)
lngArray(iMax) = lngArray(iUpper)
lngArray(iUpper) = iTemp

'Swap the smallest with the first slot of the subarray
iTemp = lngArray(iMin)
lngArray(iMin) = lngArray(iLower)
lngArray(iLower) = iTemp
End If


HTH,
Bernie
MS Excel MVP


"ker_01" wrote in message
...
Excel 2003

The function below is a shaker sort, adapted from the website referenced
in
the code. I need to make two changes to it;
(1) I'll be feeding this two different arrays and I need to sort them both
the same way (as if it were a 2D array), so I added a second array and
related sorting based on any sorts that occur to the first array, and
(2) I need to have these modifications persist back to the calling
procedure. I thought ByVal would change the "real" array in memory, but if
that doesn't work I need to pass both arrays back to the calling
procedure.

So first, using the full sample below, the messagebox is returning the
original array order, not a revised order. I don't know if there is
something
wrong with the code, or if ByRef doesn't mean what I think it means?

Second, I tried a few syntax options to have the function return the
arrays
as a 1D array of arrays (as a backup, in case I can't just have the
changes
persist directly in the original array) but I couldn't get that working
either.

Any advice greatly appreciated!
Keith

Full code sample- just copy/paste into your code module, and run the sub.


Option Base 1

Sub test()

Dim TargetArray(1 To 3) As Long
Dim CategoryArray(1 To 3) As String

TargetArray(1) = 9
TargetArray(2) = 6
TargetArray(3) = 3
CategoryArray(1) = "Zebra"
CategoryArray(2) = "Walrus"
CategoryArray(3) = "Primate"
X = BSortArray(TargetArray, CategoryArray)
End Sub

Private Function BSortArray(ByRef TargetArray() As Long, ByRef
CatagoryArray() As String) As Variant 'will variant allow me to return an
array of arrays automagically?

'Sort multiple parallel 1-D Arrays based on 1-D Shaker Sort
'based on ShakerSort sample from
http://www.xtremevbtalk.com/showthread.php?t=78889
'This is a serious resource on array sorting, and reading it makes my
brain
hurt.

'Public Sub ShakerSort(ByRef lngArray() As Long)

Dim iLower As Long
Dim iUpper As Long
Dim iInner As Long
Dim iLBound As Long
Dim iUBound As Long
Dim iTemp As Long
Dim iTemp2 As String
Dim iMax As Long
Dim iMin As Long

iLBound = LBound(TargetArray)
iUBound = UBound(TargetArray)

iLower = iLBound - 1
iUpper = iUBound + 1

Do While iLower < iUpper

iLower = iLower + 1
iUpper = iUpper - 1

iMax = iLower
iMin = iLower

'Find the largest and smallest values in the subarray
For iInner = iLower To iUpper
If TargetArray(iInner) TargetArray(iMax) Then
iMax = iInner
ElseIf TargetArray(iInner) < TargetArray(iMin) Then
iMin = iInner
End If
Next iInner

'Swap the largest with last slot of the subarray
iTemp = TargetArray(iMax)
TargetArray(iMax) = TargetArray(iUpper)
TargetArray(iUpper) = iTemp
'Then do the exact same thing for the parallel array of category
titles/references
iTemp2 = CatagoryArray(iMax)
CatagoryArray(iMax) = CatagoryArray(iUpper)
CatagoryArray(iUpper) = iTemp2

'Swap the smallest with the first slot of the subarray
iTemp = TargetArray(iMin)
TargetArray(iMin) = TargetArray(iLower)
TargetArray(iLower) = iTemp
'Then do the exact same thing for the parallel array of category
titles/references
iTemp2 = CatagoryArray(iMin)
CatagoryArray(iMin) = CatagoryArray(iLower)
CatagoryArray(iLower) = iTemp2

Loop

'XL doesn't like my attempts to return the function results as an array of
arrays
' BSortArray(1) = TargetArray
' BSortArray(2) = CatagoryArray

'Just verify that the sort itself works
'but it doesn't, the msgbox shows everything in the original order?
MsgBox TargetArray(1) & " " & TargetArray(2) & " " & TargetArray(3) &
Chr(13) & Chr(13) & _
CatagoryArray(1) & " " & CatagoryArray(2) & " " & CatagoryArray(3)

End Function

Shakersort & my modifications that don't work :( - MY SOLUTION
 

Try change:

If lngArray(iInner) lngArray(iMax) Then
iMax = iInner
ElseIf lngArray(iInner) < lngArray(iMin) Then
iMin = iInner
End If

to

If lngArray(iInner) lngArray(iMax) Then
iMax = iInner
End If
Else lngArray(iInner) < lngArray(iMin) Then
iMin = iInner
End If

just my $00.02, I had the some problem, it worked for me

Jose Simoes





ker_01 wrote:

Shakersort & my modifications that don't work :(
01-Dec-09

Excel 2003

The function below is a shaker sort, adapted from the website referenced in
the code. I need to make two changes to it;
(1) I will be feeding this two different arrays and I need to sort them both
the same way (as if it were a 2D array), so I added a second array and
related sorting based on any sorts that occur to the first array, and
(2) I need to have these modifications persist back to the calling
procedure. I thought ByVal would change the "real" array in memory, but if
that does not work I need to pass both arrays back to the calling procedure.

So first, using the full sample below, the messagebox is returning the
original array order, not a revised order. I do not know if there is something
wrong with the code, or if ByRef does not mean what I think it means?

Second, I tried a few syntax options to have the function return the arrays
as a 1D array of arrays (as a backup, in case I cannot just have the changes
persist directly in the original array) but I could not get that working
either.

Any advice greatly appreciated!
Keith

Full code sample- just copy/paste into your code module, and run the sub.


Option Base 1

Sub test()

Dim TargetArray(1 To 3) As Long
Dim CategoryArray(1 To 3) As String

TargetArray(1) = 9
TargetArray(2) = 6
TargetArray(3) = 3
CategoryArray(1) = "Zebra"
CategoryArray(2) = "Walrus"
CategoryArray(3) = "Primate"
X = BSortArray(TargetArray, CategoryArray)
End Sub

Private Function BSortArray(ByRef TargetArray() As Long, ByRef
CatagoryArray() As String) As Variant 'will variant allow me to return an
array of arrays automagically?

'Sort multiple parallel 1-D Arrays based on 1-D Shaker Sort
'based on ShakerSort sample from
http://www.xtremevbtalk.com/showthread.php?t=78889
'This is a serious resource on array sorting, and reading it makes my brain
hurt.

'Public Sub ShakerSort(ByRef lngArray() As Long)

Dim iLower As Long
Dim iUpper As Long
Dim iInner As Long
Dim iLBound As Long
Dim iUBound As Long
Dim iTemp As Long
Dim iTemp2 As String
Dim iMax As Long
Dim iMin As Long

iLBound = LBound(TargetArray)
iUBound = UBound(TargetArray)

iLower = iLBound - 1
iUpper = iUBound + 1

Do While iLower < iUpper

iLower = iLower + 1
iUpper = iUpper - 1

iMax = iLower
iMin = iLower

'Find the largest and smallest values in the subarray
For iInner = iLower To iUpper
If TargetArray(iInner) TargetArray(iMax) Then
iMax = iInner
ElseIf TargetArray(iInner) < TargetArray(iMin) Then
iMin = iInner
End If
Next iInner

'Swap the largest with last slot of the subarray
iTemp = TargetArray(iMax)
TargetArray(iMax) = TargetArray(iUpper)
TargetArray(iUpper) = iTemp
'Then do the exact same thing for the parallel array of category
titles/references
iTemp2 = CatagoryArray(iMax)
CatagoryArray(iMax) = CatagoryArray(iUpper)
CatagoryArray(iUpper) = iTemp2

'Swap the smallest with the first slot of the subarray
iTemp = TargetArray(iMin)
TargetArray(iMin) = TargetArray(iLower)

Previous Posts In This Thread:

On Tuesday, December 01, 2009 8:11 PM
ker_01 wrote:

Shakersort & my modifications that don't work :(
Excel 2003

The function below is a shaker sort, adapted from the website referenced in
the code. I need to make two changes to it;
(1) I will be feeding this two different arrays and I need to sort them both
the same way (as if it were a 2D array), so I added a second array and
related sorting based on any sorts that occur to the first array, and
(2) I need to have these modifications persist back to the calling
procedure. I thought ByVal would change the "real" array in memory, but if
that does not work I need to pass both arrays back to the calling procedure.

So first, using the full sample below, the messagebox is returning the
original array order, not a revised order. I do not know if there is something
wrong with the code, or if ByRef does not mean what I think it means?

Second, I tried a few syntax options to have the function return the arrays
as a 1D array of arrays (as a backup, in case I cannot just have the changes
persist directly in the original array) but I could not get that working
either.

Any advice greatly appreciated!
Keith

Full code sample- just copy/paste into your code module, and run the sub.


Option Base 1

Sub test()

Dim TargetArray(1 To 3) As Long
Dim CategoryArray(1 To 3) As String

TargetArray(1) = 9
TargetArray(2) = 6
TargetArray(3) = 3
CategoryArray(1) = "Zebra"
CategoryArray(2) = "Walrus"
CategoryArray(3) = "Primate"
X = BSortArray(TargetArray, CategoryArray)
End Sub

Private Function BSortArray(ByRef TargetArray() As Long, ByRef
CatagoryArray() As String) As Variant 'will variant allow me to return an
array of arrays automagically?

'Sort multiple parallel 1-D Arrays based on 1-D Shaker Sort
'based on ShakerSort sample from
http://www.xtremevbtalk.com/showthread.php?t=78889
'This is a serious resource on array sorting, and reading it makes my brain
hurt.

'Public Sub ShakerSort(ByRef lngArray() As Long)

Dim iLower As Long
Dim iUpper As Long
Dim iInner As Long
Dim iLBound As Long
Dim iUBound As Long
Dim iTemp As Long
Dim iTemp2 As String
Dim iMax As Long
Dim iMin As Long

iLBound = LBound(TargetArray)
iUBound = UBound(TargetArray)

iLower = iLBound - 1
iUpper = iUBound + 1

Do While iLower < iUpper

iLower = iLower + 1
iUpper = iUpper - 1

iMax = iLower
iMin = iLower

'Find the largest and smallest values in the subarray
For iInner = iLower To iUpper
If TargetArray(iInner) TargetArray(iMax) Then
iMax = iInner
ElseIf TargetArray(iInner) < TargetArray(iMin) Then
iMin = iInner
End If
Next iInner

'Swap the largest with last slot of the subarray
iTemp = TargetArray(iMax)
TargetArray(iMax) = TargetArray(iUpper)
TargetArray(iUpper) = iTemp
'Then do the exact same thing for the parallel array of category
titles/references
iTemp2 = CatagoryArray(iMax)
CatagoryArray(iMax) = CatagoryArray(iUpper)
CatagoryArray(iUpper) = iTemp2

'Swap the smallest with the first slot of the subarray
iTemp = TargetArray(iMin)
TargetArray(iMin) = TargetArray(iLower)

On Tuesday, December 01, 2009 10:35 PM
Bernie Deitrick wrote:

ker,You picked a bad code source to use as the basis of your code.
ker,

You picked a bad code source to use as the basis of your code.

If, as in your case, the Max is in the first position and the Min is in the
last, the swapping code blows it by doing the same swap twice, reverting the
data to their original positions. The coder clearly did not check all cases.
The code blows it on other subsequent internal sorts as well.

You can fix the code by checking for that case and only doing the swap once:

'Check if the largest and smallest are in each other's positions
If iMax = iLower And iMin = iUpper Then
iTemp = lngArray(iMax)
lngArray(iMax) = lngArray(iMin)
lngArray(iMin) = iTemp
Else
'Swap the largest with last slot of the subarray
iTemp = lngArray(iMax)
lngArray(iMax) = lngArray(iUpper)
lngArray(iUpper) = iTemp

'Swap the smallest with the first slot of the subarray
iTemp = lngArray(iMin)
lngArray(iMin) = lngArray(iLower)
lngArray(iLower) = iTemp
End If


HTH,
Bernie
MS Excel MVP


Submitted via EggHeadCafe - Software Developer Portal of Choice
ASP.NET Functionally Rich Repeater Control
http://www.eggheadcafe.com/tutorials...ally-rich.aspx