C Like qsort()

[Justin]

Code updated for 5.20+

This is basically a function that emulates the qsort() from the C Run Time Library. the point is to be flexible not speed, you supply the comparision function. it sorts binary data, i don't use pb arrays so i did this.

Code: Select all

;qsort.pbi
;Justin 07/06

EnableExplicit 

;Comparison function
;context : user value, passed with qs_sort()
;*el1, *el2 : pointers to the elements to compare
;Return : <0 *el1 less than *el2
;          0 *el1 equivalent to *el2
;         >0 *el1 greater than *el2   
Prototype.l qs_compare(context.l, *el1, *el2)

Macro qs_arrget(base, width, i)
   base + (width * i)
EndMacro 

;qsort algorithm
Procedure qs_alg(*base, width.l, iinf.l, isup.l, compare.qs_compare, context.l, *eTemp)
   Define.l *lft, *rgt, *sup, *inf, *eMid
   Define.l ilft, irgt, iMid
   
   ilft = iinf
   irgt = isup
   iMid = (ilft + irgt)/2
      
   *lft = qs_arrget(*base, width, ilft)
   *rgt = qs_arrget(*base, width, irgt)
   *eMid = qs_arrget(*base, width, iMid)

   Repeat
      While compare(context, *lft, *eMid)<0 And ilft < isup         
         *lft + width : ilft + 1
      Wend 
      
      While compare(context, *rgt, *eMid)>0 And irgt > iinf
         *rgt - width : irgt - 1
      Wend 
      
      If ilft <= irgt
         CopyMemory(*lft, *eTemp, width)
         CopyMemory(*rgt, *lft, width)
         CopyMemory(*eTemp, *rgt, width)
         
         *lft + width : ilft + 1
         *rgt - width : irgt - 1
      EndIf 
   Until ilft>=irgt

   If irgt>iinf
      qs_alg(*base, width, iinf, irgt, compare, context, *eTemp)
   EndIf 
   
   If ilft<isup
      qs_alg(*base, width, ilft, isup, compare, context, *eTemp)
   EndIf    
EndProcedure 

;Main func
;*base : pointer to the array element where the sorting starts
;num   : number of elements to sort
;width : element size in bytes
;compare : pointer to the comparison function, see prototype
;context : user value passed to the compare function
;Note: To sort an array in decreasing order, reverse the sense of "greater than"
;      and "less than" in the comparison function.
Procedure qs_sort(*base, num.l, width.l, compare.qs_compare, context.l)
   Define.l *eTemp
   
   If num>0 
      *eTemp = AllocateMemory(width)
      qs_alg(*base, width, 0, num - 1, compare, context, *eTemp)
      FreeMemory(*eTemp)
   EndIf 
EndProcedure 


;;
;TEST
Structure TEST_EL
   age.l
   name.s{32}
EndStructure 

Structure TEST_ARR
   el.TEST_EL[0]
EndStructure 

;Sort by age
Procedure compareASC(context.l, *el1.TEST_EL, *el2.TEST_EL)   
   If *el1\age < *el2\age
      ProcedureReturn -1
      
   ElseIf *el1\age = *el2\age
      ProcedureReturn 0
      
   ElseIf *el1\age > *el2\age
      ProcedureReturn 1
   EndIf 
EndProcedure 

Define.TEST_ARR *vect
Define.l count, i

count = 5

*vect = AllocateMemory(SizeOf(TEST_EL) * count)
*vect\el[0]\age = 10
*vect\el[0]\name = "mike"

*vect\el[1]\age = 4
*vect\el[1]\name = "jim"

*vect\el[2]\age = 20
*vect\el[2]\name = "john"

*vect\el[3]\age = 1
*vect\el[3]\name = "mary"

*vect\el[4]\age = 12
*vect\el[4]\name = "sue"

qs_sort(*vect, count, SizeOf(TEST_EL), @compareASC(), 0)

For i=0 To count-1
   Debug *vect\el[i]\name + ": " + Str(*vect\el[i]\age)
Next

FreeMemory(*vect)