Visual Sort

Post your FreeBASIC tips and tricks here. Please don’t post your code without including an explanation.
denise_amiga
Posts: 16
Joined: Jan 18, 2007 9:55

Visual Sort

Postby denise_amiga » Jun 05, 2019 10:10

Graphical representation of different sort methods

Code: Select all

#include "fbgfx.bi"
#if __FB_LANG__ = "fb"
Using FB '' Screen mode flags are in the FB namespace in lang FB
#endif

'' Sets screen mode 18 (640*480) with 32bpp color depth and 4 pages, in windowed mode; switching disabled
'Screen 18, 32, 4, (GFX_WINDOWED Or GFX_NO_SWITCH)

#Define inc += 1
#Define dec -= 1

#Define hres 1024
#Define vres 600

#Define mode1 1
#Define mode2 2
#Define mode3 4

Screenres hres, vres, 8, 2
Screenset 1, 0

'dim as String k, buff
Dim as Long a(hres)
dim shared as Long dcmp, dswap, plot, sync = 0, r=1
dim Shared as String dmeth
dim as Long modes(4) => {0,1,2,4}
dim Shared as String smodes(4) '=> {"off", "mode1", "mode2", "mode3"}
smodes(0)="off":smodes(1)="mode1":smodes(2)="mode2":smodes(3)="mode3"

sub display(a() as Long)
   Cls
   for i as Long = 0 to Ubound(a)
      if plot = 0 Then
         Pset (i,a(i)+vres\4)
      Else
         Line (i,(a(i)\2+vres\2))-(i,(-a(i)\2+vres\2))
      End If
   Next
   Locate 3,100:Print "comparaciones: " & dcmp
   Locate 4,100:Print "intercambios: " & dswap
   locate 5,100:Print "metodo: " & dmeth
   Locate 6,100:print smodes(sync)
   if sync = 1 Then Screensync
   dim as String s=Inkey
   if s=" " Then 'Multikey(SC_S) Then
      sync inc
      sync mod= 3
   End If
   Screencopy
   Sleep 1,1
End Sub

Sub bubble_sort( a() as long, l as Long, h as Long )
   Dim as Boolean flag = true
   dcmp = 0
   dswap = 0
   dmeth = "bubble"
   While 1
      flag=true
      for i as Long = 0 to Ubound(a)-1
         if a(i)<a(i+1) Then
            Swap a(i), a(i+1)
            dswap inc
            flag=False
         End If
         dcmp inc
         if sync = 2 Then display(a())
         if Multikey(SC_ESCAPE) Then Exit Sub
      Next
      display(a())
      if flag Then exit While
   Wend
End Sub

sub bubble2_sort( a() as Long, l as Long, h as Long )
   dcmp = 0
   dswap = 0
   dmeth = "bubble2"
   for i as Long = 0 to h-1
      for j as Long = 0 to (h-(i+1))
         if a(j)<a(j+1) Then
            Swap a(j), a(j+1)
            dswap inc
         End If
         dcmp inc
         if sync = 2 Then display(a())
         if Multikey(SC_ESCAPE) Then Exit Sub
      Next
      display(a())
   Next
End Sub

Sub   select_sort( a() as Long, l as Long, h as Long )
   dcmp = 0
   dswap = 0
   dmeth = "select"
   For i as Long = 0 to Ubound(a)-1
      dim as long k = i
      for j as Long = i+1 to Ubound(a)
         if a(j)>a(k) Then k = j
         dcmp inc
         if sync = 2 Then display(a())
         if Multikey(SC_ESCAPE) Then Exit Sub
      Next
      Swap a(k), a(i)
      dswap inc
      display(a())
   Next
End Sub

sub insert_sort( a() as Long, l as Long, h as Long )
   dcmp = 0
   dswap = 0
   dmeth = "insertion"
   for i as Long = 1 to Ubound(a)
      dim as long key = a(i)
      dim as long j = i - 1
      while j>=0 Andalso a(j)<key
         a(j+1) = a(j)
         j -= 1
         dswap inc
         dcmp inc
         if sync = 2 Then display(a())
         if Multikey(SC_ESCAPE) Then Exit Sub
      Wend
      a(j+1) = key
      dswap inc
      display(a())
   Next
End Sub

