PDA

View Full Version : Array Sort - once more...



ReneMiner
17-12-2015, 11:05
Currently i do some sorting of two associated Arrays (String + lineNumber, because i can not sort an UDT)
by appending MKL$(lineNumber) to the string-array-members which are to sort- so i have my connection between String and Number that belong together. So i sort by alphabet and i cut the last 4 bytes from the string after copying them to the numerical array-elements with same Index.
Thats quite simple because i have only to sort by element sName and there's only one more element to consider.

(see thinIce.tBasic, Sub btnCodeFunctionList_Click() - the small button up-left of a codewindow that displays the function-names of scriptunit)



Now we have a new #Trace (#Profile)- directive.

It writes csv-file that i can read in as data like


Dim FunctionNames() As String
Dim NumberOfCalls() As Number
Dim UsedTime() As Number


The FunctionName(1), NumberOfCalls(1) and UsedTime(1) belong together- so they are associated somehow.

if i sort one of these now i have no clue what index the element had before and which time belongs to which name. And if i want to sort by UsedTime or NumberOfCalls it would be some effort

lets say i read in the values from csv-file to myProfile() in a structure as below.

Now I want to sort by ... FunctionNames, but the other two arrays shall be sorted the same order too...

i would do it this way:




Type tProfile
FunctionName As String
NumberOfCalls As Number
UsedTime As Number
End Type

Dim myProfile() As tProfile

' now i loaded, parsed and filled csv-data into myProfile()-array
' lets say it has 1234 members now...
' and i want to sort by function-names:

Array Sort myProfile, UDT_Element(tProfile.FunctionName), Collate Ucase

' or i want to sort to see what used the most time:

Array Sort myProfile, UDT_Element(tProfile.UsedTime), Descend


now i could display data as sorted.

So either we should be able to sort UDTs

or back to the simple Arrays:


Dim FunctionNames(123) As String
Dim NumberOfCalls(123) As Number
Dim UsedTime(123) As Number
' lets say these variables are filled now...

' create a Buffer :
Dim myIndexList(Ubound(FunctionNames)) As Long

' now pass the pointer where to store the indices
Array Sort FunctionNames, Collate Ucase, VarPtr(myIndexList(1))

so myIndexList(1) later would hold the NEW Index of previous FunctionNames(1) and I could bring NumberOfCalls() and UsedTime() in the same order.

ReneMiner
20-12-2015, 10:34
This my attempt to sort UDTs.

Not complete (no sorting of subelements that are Strings implemented) but serves me to sort and display a #Trace-result-file by the numbers since i have no idea how else to display csv without having excel.

Save this next to a trace-file or replace TraceFilename in TBMain with a valid filename.



' #Filename "testArraySort.tBASIC"
' #Author "René"
' #Date "2015-12-20"
Uses "Console", "File"


Type tProfile
FunctionName As String
NumberOfCalls As Number
UsedTime As Number

End Type


' --------------------------------------------------------------------------------
Function TBMain()
' --------------------------------------------------------------------------------


Local sLine(), sPart() As String
Local i, nLines As Long
Local Trace() As tProfile


' load tracefile and parse it

nLines = Parse( File Tracefilename, sLine, $CRLF )

' either replace Tracefilename with a valid filename
' or save this script into a directory that contains "*Trace*.csv"-files

If nLines < 2 Then
PrintL "no Trace-file found"
WaitKey
Stop
EndIf

PrintL "have " & nLines & " lines"

Array Sort sLine, Descend ' bring empty elements to the end

While StrPtrLen(StrPtr(sLine(UBound(sLine)))) = 0
' kill empty elements
nLines -= 1
ReDim Preserve sLine(nLines)
Wend

PrintL "now have " & nLines & " lines"

ReDim Trace(nLines)
' fill data into udt now:

For i = 1 To nLines
ReDim sPart(1)
If Parse(sLine(i), sPart, ";") = 3 Then
Trace(i).FunctionName = sPart(1)
Trace(i).NumberOfCalls = Val(sPart(2))
Trace(i).UsedTime = Val(sPart(3))

EndIf
Next
PrintL "data filled in " & UBound(trace) & " elements"

PrintL
PrintL "any key to sort by used time now"

WaitKey

' now sort Array of tProfile by udt_element(tProfile.UsedTime):

If Array_Sort_Type( Trace, "tProfile", "Number", UDT_ElementOffset(Trace(1).UsedTime)) Then Nop
' need use "If" to request a function result
' because of dynamic variables within Array_Sort_Type()

For i = 1 To UBound(Trace)
PrintL Trace(i).UsedTime, Trace(i).FunctionName, Trace(i).NumberOfCalls
Next

PrintL
PrintL "any key to sort by number of calls now"
WaitKey

' sort Array of tProfile by udt_element(tProfile.NumberOfCalls):

If Array_Sort_Type( Trace, "tProfile", "Number", UDT_ElementOffset(Trace(1).NumberOfCalls)) Then Nop

