Visual Sorting Algorithm comparison

Article
09/19/2006

When I bought my first IBM PC around 1981, I wrote a program to demonstrate the speed of various sorting algorithms. It filled the screen with random characters, then the user could choose amongst a few sorting techniques and watch the sort algorithm in action as the data moved around on the screen. Watching the data move helps to see how the algorithm works.

The program could access the graphics card directly, writing characters directly into the video memory. For Foxpro, I used the @..SAY command to put a string at a particular row and column. For VB I used the Graphics.DrawString method.

Below are a Fox and VB reimplementation of this demo.

Run the code and type “B” for Bubble Sort, i=Insertion Sort, s=Shell Sort, q=Quick Sort. R will reset the data to be random.

Which one is fastest for you?

Some of the sorts take a *long* time so just the first few elements are sorted.

I’ve removed the Supersort code as an exercise for the reader: what 14 lines of code will achieve the result *much* faster than any other sorting algorithm?

Hint: none of the other algorithms require much additional storage other than a few local variables. The SuperSort uses an array of size 26.

CLEAR

PUBLIC ox

ox= NEWOBJECT("SortForm")

DEFINE CLASS SortForm AS Form

left=200

width=800

height=600

nRows=0

nCols=0

FontName="Courier New"

FontSize=10

BackColor=0xffffff

DIMENSION arData[1]

nTotal=0

PROCEDURE init

* RAND(SECONDS()) && randomize generator

this.show

this.Setup

PROCEDURE Setup

this.nRows=INT(this.height/FONTMETRIC(1)-1)

this.nCols=INT(this.width/FONTMETRIC(6))

this.nTotal= this.nRows*this.nCols

DIMENSION this.arData[this.nTotal]

this.Shuffle

PROCEDURE Shuffle

FOR i = 1 TO this.nTotal

this.arData[i]=CHR(RAND()*26+ASC('A'))

@ INT((i-1)/this.nCols), INT((i-1)%this.nCols) say this.arData[i]

ENDFOR

this.Caption="# elements = "+TRANSFORM(thisform.nTotal)+" Try Bubble, Insertion, Shell, Quick sorts"

PROCEDURE Resize

this.Cls

this.Setup

PROCEDURE KeyPress(nKeyCode, nShiftAltCtrl)

IF nKeyCode=27 && <escape> Exit program

thisform.Release

RETURN

ENDIF

IF nKeyCode=ASC("r") && reset random data

thisform.Setup

RETURN

ENDIF

cSort=""

nMax=thisform.nTotal

DO CASE

CASE nKeyCode=ASC("b") && Bubble

cSort="Bubble"

nMax=MIN(thisform.nTotal,1000) && slow sort: limit # of items

CASE nKeyCode=ASC("i") && Insertion

cSort="Insertion"

nMax=MIN(thisform.nTotal,1000) && slow sort: limit # of items

CASE nKeyCode=ASC("s") && Shell Sort

cSort="Shell"

CASE nKeyCode=ASC("q") && Quick Sort

cSort="Quick"

CASE nKeyCode=ASC("x") &&Super Sort

cSort="Super"

OTHERWISE

MESSAGEBOX("Unknown command")

RETURN

ENDCASE

this.Caption="# elements = "+TRANSFORM(nMax)+" Starting "+cSort+" Sort"

nStart = SECONDS()

this.&cSort.Sort(1,nMax) && Call the sort routine

this.Caption="# elements = "+TRANSFORM(thisform.nTotal)+" "+cSort+ " "+TRANSFORM(SECONDS()-nStart,"999.999")

PROCEDURE Swap(nPos1,nPos2) && Exchange the positions of 2 elements

LOCAL cTemp

cTemp=this.arData[nPos1]

this.arData[nPos1]=this.arData[nPos2]

this.arData[nPos2]= cTemp

@ INT((nPos1-1)/this.nCols), INT((nPos1-1)%this.nCols) say this.arData[nPos1]

@ INT((nPos2-1)/this.nCols), INT((nPos2-1)%this.nCols) say this.arData[nPos2]

PROCEDURE BubbleSort(nStart,nMax)

LOCAL i,j

FOR i = 1 TO nMax && loop through all elements

FOR j= 1 TO i && loop through current pos

IF this.arData[i] < this.arData[j]

this.Swap(i,j)

ENDIF

ENDFOR

PROCEDURE InsertionSort(nStart,nMax)

LOCAL i, j,t

FOR j = 2 TO nMax

IF this.arData[j-1] > this.arData[j] && compare adjacent elements

t = this.arData[j]

FOR i = j TO 2 STEP -1 && make room by moving the rest down

this.arData[i]=this.arData[i-1]

@ INT((i-1)/this.nCols), INT((i-1)%this.nCols) say this.arData[i-1]

IF this.arData[i-1] <= t

EXIT

ENDIF

ENDFOR

this.arData[i]=t

