Sort array indexes and parallel arrays

[Little John]

Hi all,

when it comes to sorting of arrays, it sometimes makes sense not to sort the actual data in the array, but to sort the array indexes instead.

This is desirable e.g.

• when the array elements are big, so that moving them around would take much time.
• when for some reason you need to access the array elements in the original order and in sorted order.
  a(i) is still the original value at position i, a(idx(i)) is the value at position i after sorting.
• when you want to get the ranks of the array elements, without changing their order,
• when you need to sort 2 or more "parallel" arrays.
  Say some 2-dimensional points are given in the form of 2 separate arrays x() and y(). These are called "parallel" arrays, because for any allowed index i, x(i) and y(i) strictly belong together. When e.g. the points are going to be sorted according their x values, the y values have to be rearranged exactly in the same way, so that after sorting, all corresponding x and y values still have the same index.

This module contains three groups of public procedures:

The first group consists of basic procedures for sorting array indexes, and for rearranging array elements according to the order of the indexes. Only procedures for variable types .i, .d, and .s are provided here. If needed, you can easily add procedures for other data types yourself. The actual code is contained in three macros anyway, and the procedures are only for providing an appropriate public interface. The MergeSort algorithm is used here, which is fast and stable.

The second group consists of some procedures for sorting parallel arrays. They are just "wrappers" of the basic procedures. It will be easy to write any other wrapper according to your needs. E.g. it is no problem to sort not only two, but any other number of parallel arrays.

The third group consists of procedures for calculating the ranks of all array elements. These procedures also utilise the basic procedures from the first group. Ranking is important for several statistical calculations.

Have fun!

Code: Select all

; <http://www.purebasic.fr/english/viewtopic.php?t=60013>

; Version 1.00, 2023-08-12
; successfully tested with
; [v] PB 5.72 LTS and PB 6.02 LTS (x64) on Windows 11 – both ASM and C backend
; [v] PB 6.03 beta 4 (x64) on Linux Mint 20.3         – both ASM and C backend


DeclareModule SortAI
   ; -- basic procedures
   Declare.i SortArrayIndexesI (Array a.i(1), Array idx.i(1), mode.i, first.i=0, last.i=-1)
   Declare.i RearrangeArrayI (Array idx.i(1), Array a.i(1), first.i=0, last.i=-1)
   Declare.i SortArrayIndexesD (Array a.d(1), Array idx.i(1), mode.i, first.i=0, last.i=-1)
   Declare.i RearrangeArrayD (Array idx.i(1), Array a.d(1), first.i=0, last.i=-1)
   Declare.i SortArrayIndexesS (Array a.s(1), Array idx.i(1), mode.i, first.i=0, last.i=-1)
   Declare.i RearrangeArrayS (Array idx.i(1), Array a.s(1), first.i=0, last.i=-1)
   
   ; -- some "wrappers" of the basic procedures
   Declare.i SortParallelArraysII (Array a.i(1), Array b.i(1), mode.i, first.i=0, last.i=-1)
   Declare.i SortParallelArraysID (Array a.i(1), Array b.d(1), mode.i, first.i=0, last.i=-1)
   Declare.i SortParallelArraysIS (Array a.i(1), Array b.s(1), mode.i, first.i=0, last.i=-1)
   
   Declare.i SortParallelArraysDI (Array a.d(1), Array b.i(1), mode.i, first.i=0, last.i=-1)
   Declare.i SortParallelArraysDD (Array a.d(1), Array b.d(1), mode.i, first.i=0, last.i=-1)
   Declare.i SortParallelArraysDS (Array a.d(1), Array b.s(1), mode.i, first.i=0, last.i=-1)
   
   Declare.i SortParallelArraysSI (Array a.s(1), Array b.i(1), mode.i, first.i=0, last.i=-1)
   Declare.i SortParallelArraysSD (Array a.s(1), Array b.d(1), mode.i, first.i=0, last.i=-1)
   Declare.i SortParallelArraysSS (Array a.s(1), Array b.s(1), mode.i, first.i=0, last.i=-1)
   
   ; -- ranking procedures
   Declare.i RankI (Array a.i(1), Array r.d(1))
   Declare.i RankD (Array a.d(1), Array r.d(1))
   Declare.i RankS (Array a.s(1), Array r.d(1))
EndDeclareModule