sub shell_sort(a() as Long, l as Long, h as Long )
   dcmp = 0
   dswap = 0
   dmeth = "shell"
   dim as Long inter = 5
   While inter > 0
      dim as Long j
      for i as Long = l to h
         dim as Long key = a(i)
         j = i
         While j >= inter Andalso a(j-inter) <= key
            a(j) = a(j-inter)
            j = j - inter
            dcmp inc
            dswap inc
            if sync = 2 Then display(a())
            if Multikey(SC_ESCAPE) Then Exit Sub
         Wend
         a(j) = key
         dswap inc
         display(a())
      Next
      inter = ((inter-1)/5)
   Wend
End Sub

sub _merge( a() as Long, aa() as Long, l as Long, m as Long, h as Long )
   dim as long l1, l2, i
   l1 = l
   l2 = m + 1
   i = l
   while l1 <= m Andalso l2 <= h
      if a(l1) >= a(l2) Then
         aa(i) = a(l1)
         l1 inc
      Else
         aa(i) = a(l2)
         l2 inc
      End If
      dswap inc
      dcmp inc
      i inc
      if sync = 2 Then display(a())
      if Multikey(SC_ESCAPE) Then Exit Sub
   Wend
   While l1 <= m
      aa(i) = a(l1)
      i inc
      l1 inc
      dswap inc
      if sync = 2 Then display(a())
      if Multikey(SC_ESCAPE) Then Exit Sub
   Wend
   While l2 <= h
      aa(i) = a(l2)
      i inc
      l2 inc
      dswap inc
      if sync = 2 Then display(a())
      if Multikey(SC_ESCAPE) Then Exit Sub
   Wend
   for i = l to h
      a(i) = aa(i)
   Next
   display(a())
End Sub

sub _merge_rec_sort( a() as Long, aa() as Long, l as Long, h as Long )
   if l < h Then
      if Multikey(SC_ESCAPE) Then Exit Sub
      dim as Long m = (l+h)\2
      _merge_rec_sort(a(), aa(), l, m)
      _merge_rec_sort(a(), aa(), m+1, h)
      _merge(a(), aa(), l, m, h)
   End If
End Sub

sub merge_rec_sort( a() as Long, l as Long, h as Long )
   dcmp = 0
   dswap = 0
   dmeth = "merge (recursive)"
   dim as Long aa(hres)
   _merge_rec_sort( a(), aa(), l, h )
End Sub

Function _min( a as Long, b as Long ) as Long
   return Iif( a < b, a, b )
End Function

sub _merge_ite_sort( a() as Long, aa() as Long, l as Long, h as Long )
   dim as Long curr_size, lstart
   curr_size = 1
   While curr_size <= h-1
      lstart = 0
      if Multikey(SC_ESCAPE) Then Exit Sub
      While lstart < h-1
         dim as long m = lstart + curr_size - 1
         dim as long rend = _min(lstart + 2*curr_size - 1, h - 1 )
         _merge( a(), aa(), lstart, m, rend )
         lstart += (2*curr_size)
      Wend
      curr_size *= 2
   Wend
End Sub

sub merge_ite_sort( a() as Long, l as Long, h as Long )
   dcmp = 0
   dswap = 0
   dmeth = "merge (iterative)"
   dim as Long aa(hres)
   _merge_ite_sort( a(), aa(), l, h )
End Sub

Sub _quick_rec_sort( a() as Long, l as Long, h as Long )
   dim as long key, i, j, k = (l+h)\2
   if l < h Then
      if Multikey(SC_ESCAPE) Then Exit Sub
      Swap a(l),a(k)
      dswap inc
      key = a(l)
      i = l+1
      j = h
      While i<=j
         while i<=h Andalso a(i)>=key
            i inc
            dcmp inc
            if sync = 2 Then display(a())
            if Multikey(SC_ESCAPE) Then Exit Sub
         Wend
         While j >= l Andalso a(j)<key
            j -= 1
            dcmp inc
            if sync = 2 Then display(a())
            if Multikey(SC_ESCAPE) Then Exit Sub
         Wend
         if i < j Then
            Swap a(i),a(j)
            dswap inc
            if sync = 2 Then display(a())
            if Multikey(SC_ESCAPE) Then Exit Sub
         End If
         display(a())
      Wend
      Swap a(l),a(j)
      dswap inc
      display(a())
      _quick_rec_sort( a(), l, j-1 )
      _quick_rec_sort( a(), j+1, h )
   end If
