Sort a structured array using fixedstring as sort field

[netmaestro]

Code updated for 5.20+

As it's possible that this functionality isn't going to be implemented for now, I thought I'd take a whack at a user-written routine. Here's what I have so far:

Code: Select all

;********************************************************* 
;     A test program to take the routine for a spin 
;********************************************************* 

Declare SortStructuredArrayFS(g,d) 

Structure member 
  age.l 
  name.s{4} 
  fav_color.s 
EndStructure 

Global Dim a.member(50000) 

For i=1 To 50000 ; Not responsible for any bad words that get made randomly!
  a(i)\name=Chr(65+Random(25))+Chr(97+Random(25))+Chr(97+Random(25))+Chr(97+Random(25)) 
  a(i)\age = 21+Random(30) 
Next 

DisableDebugger 
SortStructuredArrayFS(1,50000) ; First element, last element
EnableDebugger                 ; You can alter these to only sort part of the array
                               
Debug a(1)\name 
Debug a(25000)\name 
Debug a(50000)\name 

End 

;********************************************************* 
;            The routine 
;********************************************************* 
;
; Replace all ocurrences of  <a>      with your own array name
; Replace all ocurrences of  <member> with your own structure name
; Replace all ocurrences of  <name>   with your own element name

Procedure SortStructuredArrayFS(g,d) ; Quicksort Algorithm 
  If Not *tmp 
    *tmp=AllocateMemory(SizeOf(member)) 
  EndIf 
  If g < d 
    v.s = a(d)\name 
    i = g-1 
    j = d 
    Repeat 
      Repeat 
        i+1 
      Until a(i)\name >= v 
      Repeat 
        j-1 
      Until a(j)\name <= v 
      CopyMemory(@a(i),*tmp,SizeOf(member)) 
      CopyMemory(@a(j),@a(i),SizeOf(member)) 
      CopyMemory(*tmp,@a(j),SizeOf(member)) 
    Until j <= i 
    CopyMemory(@a(j),*tmp,SizeOf(member)) 
    CopyMemory(@a(i),@a(j),SizeOf(member)) 
    CopyMemory(@a(d),@a(i),SizeOf(member)) 
    CopyMemory(*tmp,@a(d),SizeOf(member)) 
    SortStructuredArrayFS(g, i-1) 
    SortStructuredArrayFS(i+1, d) 
  EndIf 
EndProcedure 

It seems to work ok, but I haven't tested it much. It could be leaking somewhere or have a wobbly wheel.

[rsts]

How timely

This will come in real handy for a project I'm working on.

Now I don't have to wait for PB 4 final, tailbite, etc.

cheers

[netmaestro]

I've updated the code above from bubble sort (painfully slow) to a (heavily) modified version of the Quicksort example in the docs (thx fred) and the speed gain is exponential. It now performs at a speed comparable to that of native PB sorts. Example above executes the sort in around 35 milliseconds on my machine for a 50,000 element array!

[netmaestro]

And finally, here is a version of the routine that is generic and not dependent on any specific array or structure:

Code: Select all

;********************************************************* 
;            The routine 
;********************************************************* 
; 
; Usage: SortStructuredArrayFS(start,end,@arrayname(),Sizeof(structure),OffsetOf(structure\member))
; 

Procedure SortStructuredArrayFS(g,d,arr,struc,mem) ; Quicksort Algorithm 
  If Not *tmp 
    *tmp=AllocateMemory(struc) 
  EndIf 
  If g < d 
    v.s = PeekS(arr+d*struc+mem)
    i = g-1 
    j = d 
    Repeat 
      Repeat 
        i+1 
      Until PeekS(arr+i*struc+mem) >= v 
      Repeat 
        j-1 
      Until PeekS(arr+j*struc+mem) <= v 
      CopyMemory(arr+i*struc,*tmp,struc) 
      CopyMemory(arr+j*struc,arr+i*struc,struc) 
      CopyMemory(*tmp,arr+j*struc,struc) 
    Until j <= i 
    CopyMemory(arr+j*struc,*tmp,struc) 
    CopyMemory(arr+i*struc,arr+j*struc,struc) 
    CopyMemory(arr+d*struc,arr+i*struc,struc) 
    CopyMemory(*tmp,arr+d*struc,struc) 
    SortStructuredArrayFS(g, i-1,arr,struc,mem) 
    SortStructuredArrayFS(i+1, d,arr,struc,mem) 
  EndIf 
EndProcedure  

Now that I've done all this work Fred will implement the feature and I can chuck it (I don't mind - it was good exercise)