Module SortAI
   EnableExplicit
   
   Macro Merge (_case_)
      ; in: _case_: nothing or 'LCase'
      
      ; copy first half of idx() to auxiliary array h()
      i = 0
      j = lo
      While j <= m
         h(i) = idx(j)
         i + 1
         j + 1
      Wend
      
      ; copy next biggest (or smallest, respectively) element back to idx()
      i = 0
      k = lo
      While k < j And j <= hi
         If mode & #PB_Sort_Descending = 1
            flag = Bool(_case_(a(h(i))) >= _case_(a(idx(j))))
         Else
            flag = Bool(_case_(a(h(i))) <= _case_(a(idx(j))))
         EndIf
         
         If flag
            idx(k) = h(i)
            i + 1
         Else
            idx(k) = idx(j)
            j + 1
         EndIf
         k + 1
      Wend
      
      ; copy rest of h() (if existing) back to idx()
      While k < j
         idx(k) = h(i)
         k + 1
         i + 1
      Wend
   EndMacro
   
   
   Macro MergeSort (_case_=)
      ; -- efficient iterative Mergesort
      ; in: _case_: nothing or 'LCase'
      ; [after
      ;  Lang, H. W.: Algorithmen.
      ;  Oldenbourg, 2nd ed. 2006, pp. 32-33
      ;  (German)]
      
      If first < 0
         ProcedureReturn #False      ; error
      ElseIf last = -1
         last = ArraySize(a())
      ElseIf last > ArraySize(a())
         ProcedureReturn #False      ; error
      EndIf
      If first > last
         ProcedureReturn #False      ; error
      EndIf   
      
      n = last + 1 - first
      Dim h.i(n/2)                   ; create an auxiliary array
      
      ; initialize array of indexes
      Dim idx.i(ArraySize(a()))
      For r = 0 To ArraySize(a())
         idx(r) = r
      Next
      
      s = 1                  ; 's' is the length of the second half (1,2,4,8,...)
      While s < n
         m = last - s        ; 'm' points to the last element of the first half
         While m >= first
            lo = m - s + 1   ; 'lo' points to the first element of the first half
            If lo < first
               lo = first
            EndIf
            hi = m + s       ; 'hi' points to the last element of the second half
            Merge(_case_)
            m - (s + s)
         Wend
         s + s
      Wend
      
      ProcedureReturn #True  ; success
   EndMacro
   
   
   Macro Rearrange
      Protected.i i, j, k
      Protected Dim h.i(0)
      
      If first < 0
         ProcedureReturn #False      ; error
      ElseIf last = -1
         last = ArraySize(a())
      ElseIf last > ArraySize(a())
         ProcedureReturn #False      ; error
      EndIf
      If first > last
         ProcedureReturn #False      ; error
      ElseIf last > ArraySize(idx())
         ProcedureReturn #False      ; error
      EndIf
      
      CopyArray(idx(), h())          ; use a copy of the index array,
                                     ; to leave the index array as is
      For i = 0 To last
         If h(i) <> i
            t = a(i)
            k = i
            Repeat
               j = k
               a(j) = a(h(j))
               k = h(j)
               h(j) = j
            Until k = i
            a(j) = t
         EndIf
      Next
      
      ProcedureReturn #True          ; success
   EndMacro
   
   ;--------------------------------------------------------------------
   
   Procedure.i SortArrayIndexesI (Array a.i(1), Array idx.i(1), mode.i, first.i=0, last.i=-1)
      ; -- sort the elements of idx(), according to array a()
      ; in : a()  : array with the elements which are to be compared
      ;      idx(): index array which is to be sorted
      ;      mode : #PB_Sort_Ascending / #PB_Sort_Descending
      ;      first: first element to sort
      ;      last : last  element to sort
      ; out: idx(): index array, completely or partly sorted:
      ;             idx(first)   is the index of the smallest (biggest) element in (the sorted part of) a(),
      ;             idx(first+1) is the index of the second smallest (biggest) element in (the sorted part of) a(),
      ;             etc.
      ;      return value: #True on success, #False on error
      Protected.i i, j, k, flag
      Protected.i m, n, r, s, lo, hi
      Protected Dim h.i(0)
      
      MergeSort()
   EndProcedure
   
   Procedure.i RearrangeArrayI (Array idx.i(1), Array a.i(1), first.i=0, last.i=-1)
      ; -- rearrange the elements of array a() in place, according to idx()
      ; in : idx(): idx(first)   is the index of the smallest (biggest) element in (the sorted part of) a(),
      ;             idx(first+1) is the index of the second smallest (biggest) element in (the sorted part of) a(),
      ;             etc.
      ;      a()  : array that is to be rearranged
      ;      first: first element taken into account
      ;      last : last  element taken into account
      ; out: a(): rearranged array
      ;      (idx() remains unchanged!)
      ;      return value: #True on success, #False on error
      Protected.i t
      
      Rearrange
   EndProcedure
   
   ;--------------------------------------------------------------------
   
   Procedure.i SortArrayIndexesD (Array a.d(1), Array idx.i(1), mode.i, first.i=0, last.i=-1)
      ; -- sort the elements of idx(), according to array a()
      ; in : a()  : array with the elements which are to be compared
      ;      idx(): index array which is to be sorted
      ;      mode : #PB_Sort_Ascending / #PB_Sort_Descending
      ;      first: first element to sort
      ;      last : last  element to sort
      ; out: idx(): index array, completely or partly sorted:
      ;             idx(first)   is the index of the smallest (biggest) element in (the sorted part of) a(),
      ;             idx(first+1) is the index of the second smallest (biggest) element in (the sorted part of) a(),
      ;             etc.
      ;      return value: #True on success, #False on error
      Protected.i i, j, k, flag
      Protected.i m, n, r, s, lo, hi
      Protected Dim h.i(0)
      
      MergeSort()
   EndProcedure
   
   Procedure.i RearrangeArrayD (Array idx.i(1), Array a.d(1), first.i=0, last.i=-1)
      ; -- rearrange the elements of array a() in place, according to idx()
      ; in : idx(): idx(first)   is the index of the smallest (biggest) element in (the sorted part of) a(),
      ;             idx(first+1) is the index of the second smallest (biggest) element in (the sorted part of) a(),
      ;             etc.
      ;      a()  : array that is to be rearranged
      ;      first: first element taken into account
      ;      last : last  element taken into account
      ; out: a(): rearranged array
      ;      (idx() remains unchanged!)
      ;      return value: #True on success, #False on error
      Protected.d t
      
      Rearrange
   EndProcedure
   
   ;--------------------------------------------------------------------
   
   Procedure.i SortArrayIndexesS (Array a.s(1), Array idx.i(1), mode.i, first.i=0, last.i=-1)
      ; -- sort the elements of idx(), according to array a()
      ; in : a()  : array with the elements which are to be compared
      ;      idx(): index array which is to be sorted
      ;      mode : #PB_Sort_Ascending / #PB_Sort_Descending; #PB_Sort_NoCase
      ;      first: first element to sort
      ;      last : last  element to sort
      ; out: idx(): index array, completely or partly sorted:
      ;             idx(first)   is the index of the smallest (biggest) element in (the sorted part of) a(),
      ;             idx(first+1) is the index of the second smallest (biggest) element in (the sorted part of) a(),
      ;             etc.
      ;      return value: #True on success, #False on error
      Protected.i i, j, k, flag
      Protected.i m, n, r, s, lo, hi
      Protected Dim h.i(0)
      
      If mode & #PB_Sort_NoCase
         MergeSort(LCase)
      Else
         MergeSort()
      EndIf
   EndProcedure
   
   Procedure.i RearrangeArrayS (Array idx.i(1), Array a.s(1), first.i=0, last.i=-1)
      ; -- rearrange the elements of array a() in place, according to idx()
      ; in : idx(): idx(first)   is the index of the smallest (biggest) element in (the sorted part of) a(),
      ;             idx(first+1) is the index of the second smallest (biggest) element in (the sorted part of) a(),
      ;             etc.
      ;      a()  : array that is to be rearranged
      ;      first: first element taken into account
      ;      last : last  element taken into account
      ; out: a(): rearranged array
      ;      (idx() remains unchanged!)
      ;      return value: #True on success, #False on error
      Protected.s t
      
      Rearrange
   EndProcedure
   
   ;-====================================================================
   
   Procedure.i SortParallelArraysII (Array a.i(1), Array b.i(1), mode.i, first.i=0, last.i=-1)
      ; in : a()  : array with the elements which are to be compared and sorted
      ;      b()  : array which is to be arranged in the same way as a()
      ;      mode : #PB_Sort_Ascending / #PB_Sort_Descending
      ;      first: first element to sort
      ;      last : last  element to sort
      ; out: a(): completely or partly sorted
      ;      b(): completely or partly sorted in the same way as a()
      ;      return value: #True on success, #False on error
      Protected.i r1, r2, r3
      Protected Dim idx.i(0)
      
      r1 = SortArrayIndexesI(a(), idx(), mode, first, last)
      r2 = RearrangeArrayI(idx(), a(), first, last)
      r3 = RearrangeArrayI(idx(), b(), first, last)
      
      ProcedureReturn Bool(r1 And r2 And r3)
   EndProcedure
   
   Procedure.i SortParallelArraysID (Array a.i(1), Array b.d(1), mode.i, first.i=0, last.i=-1)
      ; in : a()  : array with the elements which are to be compared and sorted
      ;      b()  : array which is to be arranged in the same way as a()
      ;      mode : #PB_Sort_Ascending / #PB_Sort_Descending
      ;      first: first element to sort
      ;      last : last  element to sort
      ; out: a(): completely or partly sorted
      ;      b(): completely or partly sorted in the same way as a()
      ;      return value: #True on success, #False on error
      Protected.i r1, r2, r3
      Protected Dim idx.i(0)
      
      r1 = SortArrayIndexesI(a(), idx(), mode, first, last)
      r2 = RearrangeArrayI(idx(), a(), first, last)
      r3 = RearrangeArrayD(idx(), b(), first, last)
      
      ProcedureReturn Bool(r1 And r2 And r3)
   EndProcedure
   
   Procedure.i SortParallelArraysIS (Array a.i(1), Array b.s(1), mode.i, first.i=0, last.i=-1)
      ; in : a()  : array with the elements which are to be compared and sorted
      ;      b()  : array which is to be arranged in the same way as a()
      ;      mode : #PB_Sort_Ascending / #PB_Sort_Descending
      ;      first: first element to sort
      ;      last : last  element to sort
      ; out: a(): completely or partly sorted
      ;      b(): completely or partly sorted in the same way as a()
      ;      return value: #True on success, #False on error
      Protected.i r1, r2, r3
      Protected Dim idx.i(0)
      
      r1 = SortArrayIndexesI(a(), idx(), mode, first, last)
      r2 = RearrangeArrayI(idx(), a(), first, last)
      r3 = RearrangeArrayS(idx(), b(), first, last)
      
      ProcedureReturn Bool(r1 And r2 And r3)
   EndProcedure
   
   ;--------------------------------------------------------------------
   
   Procedure.i SortParallelArraysDI (Array a.d(1), Array b.i(1), mode.i, first.i=0, last.i=-1)
      ; in : a()  : array with the elements which are to be compared and sorted
      ;      b()  : array which is to be arranged in the same way as a()
      ;      mode : #PB_Sort_Ascending / #PB_Sort_Descending
      ;      first: first element to sort
      ;      last : last  element to sort
      ; out: a(): completely or partly sorted
      ;      b(): completely or partly sorted in the same way as a()
      ;      return value: #True on success, #False on error
      Protected.i r1, r2, r3
      Protected Dim idx.i(0)
      
      r1 = SortArrayIndexesD(a(), idx(), mode, first, last)
      r2 = RearrangeArrayD(idx(), a(), first, last)
      r3 = RearrangeArrayI(idx(), b(), first, last)
      
      ProcedureReturn Bool(r1 And r2 And r3)
   EndProcedure
   
   Procedure.i SortParallelArraysDD (Array a.d(1), Array b.d(1), mode.i, first.i=0, last.i=-1)
      ; in : a()  : array with the elements which are to be compared and sorted
      ;      b()  : array which is to be arranged in the same way as a()
      ;      mode : #PB_Sort_Ascending / #PB_Sort_Descending
      ;      first: first element to sort
      ;      last : last  element to sort
      ; out: a(): completely or partly sorted
      ;      b(): completely or partly sorted in the same way as a()
      ;      return value: #True on success, #False on error
      Protected.i r1, r2, r3
      Protected Dim idx.i(0)
      
      r1 = SortArrayIndexesD(a(), idx(), mode, first, last)
      r2 = RearrangeArrayD(idx(), a(), first, last)
      r3 = RearrangeArrayD(idx(), b(), first, last)
      
      ProcedureReturn Bool(r1 And r2 And r3)
   EndProcedure
   
   Procedure.i SortParallelArraysDS (Array a.d(1), Array b.s(1), mode.i, first.i=0, last.i=-1)
      ; in : a()  : array with the elements which are to be compared and sorted
      ;      b()  : array which is to be arranged in the same way as a()
      ;      mode : #PB_Sort_Ascending / #PB_Sort_Descending
      ;      first: first element to sort
      ;      last : last  element to sort
      ; out: a(): completely or partly sorted
      ;      b(): completely or partly sorted in the same way as a()
      ;      return value: #True on success, #False on error
      Protected.i r1, r2, r3
      Protected Dim idx.i(0)
      
      r1 = SortArrayIndexesD(a(), idx(), mode, first, last)
      r2 = RearrangeArrayD(idx(), a(), first, last)
      r3 = RearrangeArrayS(idx(), b(), first, last)
      
      ProcedureReturn Bool(r1 And r2 And r3)
   EndProcedure
   
   ;--------------------------------------------------------------------
   
   Procedure.i SortParallelArraysSI (Array a.s(1), Array b.i(1), mode.i, first.i=0, last.i=-1)
      ; in : a()  : array with the elements which are to be compared and sorted
      ;      b()  : array which is to be arranged in the same way as a()
      ;      mode : #PB_Sort_Ascending / #PB_Sort_Descending; #PB_Sort_NoCase
      ;      first: first element to sort
      ;      last : last  element to sort
      ; out: a(): completely or partly sorted
      ;      b(): completely or partly sorted in the same way as a()
      ;      return value: #True on success, #False on error
      Protected.i r1, r2, r3
      Protected Dim idx.i(0)
      
      r1 = SortArrayIndexesS(a(), idx(), mode, first, last)
      r2 = RearrangeArrayS(idx(), a(), first, last)
      r3 = RearrangeArrayI(idx(), b(), first, last)
      
      ProcedureReturn Bool(r1 And r2 And r3)
   EndProcedure
   
   Procedure.i SortParallelArraysSD (Array a.s(1), Array b.d(1), mode.i, first.i=0, last.i=-1)
      ; in : a()  : array with the elements which are to be compared and sorted
      ;      b()  : array which is to be arranged in the same way as a()
      ;      mode : #PB_Sort_Ascending / #PB_Sort_Descending; #PB_Sort_NoCase
      ;      first: first element to sort
      ;      last : last  element to sort
      ; out: a(): completely or partly sorted
      ;      b(): completely or partly sorted in the same way as a()
      ;      return value: #True on success, #False on error
      Protected.i r1, r2, r3
      Protected Dim idx.i(0)
      
      r1 = SortArrayIndexesS(a(), idx(), mode, first, last)
      r2 = RearrangeArrayS(idx(), a(), first, last)
      r3 = RearrangeArrayD(idx(), b(), first, last)
      
      ProcedureReturn Bool(r1 And r2 And r3)
   EndProcedure
   
   Procedure.i SortParallelArraysSS (Array a.s(1), Array b.s(1), mode.i, first.i=0, last.i=-1)
      ; in : a()  : array with the elements which are to be compared and sorted
      ;      b()  : array which is to be arranged in the same way as a()
      ;      mode : #PB_Sort_Ascending / #PB_Sort_Descending; #PB_Sort_NoCase
      ;      first: first element to sort
      ;      last : last  element to sort
      ; out: a(): completely or partly sorted
      ;      b(): completely or partly sorted in the same way as a()
      ;      return value: #True on success, #False on error
      Protected.i r1, r2, r3
      Protected Dim idx.i(0)
      
      r1 = SortArrayIndexesS(a(), idx(), mode, first, last)
      r2 = RearrangeArrayS(idx(), a(), first, last)
      r3 = RearrangeArrayS(idx(), b(), first, last)
      
      ProcedureReturn Bool(r1 And r2 And r3)
   EndProcedure
   
   ;-====================================================================
   
   Macro CalcRanks (_type_)
      Protected.i i, k, lo, last=ArraySize(a())
      Protected.d v
      Protected Dim idx.i(0)
      
      If SortArrayIndexes#_type_(a(), idx(), #PB_Sort_Ascending) = #False
         ProcedureReturn #False        ; error
      EndIf
      
      Dim r(last)
      lo = 1
      For i = 1 To last
         If a(idx(i-1)) < a(idx(i))
            v = (lo+i) / 2.0
            For k = lo-1 To i-1
               r(idx(k)) = v
            Next
            lo = i + 1
         EndIf
      Next
      
      v = (lo+i) / 2.0
      For k = lo-1 To i-1
         r(idx(k)) = v
      Next
      
      ProcedureReturn #True            ; success
   EndMacro
   
   ;--------------------------------------------------------------------
   
   Procedure.i RankI (Array a.i(1), Array r.d(1))
      ; -- works like rank() in the R language, using the default way
      ;    of handling ties (ties.method='average')
      ; in : a(): integer array, can contain ties (i.e., equal values)
      ; out: r()         : array with the ranks of all elements in a()
      ;      return value: #True on success, #False on error
      
      CalcRanks(I)
   EndProcedure
   
   Procedure.i RankD (Array a.d(1), Array r.d(1))
      ; -- works like rank() in the R language, using the default way
      ;    of handling ties (ties.method='average')
      ; in : a(): double array, can contain ties (i.e., equal values)
      ; out: r()         : array with the ranks of all elements in a()
      ;      return value: #True on success, #False on error
      
      CalcRanks(D)
   EndProcedure
   
   Procedure.i RankS (Array a.s(1), Array r.d(1))
      ; -- works like rank() in the R language, using the default way
      ;    of handling ties (ties.method='average')
      ; in : a(): string array, can contain ties (i.e., equal values)
      ; out: r()         : array with the ranks of all elements in a()
      ;      return value: #True on success, #False on error
      
      CalcRanks(S)
   EndProcedure