End Sub

sub quick_rec_sort( a() as Long, l as Long, h as Long )
   dcmp = 0
   dswap = 0
   dmeth = "quick (recursive)"
   _quick_rec_sort(a(),l,h-1)
End Sub

#Define MAX_LEVELS 64

Function _quick_ite_sort( a() as Long, l as Long, h as Long ) as Long
   dim as Long ll, rr, i, pstart(MAX_LEVELS), pend(MAX_LEVELS)
   pstart(0) = 0
   pend(0) = h
   While i >= 0
      ll = pstart(i)
      rr = pend(i)
      if (rr - ll) > 1 Then
         dim as Long m = ll+((rr-ll) Shr 1)
         dim as Long p = a(m)
         a(m) = a(ll)
         dswap inc
         if i = MAX_LEVELS - 1 Then Return -1
         rr dec
         While ll < rr
            while a(rr) <= p Andalso ll < rr
               rr dec
               dcmp inc
               if sync = 2 Then display(a())
               if Multikey(SC_ESCAPE) Then Exit Function
            Wend
            if ll < rr Then
               a(ll) = a(rr)
               ll inc
               dswap inc
            End If
            While a(ll) >= p Andalso ll < rr
               ll inc
               dcmp inc
               if sync = 2 Then display(a())
               if Multikey(SC_ESCAPE) Then Exit Function
            Wend
            if ll < rr Then
               a(rr) = a(ll)
               rr dec
               dswap inc
            End If
            display( a() )
         Wend
         a(ll) = p
         dswap inc
         m = ll + 1
         While ll > pstart(i) Andalso a(ll -1) = p
            ll dec
            dcmp inc
            if sync = 2 Then display(a())
            if Multikey(SC_ESCAPE) Then Exit Function
         Wend
         While m < pend(i) Andalso a(m) = p
            m inc
            dcmp inc
            if sync = 2 Then display(a())
            if Multikey(SC_ESCAPE) Then Exit Function
         Wend
         if ll - pstart(i) > pend(i) - m Then
            pstart(i+1) = m
            pend(i+1) = pend(i)
            pend(i) = ll
            i inc
         Else
            pstart(i+1) = pstart(i)
            pend(i+1) = ll
            pstart(i) = m
            i inc
         End If
      Else
         i dec
      End If
      display( a() )
   Wend
   Return 0
End Function

sub quick_ite_sort( a() as Long, l as Long, h as Long )
   dcmp = 0
   dswap = 0
   dmeth = "quick (iterative)"
   _quick_ite_sort(a(),l,h)
End Sub

sub rrandom( a() as Long, s as Long = 1000)
   Randomize Iif(s,1000,timer)
   for i as Long = Lbound(a) to Ubound(a)
      a(i)=rnd*(vres\2)
   Next
End Sub

'for i as Long = 0 to 19
'   ?a(i);
'Next
'?

Do
   locate 1,2:? "1.- Bubble"
   locate 2,2:? "2.- Bubble (variant)"
   locate 3,2:? "3.- Select"
   Locate 4,2:? "4.- Insert"
   locate 5,2:? "5.- Shell"
   locate 6,2:? "6.- Merge (recursive)"
   locate 7,2:? "7.- Merge (iterative)"
   locate 8,2:? "8.- Quick (recursive)"
   locate 9,2:? "9.- Quick (iterative)"
   locate 12,2:? Space(30):locate 12,2:? "r.- Random " & Iif(r, "off", "on")
   locate 13,2:? Space(30):locate 13,2:? "p.- Draw " & Iif(plot, "line", "plot")
   locate 14,2:? Space(30):locate 14,2:? "(spc).- Sync " & smodes(sync)
   Screencopy
   'Cls
   dim as String k = Inkey
   Select Case k
      case "1":rrandom(a(),r):bubble_sort(a(),Lbound(a),Ubound(a))
      case "2":rrandom(a(),r):bubble2_sort(a(),Lbound(a),Ubound(a))
      case "3":rrandom(a(),r):select_sort(a(),Lbound(a),Ubound(a))
      case "4":rrandom(a(),r):insert_sort(a(),Lbound(a),Ubound(a))
      case "5":rrandom(a(),r):shell_sort(a(),Lbound(a),Ubound(a))
      case "6":rrandom(a(),r):merge_rec_sort(a(),Lbound(a),Ubound(a))
      case "7":rrandom(a(),r):merge_ite_sort(a(),Lbound(a),Ubound(a))
      case "8":rrandom(a(),r):quick_rec_sort(a(),Lbound(a),Ubound(a))
      case "9":rrandom(a(),r):quick_ite_sort(a(),Lbound(a),Ubound(a))
      case "p":plot = 1 - plot
      case " ":sync inc: sync Mod= 3
      case "r":r = 1 - r
      case "q": Exit Do
   End Select
   Sleep 1,1
