Sorting

[d_miecznik]

How can I sort a .log file when "," is my delimiter??

[Johnny101]

it depends on what kind of sorting you want to use. But first you have to get the data out of the file and into a seperate container. if you have VB6, then i would suggest using the split function to parse the information and it returns an array, filled with the entries between the specified deliminator. there's an aricle on the www.vbpj.com about sorting from the May issue that should help out with the sorting.

hope this helps,

john

John Pirkey
MCSD
http://www.ShallowWaterSystems.com
http://www.stlvbug.org

[Spectre]

Here is the contents of a post that I made some time ago dealing with sorting:

Visual Basic Programming

Subject Re: Binary search problem
Category ActiveX
Posted by Spectre on 7/19/00 at 07:46 am
Rating not rated


Here is the code for a .bas module containing various sort functions. Some I wrote, some I converted from QuickBasic to VB. Each sort comes in two flavors, one which takes an array and sorts it, and one which takes two arrays - sorts the first and keeps the second in sync with it. I would use the Quick Sort routine if speed is of the essence, however, keep in mind that the Quidk sort alogrythm is highly recursive (meaning that it calls itself) and this can run VB out of stack space. If you are using recursion in your functions and incur stack problems, use the Shell Sort, it is just slightly slower than the Quick Sort but is non recursive.



'Sort module for Visual Basic
'
'Written by Kevin D. Rucker
'kevinr@wvadventures.net
'
'August 1998
'
'Insertion_Sort, Shell_Sort, and Quick_Sort routines adapted from
'Sort.bas QuickBasic program downloaded from America on-Line, Author unknown.
'
'Usage:
'
'Add this module to your project, then in your code add the following:
'
'Dim Return_Variable as Boolean
'Return_Variable = Sort.This_Array(The_Array, S_Type, Asending)
'
'The_Array = Array to be sorted
'
'to sort 2 Arrays in sync:
'
'Dim Return_Variable as Boolean
'Return_Variable = Sort.These_Arrays(Key_Array, Sync_Array, S_Type, Asending)
'
'Key_Array = Primary array to be sorted
'Sync_Array = Array to be kept in sync with Key_Array
'
'S_Type = byte value indicating the sort type required.
'The following constants define the types for S_Type:
'
public Const Bubble_Sort = 1 'Very slow
public Const Insertion_Sort = 2 'Faster but still relatively slow
public Const Shell_Sort = 4 'Very fast, doesn't use recursion
public Const Quick_Sort = 8 'Fastest sort in this module but very recursive
public Const Sync_Bubble_Sort = 16 'Sycronized sort on 2 arrays
public Const Sync_Insertion_Sort = 32 'Sycronized sort on 2 arrays
public Const Sync_Shell_Sort = 64 'Sycronized sort on 2 arrays
public Const Sync_Quick_Sort = 128 'Sycronized sort on 2 arrays
'
'Ascending = true (sort asending)
'Ascending = false (sort desending)
'
'All arrays described as arrays of variants, this allows arrays of any
'built in Visual Basic variable type. User defined types not yet supported.
'All iterators and indices are declared as long, this allows for arrays with up
'to 2,147,483,647 elements (also subject to standard VB memory restrictions).
'
'Note: About recursive functions, if your program has a lot of nested functions,
'functions that call themselves (recursive), or nested loops you can run
'Visual Basic out of stack space. In a case of a program like that I would
'recommend using the shell sort as it is not recursive, yet is relatively fast.
'In a case where speed is of the essence, use quick sort it is a very very fast
'sort alogrythm (provided the recursion dosen't run you out of stack space).
'
'for production code you may want to comment out or delete the sections of code
'marked as delay counters. They provide the system with DoEvent commands allowing
'Windows the time to update the display. If you plan to use progress indicators,
'place the code to update your indicators inside the delay counter if..then..endif
'code blocks.