EndModule


CompilerIf #PB_Compiler_IsMainFile
   ; -- Module demo
   
   EnableExplicit
   
   Define.i n, k, mode
   Define out$
   
   Debug "-- SortParallelArraysII()"
   
   n = 5
   mode = #PB_Sort_Ascending
   ; mode = #PB_Sort_Descending
   
   Dim a.i(n-1)
   Dim b.i(n-1)
   
   a(0) = 999 : b(0) = 123
   a(1) =   5 : b(1) =   1
   a(2) =   8 : b(2) =   2
   a(3) =   2 : b(3) =   3
   a(4) = 111 : b(4) = 456
   
   For k = 0 To n-1
      Debug RSet(Str(a(k)), 3) + "     " + RSet(Str(b(k)), 3)
   Next
   
   ; sort both arrays a() and b(), according to the values in a()
   If SortAI::SortParallelArraysII(a(), b(), mode, 1, 3) = #False
      Debug "Error in procedure SortAI::SortParallelArraysII()"
      End
   EndIf   
   
   Debug ""
   For k = 0 To n-1
      Debug RSet(Str(a(k)), 3) + "     " + RSet(Str(b(k)), 3)
   Next
   
   Debug ""
   Debug "-- SortParallelArraysDD()"
   
   n = 5
   mode = #PB_Sort_Ascending
   ; mode = #PB_Sort_Descending
   
   Dim ad.d(n-1)
   Dim bd.d(n-1)
   
   For k = 0 To n-1
      ad(k) = Random(n*1000)/1000
      bd(k) = Random(n*1000)/1000
      Debug StrD(ad(k),3) + "   " + StrD(bd(k),3)
   Next
   
   ; sort both arrays ad() and bd(), according to the values in ad()
   If SortAI::SortParallelArraysDD(ad(), bd(), mode) = #False
      Debug "Error in procedure SortAI::SortParallelArraysDD()"
      End
   EndIf   
   
   Debug ""
   For k = 0 To n-1
      Debug StrD(ad(k),3) + "   " + StrD(bd(k),3)
   Next
   
   Debug ""
   Debug "-- SortParallelArraysSI()"
   
   n = 5
   ; mode = #PB_Sort_Ascending
   mode = #PB_Sort_Ascending | #PB_Sort_NoCase
   ; mode = #PB_Sort_Descending
   ; mode = #PB_Sort_Descending | #PB_Sort_NoCase
   
   Dim a$ (n-1)
   Dim b.i(n-1)
   
   a$(0) = "Lisa"
   a$(1) = "Pete"
   a$(2) = "Mary"
   a$(3) = "Paul"
   a$(4) = "jule"
   
   For k = 0 To n-1
      b(k) = k + 1
      Debug a$(k) + "    " + Str(b(k))
   Next
   
   ; sort both arrays a$() and b(), according to the values in a$()
   If SortAI::SortParallelArraysSI(a$(), b(), mode) = #False
      Debug "Error in procedure SortAI::SortParallelArraysSI()"
      End
   EndIf   
   
   Debug ""
   For k = 0 To n-1
      Debug a$(k) + "    " + Str(b(k))
   Next
   
   Debug ""
   Debug "-- RankI()"
   
   n = 8
   Dim a.i(n-1)
   Dim R_a.d(0)
   
   ; -- Sample data
   a(0) = 3
   a(1) = 5
   a(2) = 2
   a(3) = 1
   a(4) = 2
   a(5) = 2
   a(6) = 3
   a(7) = 4
   
   If SortAI::RankI(a(), R_a()) = #False
      Debug "Error in procedure SortAI::RankI()"
      End
   EndIf
   
   out$ = "Data: "
   For k = 0 To n-1
      out$ + "  " + LSet(Str(a(k)), 3)
   Next
   Debug out$
   
   out$ = "Rank: "
   For k = 0 To n-1
      out$ + "  " + LSet(StrD(R_a(k), 1), 3)
   Next
   Debug out$
   Debug ""
   Debug "Handling of ties:"
   Debug "After sorting, the three data elements with value 2 are at positions 2, 3, and 4."
   Debug "Because the 'average' method is used here for ties, all three elements get the rank 3.0."
   Debug "The two elements with value 3 are at positions 5 and 6. They both get the rank 5.5."
