Multi-field generic stable array sort

Share your advanced PureBasic knowledge/code with the community.
said
Enthusiast
Enthusiast
Posts: 342
Joined: Thu Apr 14, 2011 6:07 pm

Multi-field generic stable array sort

Post by said »

Hi,

Here is one routine that can sort a structured array on many fields, the sorting algorithm is Bottom-up iterative merge sort which is a stable sort :D . I have done many tests and it looks fine and fast enough (below is a test code as well). If you find bugs pls let me know :)

Code: Select all

Procedure   MySortArray(AdressOfArray, SizeOfStructure, List FldOffset.i(), List FldOption.i(), List FldType.i(), RangeStart, RangeEnd)
    ; generic, multi-fields, bottom-up iterative, stable merge-sort
    ; usage: MySortArray(@Ary(0), SizeOf(ary_structre), Flds(), Opts(), Typs(), RangeStart, RangeEnd)
    Protected   n,i,j,m, k, s1,e1,s2,e2, z, srt_asc, tmp, mode, res, dlt
    Protected   *a, *b, *pi, *pj, *p, *q
    Protected   Fld_Adr, Fld_Opt, Fld_Typ, iFld, nFld, Dim FAdr(0), Dim FOpt(0), Dim FTyp(0)
    
    n  = RangeEnd - RangeStart + 1
    If n <= 0 : ProcedureReturn : EndIf
    If ListSize(FldOffset()) = 0 : ProcedureReturn : EndIf
    *a = AdressOfArray
    *b = AllocateMemory(n * SizeOfStructure)
    z  = SizeOfStructure
    
    ; converting lists into arrays, faster access (guarantee all 3 lists have same size)
    nFld = ListSize(FldOffset()) - 1
    Dim FAdr(nFld)
    Dim FOpt(nFld)
    Dim FTyp(nFld)
    ForEach FldOffset()
        FAdr(iFld) = FldOffset()
        If SelectElement(FldOption(), ListIndex(FldOffset()))   : FOpt(iFld) = FldOption()  : EndIf
        If SelectElement(FldType(), ListIndex(FldOffset()))     : FTyp(iFld) = FldType()    : EndIf
        iFld + 1
    Next
    
    k = 1       ; at each run, k is the nbr of elements in each half
    While k < n
        s1 = RangeStart
        While s1 <= RangeEnd
            e1 = s1 + (k-1) : If e1 > RangeEnd : e1 = RangeEnd : EndIf
            e2 = -1
            s2 = e1 + 1
            If s2 <= RangeEnd
                e2 = s2 + (k-1) : If e2 > RangeEnd : e2 = RangeEnd : EndIf
            EndIf
            m = s1 - RangeStart : i = s1 : j = s2
            
            While (i <= e1 And j <= e2)
                For iFld = 0 To nFld
                    Fld_Adr = FAdr(iFld)
                    Fld_Opt = FOpt(iFld)
                    Fld_Typ = FTyp(iFld)
                    srt_asc = Bool( (Fld_Opt & #PB_Sort_Descending) = 0 )
                    *pi = AdressOfArray + (SizeOfStructure * i) + Fld_Adr
                    *pj = AdressOfArray + (SizeOfStructure * j) + Fld_Adr
                    Select Fld_Typ
                        Case #PB_Byte       : dlt = PeekB(*pi) - PeekB(*pj)
                        Case #PB_Ascii      : dlt = PeekA(*pi) - PeekA(*pj)
                        Case #PB_Character  : dlt = PeekC(*pi) - PeekC(*pj)
                        Case #PB_Unicode    : dlt = PeekU(*pi) - PeekU(*pj)
                        Case #PB_Long       : dlt = PeekL(*pi) - PeekL(*pj)
                        Case #PB_Integer    : dlt = PeekI(*pi) - PeekI(*pj)
                        Case #PB_Float      : dlt = Sign(PeekF(*pi) - PeekF(*pj))
                        Case #PB_Quad       : dlt = Sign(PeekQ(*pi) - PeekQ(*pj))
                        Case #PB_Double     : dlt = Sign(PeekD(*pi) - PeekD(*pj))
                        Case #PB_String
                            mode = #PB_String_CaseSensitive
                            If (Fld_Opt & #PB_Sort_NoCase) : mode = #PB_String_NoCase : EndIf
                            
                            tmp = CompareMemoryString(PeekI(*pi), PeekI(*pj), mode)
                            If tmp = #PB_String_Equal   : dlt =  0 : EndIf
                            If tmp = #PB_String_Lower   : dlt = -1 : EndIf
                            If tmp = #PB_String_Greater : dlt =  1 : EndIf
                    EndSelect
                    If srt_asc
                        If dlt <= 0 : res = -1 : Else : res = 1 : EndIf
                    Else
                        If dlt >= 0 : res = -1 : Else : res = 1 : EndIf
                    EndIf
                    If dlt <> 0 : Break : EndIf
                Next
                If res <= 0
                    *p = *a + (z * i) : *q = *b + (z * m) : CopyMemory(*p, *q, z) : i+1
                Else
                    *p = *a + (z * j) : *q = *b + (z * m) : CopyMemory(*p, *q, z) : j+1
                EndIf
                m+1
            Wend
            If i <= e1
                *p = *a + (z * i) : *q = *b + (z * m) : CopyMemory(*p, *q, (e1-i+1)*z)
                m = m + (e1-i+1)
            EndIf
            If j <= e2
                *p = *a + (z * j) : *q = *b + (z * m) : CopyMemory(*p, *q, (e2-j+1)*z)
                m = m + (e2-j+1)
            EndIf
            s1 = e1+1
            If e2 > 0 : s1 = e2 + 1 : EndIf
        Wend
        *p = *a + (z * RangeStart) : CopyMemory(*b, *p, n*z)
        k = k << 1 ; k * 2
    Wend
    FreeMemory(*b)
EndProcedure
And here is a test code

Code: Select all

;-------------------------------------
;--- TEST ---------------------------
;-------------------------------------
Structure tst
    Index.i
    Txt1.s
    Txt2.s
    Int1.i
    Int2.i
EndStructure

Procedure Debug_tst(Array t.tst(1), ss,ee)
    Protected i
    Debug ">>>>>>>>>>>>>>>> ss = " +#TAB$+ Str(ss) +#TAB$+ " ee = " +#TAB$+ Str(ee)
    Debug "Index" +#TAB$+ "txt1" +#TAB$+ "int1" +#TAB$+ "txt2" +#TAB$+ "int2"
    For i=ss To ee
        Debug Str(t(i)\Index) + #TAB$ +
              t(i)\Txt1 + #TAB$ +
              Str(t(i)\Int1) + #TAB$ +
              t(i)\Txt2 + #TAB$ +
              Str(t(i)\Int2)
    Next
EndProcedure

Define i,t0,t1,t2, n, ss, ee
Define NewList Flds(), NewList Opts(), NewList Typs()
Dim t.tst(0)
Dim t2.tst(0)

n = 10000;00
ss = Random(n/2)
ee = Random(n, n/2)
Dim t(n)

For i=0 To n
    t(i)\Index = i
    t(i)\Txt1 = Chr(Random(128, 65)) + Chr(Random(128, 65)) + Chr(Random(128, 65)) ;"a" + RSet(Str(Random(999,0)), 3, "0")
    t(i)\Txt2 = Chr(Random(90, 65)) + Chr(Random(122, 97))
    t(i)\Int1 = Random(1000)
    t(i)\Int2 = Random(10000, 100)
Next

; before
;debug_tst(t(), ss, ee)

; adding sorting fields: Txt1, Asc no-case 
AddElement(Flds()) : Flds() = OffsetOf(tst\Txt1)
AddElement(Typs()) : Typs() = TypeOf(tst\Txt1)
AddElement(Opts()) : Opts() = #PB_Sort_Ascending | #PB_Sort_NoCase

; then field: Int1 Desc
AddElement(Flds()) : Flds() = OffsetOf(tst\Int1)
AddElement(Typs()) : Typs() = TypeOf(tst\Int1)
AddElement(Opts()) : Opts() = #PB_Sort_Descending

; then field: Int2 Asc
AddElement(Flds()) : Flds() = OffsetOf(tst\Int2)
AddElement(Typs()) : Typs() = TypeOf(tst\Int2)
AddElement(Opts()) : Opts() = #PB_Sort_Ascending

; then field: Txt2 Desc
AddElement(Flds()) : Flds() = OffsetOf(tst\Txt2)
AddElement(Typs()) : Typs() = TypeOf(tst\Txt2)
AddElement(Opts()) : Opts() = #PB_Sort_Descending ;| #PB_Sort_NoCase

; sorting
t0 = ElapsedMilliseconds()
MySortArray(@t(0), SizeOf(tst), Flds(), Opts(), Typs(), ss, ee)
t0 = ElapsedMilliseconds() - t0
MessageRequester("sorting-time", Str(t0))

; after
;Debug " >>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>  "
;debug_tst(t(), ss, ee)
Demivec has also shared routines on multi-field sorting see here:
http://www.purebasic.fr/english/viewtop ... 12&t=49396

Edit: added all native PB types to MySortArray() and removed the procedure IsSorted_tst(), it was only for validation
Last edited by said on Tue Oct 06, 2015 3:35 am, edited 2 times in total.
User avatar
skywalk
Addict
Addict
Posts: 3999
Joined: Wed Dec 23, 2009 10:14 pm
Location: Boston, MA

Re: Multi-field generic stable array sort

Post by skywalk »

Hi said,
Here is the same result using qsort() and a custom compare function.
This is 2x faster and much less code and setup.
Maybe you could macrofy the custom compare function to make it accept variables?
I just hardcode them for my needs.

Code: Select all

EnableExplicit
;-{ IMPORTS
ImportC ""
  ; Requires custom ProcedureC.i Compare_myStruc(*a,*b)
  ; C stores 2D arrays [nrows-1][ncols-1]
  qsort(*arBaseIndex, nPts.i, SizeOfStruc.i, *CompareFn)
EndImport
;-} IMPORTS
Structure tst
  Index.i
  Txt1.s
  Txt2.s
  Int1.i
  Int2.i
EndStructure
Global.i cmp_string_case
ProcedureC.i cmp_tst_txt1(*a.tst, *b.tst)
  ; Sort fields/properties = txt1+nc, int1-, int2+, txt2-cs
  ; Returns:  0 if a=b, <0 if a<b, >0 if a>b
  Protected.i ri
  ri = CompareMemoryString(@*a\Txt1, @*b\Txt1, cmp_string_case);#PB_String_NoCase)
  If ri = 0   ; Make stable if identical
    ; Comparing element addresses fails because qsort() moves elements internally
    ; Try looking at next desired field's values
    ri = *b\int1 - *a\int1    ; Compare descending Order
    If ri = 0
      ri = *a\Int2 - *b\int2  ; Compare ascending Order
      If ri = 0
        ri = CompareMemoryString(@*b\Txt2, @*a\Txt2, #PB_String_NoCase)
      EndIf
    EndIf
  EndIf
  ProcedureReturn ri
EndProcedure

Procedure   MySortArray(AdressOfArray, SizeOfStructure, List FldOffset.i(), List FldOption.i(), List FldType.i(), RangeStart, RangeEnd)
  ; generic, multi-fields, bottom-up iterative, stable merge-sort
  ; usage:
  ;         MySortArray(@Ary(0), SizeOf(ary_structre), Flds(), Opts(), Typs(), RangeStart, RangeEnd)
  Protected   n,i,j,m, k, s1,e1,s2,e2, z, srt_asc, tmp, mode, res, dlt
  Protected   *a, *b, *pi, *pj, *p, *q
  Protected   Fld_Adr, Fld_Opt, Fld_Typ, iFld, nFld, Dim FAdr(0), Dim FOpt(0), Dim FTyp(0)
  
  n  = RangeEnd - RangeStart + 1
  If n <= 0 : ProcedureReturn : EndIf
  If ListSize(FldOffset()) = 0 : ProcedureReturn : EndIf
  *a = AdressOfArray
  *b = AllocateMemory(n * SizeOfStructure)
  z  = SizeOfStructure
  
  ; converting lists into arrays, faster access (guarantee all 3 lists have same size)
  nFld = ListSize(FldOffset()) - 1
  Dim FAdr(nFld)
  Dim FOpt(nFld)
  Dim FTyp(nFld)
  ForEach FldOffset()
    FAdr(iFld) = FldOffset()
    If SelectElement(FldOption(), ListIndex(FldOffset()))   : FOpt(iFld) = FldOption()  : EndIf
    If SelectElement(FldType(), ListIndex(FldOffset()))     : FTyp(iFld) = FldType()    : EndIf
    iFld + 1
  Next
  
  k = 1       ; at each run, k is the nbr of elements in each half
  While k < n
    s1 = RangeStart
    While s1 <= RangeEnd
      
      e1 = s1 + (k-1) : If e1 > RangeEnd : e1 = RangeEnd : EndIf
      e2 = -1
      s2 = e1 + 1
      If s2 <= RangeEnd
        e2 = s2 + (k-1)
        If e2 > RangeEnd : e2 = RangeEnd : EndIf
      EndIf
      m = s1 - RangeStart : i = s1 : j = s2
      
      While (i <= e1 And j <= e2)
        ; comparing elements i and j on each field ---> res, dlt
        ; res = -1   ==> i preceeds j
        ; res = +1   ==> j preceeds i
        ; dlt =  0   ==> continue testing additional fields
        ; dlt <> 0   ==> no need to test additional fields
        For iFld = 0 To nFld
          
          Fld_Adr = FAdr(iFld)
          Fld_Opt = FOpt(iFld)
          Fld_Typ = FTyp(iFld)
          srt_asc = Bool( (Fld_Opt & #PB_Sort_Descending) = 0 )
          
          *pi = AdressOfArray + (SizeOfStructure * i) + Fld_Adr
          *pj = AdressOfArray + (SizeOfStructure * j) + Fld_Adr
          
          Select Fld_Typ
          Case #PB_Integer
            dlt = PeekI(*pi) - PeekI(*pj)
            If srt_asc
              If dlt <= 0 : res = -1 : Else : res = 1 : EndIf
            Else
              If dlt >= 0 : res = -1 : Else : res = 1 : EndIf
            EndIf
            
          Case #PB_String
            mode = #PB_String_CaseSensitive
            If (Fld_Opt & #PB_Sort_NoCase) : mode = #PB_String_NoCase : EndIf
            
            tmp = CompareMemoryString(PeekI(*pi), PeekI(*pj), mode)
            If tmp = #PB_String_Equal   : dlt =  0 : EndIf
            If tmp = #PB_String_Lower   : dlt = -1 : EndIf
            If tmp = #PB_String_Greater : dlt =  1 : EndIf
            
            If srt_asc
              If dlt <= 0 : res = -1 : Else : res = 1 : EndIf
            Else
              If dlt >= 0 : res = -1 : Else : res = 1 : EndIf
            EndIf
          EndSelect
          
          If dlt <> 0 : Break : EndIf
          
        Next
        
        If res <= 0
          *p = *a + (z * i)
          *q = *b + (z * m)
          CopyMemory(*p, *q, z) : i+1
        Else
          *p = *a + (z * j)
          *q = *b + (z * m)
          CopyMemory(*p, *q, z) : j+1
        EndIf
        m+1
        
      Wend
      
      If i <= e1
        *p = *a + (z * i)
        *q = *b + (z * m)
        CopyMemory(*p, *q, (e1-i+1)*z)
        m = m + (e1-i+1)
      EndIf
      
      If j <= e2
        *p = *a + (z * j)
        *q = *b + (z * m)
        CopyMemory(*p, *q, (e2-j+1)*z)
        m = m + (e2-j+1)
      EndIf
      
      s1 = e1+1
      If e2 > 0       ; 2nd block/half is present
        s1 = e2 + 1
      EndIf
      
    Wend
    ; copying back from b to a
    *p = *a + (z * RangeStart)
    CopyMemory(*b, *p, n*z)
    k = k << 1 ; k * 2
  Wend
  FreeMemory(*b)
EndProcedure

;-{ TEST
CompilerIf 1
  ; routines tailored to the tst-structure !
  Procedure Debug_tst(Array t.tst(1), ss,ee)
    Protected i
    Debug ">>>>>>>>>>>>>>>> ss = " +#TAB$+ Str(ss) +#TAB$+ " ee = " +#TAB$+ Str(ee)
    Debug "Index" +#TAB$+ "txt1" +#TAB$+ "int1" +#TAB$+ "txt2" +#TAB$+ "int2"
    For i=ss To ee
      Debug Str(t(i)\Index) + #TAB$ +
            t(i)\Txt1 + #TAB$ +
            Str(t(i)\Int1) + #TAB$ +
            t(i)\Txt2 + #TAB$ +
            Str(t(i)\Int2)
    Next
  EndProcedure
  Procedure IsSorted_tst(Array before.tst(1), Array after.tst(1), List FldIdxs(), List Opts(), s,e)
    ; uses SQL query (ORDER BY) for checking
    ; To validate, pass field index in list FldIdxs(), 0-based.
    Protected   db_Idx, db_Txt1.s, db_Txt2.s, db_Int1, db_Int2, db_Flt1.f
    Protected   i, srt_asc, no_case, err
    Protected   db, tbl, sql.s, upd.s
    
    UseSQLiteDatabase()
    db = OpenDatabase(#PB_Any, ":memory:", "", "")
    If db
      sql = "CREATE TABLE T ( Idx INTEGER, Txt1 TEXT, Txt2 TEXT, Int1 INTEGER, Int2 INTEGER );"
      If Not DatabaseUpdate(db, sql)
        MessageRequester("Error"," creating table...") : ProcedureReturn
      EndIf
      
      For i=s To e
        upd = "INSERT INTO T ( Idx, Txt1, Txt2, Int1, Int2 ) VALUES ( " + 
              "'" + Str(before(i)\Index) + "'" + " , " +
              "'" + before(i)\Txt1 + "'" + " , " +
              "'" + before(i)\Txt2 + "'" + " , " +
              "'" + Str(before(i)\Int1)  + "'" + " , " +
              "'" + Str(before(i)\Int2)  + "'" + " ); "
        
        If Not DatabaseUpdate(db,upd)
          MessageRequester("Error","inserting...") : ProcedureReturn
        EndIf
      Next
      
      ; Create sort query
      sql = "SELECT * FROM T ORDER BY "
      ForEach FldIdxs()
        SelectElement(Opts(), ListIndex(FldIdxs()))
        srt_asc = Bool( (Opts() & #PB_Sort_Descending) = 0 )
        no_case = Bool( (Opts() & #PB_Sort_NoCase) = #PB_Sort_NoCase )
        If ListIndex(FldIdxs()) > 0 : sql + ", " : EndIf
        Select FldIdxs()
        Case 0 : sql + " Idx "
          Case 1 : sql + " Txt1 " : If no_case : sql + " COLLATE NOCASE " : EndIf
          Case 2 : sql + " Txt2 " : If no_case : sql + " COLLATE NOCASE " : EndIf
        Case 3 : sql + " Int1 "
        Case 4 : sql + " Int2 "
        EndSelect
        If srt_asc
          sql + "ASC"
        Else
          sql + "DESC"
        EndIf
      Next
      sql + ", Idx ASC ;"
      
      ; checking now with after()
      If DatabaseQuery(db, sql)
        i=s
        While NextDatabaseRow(db)
          db_Idx  = GetDatabaseLong(db, DatabaseColumnIndex(db, "Idx"))
          db_Txt1 = GetDatabaseString(db, DatabaseColumnIndex(db, "Txt1"))
          db_Txt2 = GetDatabaseString(db, DatabaseColumnIndex(db, "Txt2"))
          db_Int1 = GetDatabaseLong(db, DatabaseColumnIndex(db, "Int1"))
          db_Int2 = GetDatabaseLong(db, DatabaseColumnIndex(db, "Int2"))
          
          If db_Idx  <> after(i)\Index : err+1 : EndIf
          If db_Txt1 <> after(i)\Txt1  : err+1 : EndIf
          If db_Txt2 <> after(i)\Txt2  : err+1 : EndIf
          If db_Int1 <> after(i)\Int1  : err+1 : EndIf
          If db_Int2 <> after(i)\Int2  : err+1 : EndIf
          
          i+1
          If err
            MessageRequester("Error", "IsSorted_tst - Array Not sorted")
            ProcedureReturn
          EndIf
        Wend
        FinishDatabaseQuery(db)
      EndIf
      CloseDatabase(db)
    EndIf
    
    MessageRequester("IsSorted_tst", "Array is sorted")
  EndProcedure
  Define i,t0,t1,t2, n, ss, ee
  Define NewList Flds(), NewList Opts(), NewList Typs()
  Dim t.tst(0)
  Dim t2.tst(0)
  
  n = 10;000;0
  ss = 0    ;Random(n/2)
  ee = n-1  ;Random(n, n/2)
  Dim t(n)
  Dim t2(n)
  RandomSeed(255)
  For i=0 To n
    t(i)\Index = i
    t(i)\Txt1 = Chr(Random(128, 65)) + Chr(Random(128, 65)) + Chr(Random(128, 65))
    t(i)\Txt2 = Chr(Random(90, 65)) + Chr(Random(122, 97))
    t(i)\Int1 = Random(1000)
    t(i)\Int2 = Random(10000, 100)
  Next
  t(4)\Txt1 = "abc"
  t(7)\Txt1 = "ABC"
  CopyArray(t(), t2())
  
  ; before
  debug_tst(t(), ss, ee)
  
  ; Specify sort fields/properties = txt1+nc, int1-, int2+, txt2-cs
  AddElement(Flds()) : Flds() = OffsetOf(tst\Txt1)
  AddElement(Typs()) : Typs() = TypeOf(tst\Txt1)
  AddElement(Opts()) : Opts() = #PB_Sort_Ascending | #PB_Sort_NoCase
  
  AddElement(Flds()) : Flds() = OffsetOf(tst\Int1)
  AddElement(Typs()) : Typs() = TypeOf(tst\Int1)
  AddElement(Opts()) : Opts() = #PB_Sort_Descending
  
  AddElement(Flds()) : Flds() = OffsetOf(tst\Int2)
  AddElement(Typs()) : Typs() = TypeOf(tst\Int2)
  AddElement(Opts()) : Opts() = #PB_Sort_Ascending
  
  AddElement(Flds()) : Flds() = OffsetOf(tst\Txt2)
  AddElement(Typs()) : Typs() = TypeOf(tst\Txt2)
  AddElement(Opts()) : Opts() = #PB_Sort_Descending ;| #PB_Sort_NoCase
  
  ; sorting hard
  t0 = ElapsedMilliseconds()
  ;MySortArray(@t(0), SizeOf(tst), Flds(), Opts(), Typs(), ss, ee)
  ; qsort with custom compare functions
  ; Specify sort fields/properties = txt1+nc, int1-, int2+, txt2-cs
  cmp_string_case = #PB_String_NoCase
  qsort(@t(0), n, SizeOf(tst), @cmp_tst_txt1())
  t0 = ElapsedMilliseconds() - t0
  MessageRequester("sorting hard time", Str(t0))

  ; after
  Debug " >>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>  "
  Debug " >>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>  "
  debug_tst(t(), ss, ee)
  
  ; test if array is really sorted
  Define NewList Fld_Idx()
  
  AddElement(Fld_Idx()) : Fld_Idx() = 1   ; field Txt1
  AddElement(Fld_Idx()) : Fld_Idx() = 3   ; field Int1
  AddElement(Fld_Idx()) : Fld_Idx() = 4   ; field Int1
  AddElement(Fld_Idx()) : Fld_Idx() = 2   ; field Txt2
  t0 = ElapsedMilliseconds()
  IsSorted_tst(t2(), t(), Fld_Idx(), Opts(), ss, ee)
  t0 = ElapsedMilliseconds() - t0
  MessageRequester("checking-time", Str(t0))
CompilerEndIf
;-}
The nice thing about standards is there are so many to choose from. ~ Andrew Tanenbaum
said
Enthusiast
Enthusiast
Posts: 342
Joined: Thu Apr 14, 2011 6:07 pm

Re: Multi-field generic stable array sort

Post by said »

skywalk wrote:Hi said,
Here is the same result using qsort() and a custom compare function.
This is 2x faster and much less code and setup.
Maybe you could macrofy the custom compare function to make it accept variables?
I just hardcode them for my needs.
Hi skywalk,

That's the whole point of using generic sort routine :) you dont need to work explicitly with various fields of the structure! Nor you need to define a custom comaprator function; All you need is to define the Fields you want to sort on using the usual OffsetOf() and TypeOf() in lists and pass those lists to the sort routine and voila :D I find this much more convenient ! Isn't it ?

Most of the code above is for testing/validating the sort is working fine, i split it now in two parts, the actual sorting routine and the remaining test code. As for the speed, yes the C-lib qsort() or the native PB sort is blazing fast ... but still that implementation of Merge-sort is still very fast (it can sort an array of 10,000 records in 2 ms :!: ) ... forgot to mention that you have a stable sort as well (which is very important in many scenarios)
User avatar
skywalk
Addict
Addict
Posts: 3999
Joined: Wed Dec 23, 2009 10:14 pm
Location: Boston, MA

Re: Multi-field generic stable array sort

Post by skywalk »

I was not counting the test code. That is obvious.
I was suggesting to macrofy the qsort() custom compare function.
This way you don't have the added array and list creations.
Scanning my code, I have very few cases where the sort must be variable driven AND stable.
Many times, I can use the built-in sortstructuredarray().
Still, thanks for posting, it is a good endeavor.
The nice thing about standards is there are so many to choose from. ~ Andrew Tanenbaum
said
Enthusiast
Enthusiast
Posts: 342
Joined: Thu Apr 14, 2011 6:07 pm

Re: Multi-field generic stable array sort

Post by said »

skywalk wrote:I was not counting the test code. That is obvious.
I was suggesting to macrofy the qsort() custom compare function.
This way you don't have the added array and list creations.
Scanning my code, I have very few cases where the sort must be variable driven AND stable.
Many times, I can use the built-in sortstructuredarray().
Still, thanks for posting, it is a good endeavor.
Yeah ... I have written this for the lazy people like me :mrgreen: who dont want to create a custom compare function each time they want a stable multi-field sort :D
User avatar
Kwai chang caine
Always Here
Always Here
Posts: 5353
Joined: Sun Nov 05, 2006 11:42 pm
Location: Lyon - France

Re: Multi-field generic stable array sort

Post by Kwai chang caine »

A "little bit" late :oops:
Thanks at you two for sharing this usefull codes 8)
ImageThe happiness is a road...
Not a destination
Post Reply