'Control function for single array sorts
public Function This_Array(byref N_Array, S_Type as Byte, Asending as Boolean) as Boolean
Dim Success as Boolean
Dim N_Elements as Long
N_Elements = UBound(N_Array) + 1
If S_Type = Bubble_Sort then Success = Bubble_Sort_Fn(N_Array, N_Elements, Asending)
If S_Type = Insertion_Sort then Success = Insertion_Sort_Fn(N_Array, N_Elements, Asending)
If S_Type = Shell_Sort then Success = Shell_Sort_Fn(N_Array, N_Elements, Asending)
If S_Type = Quick_Sort then Success = Quick_Sort_Fn(N_Array, 1, N_Elements, Asending)
This_Array = Success
End Function

'Control function for sycronised array sorts
public Function These_Arrays(byref Key_Array, byref Sync_Array, S_Type as Byte, Asending as Boolean) as Boolean
Dim Success as Boolean
Dim N_Elements as Long
N_Elements = UBound(N_Array) + 1
If S_Type = Sync_Bubble_Sort then Success = Sync_Bubble_Sort_Fn(Key_Array, Sync_Array, N_Elements, Asending)
If S_Type = Sync_Insertion_Sort then Success = Sync_Insertion_Sort_Fn(Key_Array, Sync_Array, N_Elements, Asending)
If S_Type = Sync_Shell_Sort then Success = Sync_Shell_Sort_Fn(Key_Array, Sync_Array, N_Elements, Asending)
If S_Type = Sync_Quick_Sort then Success = Sync_Quick_Sort_Fn(Key_Array, Sync_Array, 1, N_Elements, Asending)
These_Array = Success
End Function

'The following are the actual sort routines

private Function Bubble_Sort_Fn(byref Array1, N_Elements as Long, Asending as Boolean)
Dim Last as Long, Current as Long, i as Long, Delay_Counter as Long
Dim Success as Boolean, Hit as Boolean
Last = N_Elements - 1
If Asending = true then
Again1:
for i = 0 to Last - 1
If Array1(i) > Array1(i + 1) then
Success = Swap(Array1(i), Array1(i + 1))
If Hit <> true then
Hit = true
End If
End If
'Screen update delay counter
'Remove or comment out for production code
'>>> Delay counter start <<<
Delay_Counter = Delay_Counter + 1
If Delay_Counter = 10000 then
Delay_Counter = 0
DoEvents
End If
'>>> Delay counter end <<<
next i
If Hit = true then
Hit = false
GoTo Again1
End If
else
Again2:
for i = Last to 1 step -1
If Array1(i) > Array1(i - 1) then
Success = Swap(Array1(i), Array1(i - 1))
If Hit <> true then
Hit = true
End If
End If
'Screen update delay counter
'Remove or comment out for production code
'>>> Delay counter start <<<
Delay_Counter = Delay_Counter + 1
If Delay_Counter = 10000 then
Delay_Counter = 0
DoEvents
End If
'>>> Delay counter end <<<
next i
If Hit = true then
Hit = false
GoTo Again2
End If
End If
Bubble_Sort_Fn = true
End Function

private Function Insertion_Sort_Fn(byref Array1, N_Elements as Long, Asending as Boolean) as Boolean
Dim i as Long, Position as Long
Dim Temp as Variant
Dim Done as Boolean
If Asending = true then
for i = 1 to N_Elements - 1
Temp = Array1(i)
Position = i
Done = false
Do While (Position >= 1) And (Done = false)
If Temp < Array1(Position - 1) then
Array1(Position) = Array1(Position - 1)
Position = Position - 1
else
Done = true
End If
Loop
Array1(Position) = Temp
'Screen update delay counter
'Remove or comment out for production code
'>>> Delay counter start <<<
Delay_Counter = Delay_Counter + 1
If Delay_Counter = 10 then
Delay_Counter = 0
DoEvents
End If
'>>> Delay counter end <<<
next i
else
for i = N_Elements - 2 to 0 step -1
Temp = Array1(i)
Position = i
Done = false
Do While (Position <= N_Elements - 2) And (Done = false)
If Temp < Array1(Position + 1) then
Array1(Position) = Array1(Position + 1)
Position = Position + 1
else
Done = true
End If
Loop
Array1(Position) = Temp
'Screen update delay counter
'Remove or comment out for production code
'>>> Delay counter start <<<
Delay_Counter = Delay_Counter + 1
If Delay_Counter = 10 then
Delay_Counter = 0
DoEvents
End If
'>>> Delay counter end <<<
next i
End If
Insertion_Sort_Fn = true
End Function