CompilerEndIf

-------------------------------------------------

My best tricks & tips from 15+ years
Create arrays elegantly
Extended date library
Save JSON data with object members well-arranged
Evaluate and process math expressions
Functions for sets
Statistics with R
Thue-Morse sequence
Natural sorting
Sort array indexes and parallel arrays
Time profiling
VectorIcons

[Little John]

The following code verifies that the six basic procedures in the module work correctly:

Code: Select all

; -- Test of basic procedures in module 'SortAI' (PB 5.22 LTS)

EnableExplicit

XIncludeFile "SortAI.pbi"

Define.i n, i, k, tests, mode, firstElement, lastElement
Dim idx.i(0)
tests = 100                  ; number of tests to run
n = 50


Debug "-- SortArrayIndexesI(), RearrangeArrayI()"

mode = #PB_Sort_Ascending
; mode = #PB_Sort_Descending

Dim bi.i(n-1)
Dim ci.i(n-1)

For i = 1 To tests
   For k = 0 To n-1
      bi(k) = Random(n)   ; populate original array with random values
      ci(k) = bi(k)       ; save a copy of the original array
   Next
   
   firstElement = Random(n-1, 0)
   lastElement  = Random(n-1, firstElement)
   
   ; sort array idx(), according to the values in array bi()
   If SortAI::SortArrayIndexesI(bi(), idx(), mode, firstElement, lastElement) = #False
      Debug "Error: Can't sort array idx()."
      End
   EndIf   
   
   ; prove that SortArrayIndexesI() has NOT changed the original array
   If CompareMemory(bi(), ci(), n*SizeOf(Integer)) = 0
      Debug "Error: Original array has been altered."
      End
   EndIf
   
   ; use PureBasic's built-in function SortArray() for sorting ci()
   SortArray(ci(), mode, firstElement, lastElement)
   
   ; prove that idx() is arranged in the same way as ci()
   For k = 0 To n-1
      If bi(idx(k)) <> ci(k)
         Debug "Error: idx() has not been sorted correctly."
         End
      EndIf
   Next
   
   ; now actually rearrange the elements of bi(), according to idx()
   If SortAI::RearrangeArrayI(idx(), bi(), firstElement, lastElement) = #False
      Debug "Error: Can't rearrange array bi()."
      End
   EndIf   
   
   ; prove that bi() is now arranged in the same way as ci()
   For k = 0 To n-1
      If bi(k) <> ci(k)
         Debug "Error: bi() has not been rearranged correctly."
         End
      EndIf
   Next