@ INT((i-1)/this.nCols), INT((i-1)%this.nCols) say t

ENDIF

ENDFOR

PROCEDURE ShellSort(nStart,nMax)

LOCAL g,i,j

g = INT(nMax/2)

DO WHILE g > 0 && g is successively half of nMax

FOR i = g+1 TO nMax

j = i - g

DO WHILE j>0 AND this.arData[j] > this.arData[j+g] && do we swap?

this.Swap(j,j+g)

j=j-g && next group

ENDDO

ENDFOR

g=INT(g/2)

ENDDO

PROCEDURE QuickSort(nLeft,nRight) && left and right pointers into data. Divide and conquer

LOCAL cKey,i,j

IF nLeft >= nRight && if the pointers cross, then we're done

RETURN

ENDIF

cKey = this.arData[nLeft] && the key is the first element

i=nLeft && start the left and right pointers

j = nRight +1

DO WHILE j > i && as the pointers move toward each other without crossing

i=i+1

DO WHILE this.arData[i] < cKey && move the left pointer til we find one out of pos

i=i+1

ENDDO

j=j-1

DO WHILE this.arData[j] > cKey && move the right pointer til we find one out of pos

j=j-1

ENDDO

IF j > i

this.Swap(j,i) && swap them

ENDIF

ENDDO

this.Swap(j,nLeft) && now we know the key goes into position nleft

this.QuickSort(nLeft, j-1) && sort left & right sides.

this.QuickSort(j+1, nRight)

PROCEDURE SuperSort(nStart,nMax)

*What 14 lines of superfast code should go here to accomplish the task of sorting all the data?

ENDDEFINE

This is the VB version:

Public Class Form1

Public arData(1) ' VB arrays are 0 to n-1

Dim rand As Random = New Random()

Dim nRows As Integer

Dim nCols As Integer

Dim nTotal As Integer

Delegate Sub dlgSortFunc(ByVal nStart As Integer, ByVal nMax As Integer)

Private Sub Form1_Load(ByVal sender As Object, ByVal e As System.EventArgs) Handles Me.Load

Me.Font = New Font("Courier new", 10)

Me.BackColor = Color.White

Me.Width = 800

Me.Height = 600

Me.Text = "Sort demo b=Bubble, i=Insertion, s=Shell, q=Quick sorts r=reset"

End Sub

Sub SetUp()

nRows = Me.Height / Font.Height - 3

nCols = Me.Width / Font.Size - 2

nTotal = nRows * nCols

ReDim arData(nTotal - 1)

Dim g As Graphics = Graphics.FromHwnd(Me.Handle)

g.FillRectangle(Brushes.White, 0, 0, Me.Width, Me.Height)

g.Dispose()

Shuffle()

End Sub

Sub Shuffle()

Dim i As Integer

For i = 0 To nTotal - 1

arData(i) = Chr(rand.Next(0, 26) + Asc("A"))

ShowChar(arData(i), i)

End Sub

Sub ShowChar(ByVal s As String, ByVal nPos As Integer)

Dim x, y As Integer

Dim g As Graphics

g = Graphics.FromHwnd(Me.Handle)

x = Int((nPos Mod Me.nCols)) * Me.Font.Size

y = Int((nPos / Me.nCols)) * Me.Font.Height

g.FillRectangle(Brushes.White, x, y, Me.Font.Size, Me.Font.Height)

g.DrawString(s, Me.Font, Brushes.Black, x, y)

g.Dispose()

End Sub

Private Sub Form1_Paint(ByVal sender As Object, ByVal e As System.Windows.Forms.PaintEventArgs) Handles Me.Paint

Dim g As Graphics = Graphics.FromHwnd(Me.Handle)

g.FillRectangle(Brushes.White, 0, 0, Me.Width, Me.Height)

g.Dispose()

Me.SetUp()

End Sub

Private Sub Form1_KeyPress(ByVal sender As Object, ByVal e As System.Windows.Forms.KeyPressEventArgs) Handles Me.KeyPress

If Asc(e.KeyChar) = 27 Then ' esc: end program

End

End If

If e.KeyChar = "r" Then

SetUp()

Return

End If

Dim cSort As String = ""

Dim nMax As Integer = Me.nTotal - 1

Dim MyDlg As dlgSortFunc

Select Case e.KeyChar

Case "b" ' bubble sort

cSort = "Bubble"

nMax = Math.Min(nMax, 800)

MyDlg = AddressOf Me.BubbleSort

Case "i" ' insertion

cSort = "Insertion"

nMax = Math.Min(nMax, 800)

MyDlg = AddressOf Me.InsertionSort

Case "s"

cSort = "Shell"

MyDlg = AddressOf Me.ShellSort

Case "q"

cSort = "Quick"

MyDlg = AddressOf Me.QuickSort

Case "x"

cSort = "Super"

MyDlg = AddressOf Me.SuperSort