private Function Shell_Sort_Fn(byref Array1, N_Elements as Long, Asending as Boolean) as Boolean
Dim i as Long, Position as Long, Segments as Long
Dim Temp as Variant
Dim Done as Boolean
Segments = N_Elements / 2
Do While (Segments > 0)
for i = Segments to N_Elements - 1
Temp = Array1(i)
Position = i - Segments
Done = false
Do While (Position >= 0) And (Done = false)
If Temp < Array1(Position) then
Array1(Position + Segments) = Array1(Position)
Position = Position - Segments
else
Done = true
End If
Loop
Array1(Position + Segments) = Temp
next i
Segments = Segments / 2
'Screen update delay counter
'Remove or comment out for production code
'>>> Delay counter start <<<
Delay_Counter = Delay_Counter + 1
If Delay_Counter = 10 then
Delay_Counter = 0
DoEvents
End If
'>>> Delay counter end <<<
Loop
If Asending = false then
Dim Array2() as Variant
Erase Array2
ReDim Array2(N_Elements - 1)
for i = N_Elements - 1 to 0 step -1
Array2(N_Elements - 1 - i) = Array1(i)
next i
for i = 0 to N_Elements - 1
Array1(i) = Array2(i)
next i
Erase Array2
End If
Shell_Sort_Fn = true
End Function

private Function Quick_Sort_Fn(byref Array1, Low as Long, N_Elements as Long, Asending as Boolean) as Boolean
Dim Left as Long, Right as Long, Hi as Long
Dim Middle as Variant
Dim Success as Boolean
Left = Low - 1
Low = Left
Right = N_Elements - 1
Hi = Right
Middle = Array1((Left + Right) / 2)
Do
Do While (Array1(Right) > Middle)
Right = Right - 1
Loop
Do While (Array1(Left) < Middle)
Left = Left + 1
Loop
If Left <= Right then
Success = Swap(Array1(Left), Array1(Right))
Left = Left + 1
Right = Right - 1
End If
Loop Until (Right < Left)
'Screen update delay counter
'Remove or comment out for production code
'>>> Delay counter start <<<
Delay_Counter = Delay_Counter + 1
If Delay_Counter = 10 then
Delay_Counter = 0
DoEvents
End If
'>>> Delay counter end <<<
If Low < Right then Success = Quick_Sort_Fn(Array1, Low + 1, Right + 1, Asending)
If Left < Hi then Success = Quick_Sort_Fn(Array1, Left + 1, Hi + 1, Asending)
If Asending = false then
Dim Array2() as Variant
Erase Array2
ReDim Array2(N_Elements - 1)
for i = N_Elements - 1 to 0 step -1
Array2(N_Elements - 1 - i) = Array1(i)
next i
for i = 0 to N_Elements - 1
Array1(i) = Array2(i)
next i
Erase Array2
End If
Quick_Sort_Fn = true
End Function

private Function Sync_Bubble_Sort_Fn(byref Array1, byref Array2, N_Elements as Long, Asending as Boolean)
Dim Last as Long, Current as Long, i as Long, Delay_Counter as Long
Dim Success as Boolean, Hit as Boolean
Last = N_Elements - 1
If Asending = true then
for i = 0 to Last - 1
If Array1(i) > Array1(i + 1) then
Success = Swap(Array1(i), Array1(i + 1))
Success = Swap(Array2(i), Array2(i + 1))
Hit = true
End If
If Hit = true then
Hit = false
i = -1
End If
'Screen update delay counter
'Remove or comment out for production code
'>>> Delay counter start <<<
Delay_Counter = Delay_Counter + 1
If Delay_Counter = 10000 then
Delay_Counter = 0
DoEvents
End If
'>>> Delay counter end <<<
next i
else
for i = Last to 1 step -1
If Array1(i) > Array1(i - 1) then
Success = Swap(Array1(i), Array1(i - 1))
Success = Swap(Array2(i), Array2(i - 1))
Hit = true
End If
If Hit = true then
Hit = false
i = Last + 1
End If
'Screen update delay counter
'Remove or comment out for production code
'>>> Delay counter start <<<
Delay_Counter = Delay_Counter + 1
If Delay_Counter = 10000 then
Delay_Counter = 0
DoEvents
End If
'>>> Delay counter end <<<
next i
End If
Sync_Bubble_Sort_Fn = true
End Function

