Visual Sort

denise_amiga · Post by **denise_amiga** » Jun 05, 2019 10:10

Graphical representation of different sort methods

#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

dodicat · Post by **dodicat** » Jun 05, 2019 11:45

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

https://en.wikibooks.org/wiki/Algorithm ... _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 · Post by **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 · Post by **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 · Post by **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 · Post by **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 · Post by **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 · Post by **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 · Post by **Makoto WATANABE** » Sep 08, 2019 14:20

Dear denise_amiga

Thanks for your consent.
Thank you for your kindness.

Makoto WATANABE · Post by **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 · Post by **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 · Post by **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

Visual Sort

Visual Sort

Re: Visual Sort

Re: Visual Sort

Re: Visual Sort

Re: Visual Sort

Re: Visual Sort

Re: Visual Sort

Re: Visual Sort

Re: Visual Sort

Re: Visual Sort

Re: Visual Sort

Re: Visual Sort