Case Else

MsgBox("Unknown command")

Return

End Select

Me.Text = String.Format("{0} Sort # elements = {1}", cSort, nMax + 1)

Dim nStart As Integer = My.Computer.Clock.TickCount

MyDlg(0, nMax)

Dim nEnd As Integer = My.Computer.Clock.TickCount - nStart

Me.Text = String.Format("{0} Sort # elements = {1} Time={2:###.###}", cSort, nTotal, nEnd / 1000)

End Sub

Sub Swap(ByVal nPos1 As Integer, ByVal nPos2 As Integer)

Dim cTemp

cTemp = Me.arData(nPos1)

Me.arData(nPos1) = Me.arData(nPos2)

Me.arData(nPos2) = cTemp

ShowChar(Me.arData(nPos1), nPos1)

ShowChar(Me.ardata(nPos2), nPos2)

End Sub

Sub BubbleSort(ByVal nStart As Integer, ByVal nMax As Integer)

Dim i, j As Integer

For i = 0 To nMax

For j = 0 To i

If Me.arData(i) < Me.arData(j) Then

Swap(i, j)

End If

End Sub

Sub InsertionSort(ByVal nStart As Integer, ByVal nMax As Integer)

Dim i, j As Integer

Dim t As Char

For j = 1 To nMax

If Me.arData(j - 1) > Me.arData(j) Then ' compare adjacent elements

t = Me.arData(j)

For i = j To 1 Step -1 ' shift the rest down

Me.arData(i) = Me.arData(i - 1)

Me.ShowChar(Me.arData(i), i)

If Me.arData(i - 1) < t Then

Exit For

End If

Me.arData(i) = t

Me.ShowChar(t, i)

End If

End Sub

Sub ShellSort(ByVal nStart As Integer, ByVal nMax As Integer)

Dim g, i, j As Integer

g = Int(nMax / 2)

Do While g > 0

For i = g To nMax

j = i - g

Do While j >= 0 AndAlso Me.arData(j) > Me.arData(j + g)

Me.Swap(j, j + g)

j = j - g ' next group

If j < 0 Then

'Exit Do

End If

Loop

g = Int(g / 2)

Loop

End Sub

Sub QuickSort(ByVal nLeft As Integer, ByVal nRight As Integer)

Dim cKey As Char, i, j As Integer

If nLeft >= nRight Then ' if the pointers cross, then we're done

Return

End If

cKey = Me.arData(nLeft)

i = nLeft ' start the left and right index pointers

j = nRight + 1

Do While j > i ' as the poitners move toward each other without crossing

i = i + 1

Do While Me.arData(i) < cKey 'move the left pointer til we find one out of pos

i += 1

Loop

j -= 1

Do While Me.arData(j) > cKey 'move the right pointer til we find one out of pos

j -= 1

Loop

If j > i Then

Me.Swap(j, i)

End If

Loop

Me.Swap(j, nLeft) 'now we know the key goes into position nleft

Me.QuickSort(nLeft, j - 1) ' sort left & right sides

Me.QuickSort(j + 1, nRight)

End Sub

Sub SuperSort(ByVal nStart As Integer, ByVal nMax As Integer)

'What 14 lines of superfast code should go here to accomplish the task of sorting all the data?

End Class

Comments

Anonymous
September 19, 2006
Calvin,
A VFP Specific Solution in 12 lines (including Endproc???

Procedure SuperSort(nStart,nMax)
local I
create cursor curSort(ID C(1))
for I=nStart to nMax
Insert into curSort values (This.arData[I])
endfor
index on Id tag Id

I=1
scan
@ Int((I-1)/This.nCols), Int((I-1)%This.nCols) Say curSort->Id
I=I+1
endscan
endproc

Dave Crozier
All in 12 Lines!
Anonymous
September 19, 2006
The comment has been removed
Anonymous
September 19, 2006
This is probably closer to what's expected...

LOCAL ARRAY aa[26]
LOCAL nCnt1, nCnt2, nCnt3, nPos, nMax, nWritten, nTot
STORE 0 TO m.nPos
FOR m.nCnt1 = 1 TO m.nMax
m.nCnt2 = 1 + ASC(this.ardata[m.nCnt1])-ASC("A")
m.aa[m.nCnt2]=1+IIF(VARTYPE(aa[m.nCnt2])="L",0,m.aa[m.nCnt2])
ENDFOR
FOR m.nCnt3 = 0 TO 25
m.nTot = m.aa[m.nCnt3+1]
FOR m.nWritten = 1 TO m.nTot
@ INT((m.nPos+m.nWritten-1)/this.nCols), INT((m.nPos+m.nWritten-1)%this.nCols) say CHR(m.nCnt3+ASC("A"))
ENDFOR
m.nPos = m.nPos + m.nTot
ENDFOR

Partager via

Visual Sorting Algorithm comparison

Comments

Ressources supplémentaires