For i = 1 To UBound(Trace)
PrintL Trace(i).NumberOfCalls, Trace(i).FunctionName, Trace(i).UsedTime
Next


PrintL
PrintL "any key to end"

WaitKey

End Function

' -----------------------------------------------------------------
Function Array_Sort_Type( ByRef a() As Byte, _
ByVal TypeOfUDT As String, _
ByVal TypeOfSubset As String, _
ByVal lSubOffset As Long, _
Optional ByVal lDirection As Long = 1 _
) As Boolean
' -----------------------------------------------------------------


Local lCount, lIndex As Long
Local sElement As String

Local realArray(UBound(a)) Like TypeOfUDT At VarPtr(a(1))

Local lNum1 Like TypeOfSubset At 0
Local lNum2 Like TypeOfSubset At 0

If UBound(a) < 2 Then Exit Function

If lDirection < 0 Then
' descend

Select Case Ucase$(TypeOfSubset)
Case "STRING"
' not implemented for strings
Case Else
For lCount = 2 To UBound(a)
sElement = Memory_Get(VarPtr(realArray(lCount)), SizeOf(realArray(1)))
lIndex = lCount

SetAt( lNum1, VarPtr(realArray(lIndex-1)) + lSubOffset )
SetAt( lNum2, StrPtr(sElement) + lSubOffset )
While lNum1 < lNum2
Memory_Set(VarPtr(realArray(lIndex)), Memory_Get(VarPtr(realArray(lIndex-1)), SizeOf(realArray(1))))
lIndex -= 1
If lIndex = 1 Then Exit While
SetAt( lNum1, VarPtr(realArray(lIndex-1)) + lSubOffset )
Wend
Memory_Set(VarPtr(realArray(lIndex)), sElement)
Next
End Select

Else
' ascend


Select Case Ucase$(TypeOfSubset)
Case "STRING"
' not implemented for strings

Case Else
For lCount = 2 To UBound(a)
sElement = Memory_Get(VarPtr(realArray(lCount)), SizeOf(realArray(1)))
lIndex = lCount

SetAt( lNum1, VarPtr(realArray(lIndex-1)) + lSubOffset )
SetAt( lNum2, StrPtr(sElement) + lSubOffset )
While lNum1 > lNum2
Memory_Set(VarPtr(realArray(lIndex)), Memory_Get(VarPtr(realArray(lIndex-1)), SizeOf(realArray(1))))
lIndex -= 1
If lIndex = 1 Then Exit While
SetAt( lNum1, VarPtr(realArray(lIndex-1)) + lSubOffset )
Wend
Memory_Set(VarPtr(realArray(lIndex)), sElement)
Next
End Select
EndIf

Function = TRUE

End Function



' --------------------------------------------------------------------------------
Function TraceFilename() As String
' --------------------------------------------------------------------------------

' seems Load_File does not accept wildcards...

Local sFile(), sPrompt As String
Local i, nFiles, slctd As Long

nFiles = DIR_ListArray(sFile, APP_ScriptPath, "*Trace*.csv", %FILE_NORMAL)

Select Case nFiles
Case 0
Return ""
Case 1
Return sFile(1)
End Select

For i = 1 To nFiles
sPrompt &= "[" & TStr$(i) & "] " & sFile(i) & $CRLF
Next

slctd = Val( InputBox$(sPrompt ,"Please select a file-number", "1") )

If Not Between(slctd, 1, nFiles) Then
Function = ""
Else
Function = sFile(slctd)
EndIf

End Function

ErosOlmi
20-12-2015, 12:40
Regarding a general Array Sort working on any UDT, I have some idea but not yet tested.


Regarding reading data from new thinBasic Profile option, please find here attached an utility I will release in next thinBasic version.

Just call it passing profile file name and an optional flag DELETE that instruct profiler to delete profile file

thinBasic_Profiler.exe <full profile file path name> [DELETE]

It will open a window with a 3 column listview. Clicking on listview header you can sort data on any column.
In future versions there will be more information on function execution on which I'm working on: number of parameters, number of local variables, timing to create local function stack, time to unload local function stack on function exit, ...

Ciao
Eros

ReneMiner
20-12-2015, 13:23
thank you.

For the meantime: save this next to thinBasic_Profiler.exe (download at post of Eros above) and run to select the desired file:



' #Filename "launchTBProfiler.tBASIC"

Uses "UI", "OS"



' --------------------------------------------------------------------------------
Function TBMain()
' --------------------------------------------------------------------------------


Local sFile As String

sFile = Dialog_OpenFile(0, "Select Profile", APP_ScriptPath, "Profiles (*.CSV)|*.CSV|All Files (*.*)|*.*", "CSV", %OFN_FILEMUSTEXIST)
If StrPtrLen(StrPtr(sFile)) Then
OS_Shell( APP_ScriptPath & "thinBasic_Profiler.exe " & sFile, %OS_WNDSTYLE_NORMAL, %OS_SHELL_SYNC )
EndIf

End Function