Loop
'sleep
Last edited by denise_amiga on Jun 05, 2019 17:11, edited 1 time in total.
dodicat
Posts: 5938
Joined: Jan 10, 2006 20:30
Location: Scotland

Re: Visual Sort

Postby dodicat » Jun 05, 2019 11:45

Really nice visually.
For iterative quicksort, a method in c

https://en.wikibooks.org/wiki/Algorithm_Implementation/Sorting/Quicksort#Iterative_Quicksort

To use the crt runtime qsort you could
1) make the array a() shared
2) Using your quick_ite_sort (unused), Insert this somewhere:

Code: Select all

'=====================
'=====================
#include "crt.bi"
Function callback Cdecl(n1 As Any Ptr,n2 As Any Ptr) As long
    dcmp inc
    dswap inc
    display(a())
 If *Cptr(long Ptr,n1) > *Cptr(long Ptr,n2) Then Return -1
 If *Cptr(long Ptr,n1) < *Cptr(long Ptr,n2) Then Return 1
 return 0
End Function


sub _quick_ite_sort( a() as Long, l as Long, h as Long )
    qsort( @a((l)),((h)-(l)+1),Sizeof(a),@callback)
end sub


sub quick_ite_sort( a() as Long, l as Long, h as Long )
  dcmp = 0
   dswap = 0
   dmeth = "quick (iterative)"
   _quick_ite_sort(a(),l,h-1)
End Sub
'====================

'====================   

Which shows well in your visual representation as a type of quicksort.
Lost Zergling
Posts: 240
Joined: Dec 02, 2011 22:51
Location: France

Re: Visual Sort

Postby Lost Zergling » Jun 05, 2019 15:45

This is just very nice for short testing & understanding ! On my laptop :
Bubble1=>16s, Bubble2=>18s, Select =>17s, Insert =>16s, Shell=>33s, Merge=>18s, Quick=>54s
I add a sub in your code and I did a test just loading string in a sorted index leaving original array unchanged MyList.HashTag(Str(i)) (Insert)=>16s, speeds same, happy of it.
Shell & Quick are supposed to be as fast as Bubble or comb sort, do they.
denise_amiga
Posts: 16
Joined: Jan 18, 2007 9:55

Re: Visual Sort

Postby denise_amiga » Jun 05, 2019 18:21

@dodicat thanks for the link, but I already had an implementation of the algorithm, only that I did not upload the "final" version :D :D

@lost these algorithms are designed to work with array (where the access to the elements is random, unlike the lists that access is sequential)
the merge and the quick are very similar in operation (technique divides and conquer)