private Function Sync_Insertion_Sort_Fn(byref Array1, byref Array2, N_Elements as Long, Asending as Boolean) as Boolean
Dim i as Long, Position as Long
Dim Temp1 as Variant, Temp2 as Variant
Dim Done as Boolean
If Asending = true then
for i = 1 to N_Elements - 1
Temp1 = Array1(i)
Temp2 = Array2(i)
Position = i
Done = false
Do While (Position >= 1) And (Done = false)
If Temp < Array1(Position - 1) then
Array1(Position) = Array1(Position - 1)
Array2(Position) = Array2(Position - 1)
Position = Position - 1
else
Done = true
End If
Loop
Array1(Position) = Temp1
Array2(Position) = Temp2
'Screen update delay counter
'Remove or comment out for production code
'>>> Delay counter start <<<
Delay_Counter = Delay_Counter + 1
If Delay_Counter = 10 then
Delay_Counter = 0
DoEvents
End If
'>>> Delay counter end <<<
next i
else
for i = N_Elements - 2 to 0 step -1
Temp1 = Array1(i)
Temp2 = Array2(i)
Position = i
Done = false
Do While (Position <= N_Elements - 2) And (Done = false)
If Temp < Array1(Position + 1) then
Array1(Position) = Array1(Position + 1)
Array2(Position) = Array2(Position + 1)
Position = Position + 1
else
Done = true
End If
Loop
Array1(Position) = Temp1
Array2(Position) = Temp2
'Screen update delay counter
'Remove or comment out for production code
'>>> Delay counter start <<<
Delay_Counter = Delay_Counter + 1
If Delay_Counter = 10 then
Delay_Counter = 0
DoEvents
End If
'>>> Delay counter end <<<
next i
End If
Sync_Insertion_Sort_Fn = true
End Function

private Function Sync_Shell_Sort_Fn(byref Array1, byref Array2, N_Elements as Long, Asending as Boolean) as Boolean
Dim i as Long, Position as Long, Segments as Long
Dim Temp1 as Variant, Temp2 as Variant
Dim Done as Boolean
Segments = N_Elements / 2
Do While (Segments > 0)
for i = Segments to N_Elements - 1
Temp1 = Array1(i)
Temp2 = Array2(i)
Position = i - Segments
Done = false
Do While (Position >= 0) And (Done = false)
If Temp < Array1(Position) then
Array1(Position + Segments) = Array1(Position)
Array2(Position + Segments) = Array2(Position)
Position = Position - Segments
else
Done = true
End If
Loop
Array1(Position + Segments) = Temp1
Array2(Position + Segments) = Temp2
next i
Segments = Segments / 2
'Screen update delay counter
'Remove or comment out for production code
'>>> Delay counter start <<<
Delay_Counter = Delay_Counter + 1
If Delay_Counter = 10 then
Delay_Counter = 0
DoEvents
End If
'>>> Delay counter end <<<
Loop
If Asending = false then
Dim T_Array1() as Variant
Dim T_Array2() as Variant
Erase T_Array1
Erase T_Array2
ReDim T_Array1(N_Elements - 1)
ReDim T_Array2(N_Elements - 1)
for i = N_Elements - 1 to 0 step -1
T_Array1(N_Elements - 1 - i) = Array1(i)
T_Array2(N_Elements - 1 - i) = Array2(i)
next i
for i = 0 to N_Elements - 1
Array1(i) = T_Array1(i)
Array2(i) = T_Array2(i)
next i
Erase T_Array1
Erase T_Array2
End If
Sync_Shell_Sort_Fn = true
End Function