Next

Debug "OK"

Debug ""
Debug "-- SortArrayIndexesD(), RearrangeArrayD()"

mode = #PB_Sort_Ascending
; mode = #PB_Sort_Descending

Dim bd.d(n-1)
Dim cd.d(n-1)

For i = 1 To tests
   For k = 0 To n-1
      bd(k) = Random(n*1000)/1000   ; populate original array with random values
      cd(k) = bd(k)                 ; save a copy of the original array
   Next
   
   firstElement = Random(n-1, 0)
   lastElement  = Random(n-1, firstElement)
   
   ; sort array idx(), according to the values in array bd()
   If SortAI::SortArrayIndexesD(bd(), idx(), mode, firstElement, lastElement) = #False
      Debug "Error: Can't sort array idx()."
      End
   EndIf   
   
   ; prove that SortArrayIndexesD() has NOT changed the original array
   If CompareMemory(bd(), cd(), n*SizeOf(Double)) = 0
      Debug "Error: Original array has been altered."
      End
   EndIf
   
   ; use PureBasic's built-in function SortArray() for sorting cd()
   SortArray(cd(), mode, firstElement, lastElement)
   
   ; prove that idx() is arranged in the same way as cd()
   For k = 0 To n-1
      If bd(idx(k)) <> cd(k)
         Debug "Error: idx() has not been sorted correctly."
         End
      EndIf
   Next
   
   ; now actually rearrange the elements of bd(), according to idx()
   If SortAI::RearrangeArrayD(idx(), bd(), firstElement, lastElement) = #False
      Debug "Error: Can't rearrange array bd()."
      End
   EndIf   
   
   ; prove that bd() is now arranged in the same way as cd()
   For k = 0 To n-1
      If bd(k) <> cd(k)
         Debug "Error: bd() has not been rearranged correctly."
         End
      EndIf
   Next