merge and quick are much faster than others, bubble is the slowest by far. with this program the bubble seems faster than quick, but that is because there are very few elements that order and the overload of the redraw makes the quick slow
i have some routines to work with lists, (add to the beginning, at the end, add sorted, sort by merge, binary search...
if you want them, I can send them to you

pd. sorry for my english
Lost Zergling
Posts: 240
Joined: Dec 02, 2011 22:51
Location: France

Re: Visual Sort

Postby Lost Zergling » Jun 05, 2019 22:10

@denise_amiga
Thank you for your response and your interest. I do not want to accept any code that could be covered by copyright, as this would be to integrate or enhance a completely personal library (viewtopic.php?f=8&t=26533) dedicated to FB (free use under FB), itself open source and developed under my copyright. But I will gladly accept any suggestions or constructive remarks, knowing that it seems already quite a little optimized. The list engine is organized as a trieve (or Trie) ( https://fr.wikipedia.org/wiki/Trie_(informatique) ), but with some originality (*), so access is not only sequential. Your code allowed me to get some speed references for my tests, and I thank you for that.

(*) at the conceptual level the tree is organized to allow elementary optimized navigation in the tree (next or previous element, parent element or element(s) son) whatever the context of the current element (part of originality). When or if the context has been lost, it must be possible to find it (pretty) quickly. The interest of such an implementation consists in the absence (or lightness) of restrictions on elementary navigation, which allows more flexibility for the algorithmic optimization of the path of the tree. The fact that a unit element can be considered virtually independently of the structure makes it possible to consider better other convergent functional uses (memory management).
This (small) originality is important because it is (for me) also a bit of language. The user must be able to adopt a specific work and not a copy.
In addition, two optimization algorithms are implemented: the first (by default) is based on the pairing of the last key used (dynamic matching, very effective on long keys or similar) and another based on the recording of Node prediction (supposed to be more efficient on highly variable data)
The tool is almost finalized, some minor bugs remain, some improvements that would be too tedious and risky, ..lots of tests & small improvments.
Makoto WATANABE
Posts: 118
Joined: Apr 10, 2010 11:41
Location: Japan
Contact:

Re: Visual Sort

Postby Makoto WATANABE » Jul 22, 2019 13:02

Dear denise_amiga

Your program is not only easy to understand the processes of sorting, but also beautiful to watch.
I would like to introduce your program to Japanese people on my website by adding Japanese comments to your program.
Please consent to this.

P.S.
My Windows 10 PC could not show FreeBASIC graphics.
I followed MrSwiss's advice and now I can enjoy your program by switching from "language = JP" to "language = US-EN" only when running programs.
D.J.Peters
Posts: 7825
Joined: May 28, 2005 3:28

Re: Visual Sort

Postby D.J.Peters » Jul 22, 2019 19:22

good job

Joshy

My favorite on YouTube: 15 Sorting Algorithms in 6 Minutes (with sound)

Homepage: The Sound of Sorting
denise_amiga
Posts: 16
Joined: Jan 18, 2007 9:55

Re: Visual Sort

Postby denise_amiga » Sep 07, 2019 17:14

Makoto WATANABE wrote:Dear denise_amiga

Your program is not only easy to understand the processes of sorting, but also beautiful to watch.
I would like to introduce your program to Japanese people on my website by adding Japanese comments to your program.
Please consent to this.



ok, no problem
Makoto WATANABE
Posts: 118
Joined: Apr 10, 2010 11:41
Location: Japan
Contact:

Re: Visual Sort

Postby Makoto WATANABE » Sep 08, 2019 14:20

Dear denise_amiga

Thanks for your consent.
Thank you for your kindness.
Makoto WATANABE
Posts: 118
Joined: Apr 10, 2010 11:41
Location: Japan
Contact:

Re: Visual Sort

Postby Makoto WATANABE » Sep 09, 2019 11:31

Dear denise_amiga

I don't understand what the following items mean.
I think this is a childish question, but please tell me about this.

smodes(sync)
{"off", "mode1", "mode2", "mode3"}
DANILIN
Posts: 7
Joined: Oct 20, 2018 0:57
Contact:

Re: Visual Sort

Postby DANILIN » Sep 18, 2019 22:46

may be interested in adding visualization
fast up bubble sorting regular and recursive

FreeBasic Russian Sorting Halves Danilin
https://freebasic.net/forum/viewtopic.php?f=3&t=27097
denise_amiga
Posts: 16
Joined: Jan 18, 2007 9:55

Re: Visual Sort

Postby denise_amiga » Sep 26, 2019 21:43

Makoto WATANABE wrote:Dear denise_amiga

I don't understand what the following items mean.
I think this is a childish question, but please tell me about this.

smodes(sync)
{"off", "mode1", "mode2", "mode3"}

smodes (sync) is a text array to show the text of the speed at which we see the algorithm.

The last speed, the slowest "mode3", is not implemented.

While we see the algorithm, we can change the speed with the "space" key.

with the "p" key, we switch between points and lines

with the "r" key, we change between random and fixed, to compare on equal terms

Return to “Tips and Tricks”

Who is online

Users browsing this forum: No registered users and 1 guest