private Function Sync_Quick_Sort_Fn(byref Array1, byref Array2, Low as Long, N_Elements as Long, Asending as Boolean) as Boolean
Dim Left as Long, Right as Long, Hi as Long
Dim Middle as Variant
Dim Success as Boolean
Left = Low - 1
Low = Left
Right = N_Elements - 1
Hi = Right
Middle = Array1((Left + Right) / 2)
Do
Do While (Array1(Right) > Middle)
Right = Right - 1
Loop
Do While (Array1(Left) < Middle)
Left = Left + 1
Loop
If Left <= Right then
Success = Swap(Array1(Left), Array1(Right))
Success = Swap(Array2(Left), Array2(Right))
Left = Left + 1
Right = Right - 1
End If
Loop Until (Right < Left)
'Screen update delay counter
'Remove or comment out for production code
'>>> Delay counter start <<<
Delay_Counter = Delay_Counter + 1
If Delay_Counter = 10 then
Delay_Counter = 0
DoEvents
End If
'>>> Delay counter end <<<
If Low < Right then Success = Sync_Quick_Sort_Fn(Array1, Array2, Low + 1, Right + 1, Asending)
If Left < Hi then Success = Sync_Quick_Sort_Fn(Array1, Array2, Left + 1, Hi + 1, Asending)
If Asending = false then
Dim T_Array1() as Variant
Dim T_Array2() as Variant
Erase T_Array1
Erase T_Array2
ReDim T_Array1(N_Elements - 1)
ReDim T_Array2(N_Elements - 1)
for i = N_Elements - 1 to 0 step -1
T_Array1(N_Elements - 1 - i) = Array1(i)
T_Array2(N_Elements - 1 - i) = Array2(i)
next i
for i = 0 to N_Elements - 1
Array1(i) = T_Array1(i)
Array2(i) = T_Array2(i)
next i
Erase T_Array1
Erase T_Array2
End If
Sync_Quick_Sort_Fn = true
End Function

'Swap function used internally by sort routines to swap values between two
'array elements
private Function Swap(byref Element1 as Variant, byref Element2 as Variant) as Boolean
Dim Temp as Variant
Temp = Element1
Element1 = Element2
Element2 = Temp
Swap = true
End Function







P.S. Here is the code to a .bas file that I wrote that uses a a true binary search (or as us oldtimers called it a partition search). It is the companion module to the module above.


'Usage:
'Dim ReturnVariable as long
'Array1 and Array2 must be pre-sorted in ascending order.
'ReturnVariable = BinarySearch(Array1, Array2, Number_of_records, SearchKey)
'If ReturnVariable = -1 : No match found.
'If ReturnVariable <> -1 : ReturnVariable = record_number of match

public Function BinarySearch(Array1, Array2, Numrecs as Long, KeyValue as string) as Long
Dim UpperLimit as Long, LowerLimit as Long, Current as Long, Results as Long
Dim Hit as Boolean, EndLoop as Boolean
Hit = false
EndLoop = false
UpperLimit = Numrecs
LowerLimit = 0
Do
Current = Int((UpperLimit - LowerLimit) / 2) + LowerLimit
If Val(Array1(Current)) = Val(KeyValue) then
Hit = true
Results = Array2(Current)
End If
If UpperLimit - LowerLimit <= 2 then
If Val(Array1(UpperLimit)) = Val(KeyValue) then
Hit = true
Results = Array2(UpperLimit)
EndLoop = true
End If
If Val(Array1(LowerLimit)) = Val(KeyValue) then
Hit = true
Results = Array2(LowerLimit)
EndLoop = true
End If
End If
If Val(Array1(Current)) > Val(KeyValue) then UpperLimit = Current
If Val(Array1(Current)) < Val(KeyValue) then LowerLimit = Current
If Hit = true then EndLoop = true
If Hit = false then
If UpperLimit - LowerLimit = 1 then EndLoop = true
End If
Loop Until EndLoop = true
If Hit = false then Results = -1
BinarySearch = Results
End Function






Hope this helps.
Spectre



:^)