Next

Debug "OK"

Debug ""
Debug "-- SortArrayIndexesS(), RearrangeArrayS()"

Procedure.s RandomString (min.i, max.i)
   Protected ret$, *ptr.Character
   
   ret$ = Space(Random(max, min))
   *ptr = @ret$
   While *ptr\c
      *ptr\c = Random('z', 'A')
      *ptr + SizeOf(Character)
   Wend
   
   ProcedureReturn ret$
EndProcedure


mode = #PB_Sort_Ascending | #PB_Sort_NoCase
; mode = #PB_Sort_Descending

Dim bs.s(n-1)
Dim cs.s(n-1)

For i = 1 To tests
   For k = 0 To n-1
      bs(k) = RandomString(3, 10)   ; populate original array with random strings
      cs(k) = bs(k)                 ; save a copy of the original array
   Next
   
   firstElement = Random(n-1, 0)
   lastElement  = Random(n-1, firstElement)
   
   ; sort array idx(), according to the values in array bs()
   If SortAI::SortArrayIndexesS(bs(), idx(), mode, firstElement, lastElement) = #False
      Debug "Error: Can't sort array idx()."
      End
   EndIf   
   
   ; prove that SortArrayIndexesS() has NOT changed the original array
   For k = 0 To n-1
      If bs(k) <> cs(k)
         Debug "Error: Original array has been altered."
         End
      EndIf
   Next
   
   ; use PureBasic's built-in function SortArray() for sorting cs()
   SortArray(cs(), mode, firstElement, lastElement)
   
   ; prove that idx() is arranged in the same way as cs()
   For k = 0 To n-1
      If bs(idx(k)) <> cs(k)
         Debug "Error: idx() has not been sorted correctly."
         End
      EndIf
   Next
   
   ; now actually rearrange the elements of bs(), according to idx()
   If SortAI::RearrangeArrayS(idx(), bs(), firstElement, lastElement) = #False
      Debug "Error: Can't rearrange array bs()."
      End
   EndIf   
   
   ; prove that bs() is now arranged in the same way as cs()
   For k = 0 To n-1
      If bs(k) <> cs(k)
         Debug "Error: bs() has not been rearranged correctly."
         End
      EndIf
   Next
Next

Debug "OK"

[said]

Clean and useful Thanks for sharing

One little note, if i may! ... Though English is barley my 3rd language, personally i find the word 'Parallel' quite misleading, i would have used something like 'Companion' or 'Associate'

So, SortParallelArraysXX() would be SortCompanionArraysXX() ... that sounds much clearer isn't it (at least for me )?!

[Little John]

Hi said,

thanks for yor kind words.

One little note, if i may! ... Though English is barley my 3rd language, personally i find the word 'Parallel' quite misleading, i would have used something like 'Companion' or 'Associate'

So, SortParallelArraysXX() would be SortCompanionArraysXX() ... that sounds much clearer isn't it (at least for me )?!

I agree that "parallel" might sound somewhat strange in this context, but I think this actually is the proper technical term:

In computing, a parallel array is a data structure for representing arrays of records. It keeps a separate, homogeneous array for each field of the record, each having the same number of elements. Then, objects located at the same index in each array are implicitly the fields of a single record.

[Little John]

New version:

• Added public functions RankI(), RankD(), and RankS()
  (for details see first post).
• Made some tiny cosmetic changes in the code.

[kinglestat]

Incidentally my index system (posted earlier) does just that...it keeps a sorted index of data elements