TheGameCreators - CodeBase

Return to the CodeBase listing

Category: Math / Physics

Version: 2.0

Information

Uploaded: 1st Oct 2003 18:14

Modified: 2nd Jun 2006 23:41

Author: Codger

Summary

Quick Sort Function for upto 1000 records press Yes at prompt to see graphic demo of sort.

Full Description

Quick Sort Function and small routine to graphically demonstrate<br /> <br /> Rem out any graphics in your application and it is very fast<br /> <br /> 1,000,000 items in 13 seconds or so depending on your machine

DarkBASIC Professional Source Code

` This code was downloaded from The Game Creators

` It is reproduced here with full permission

` http://www.thegamecreators.com

set window on

set window position 10,1

SET DISPLAY MODE 1024,768,32

set text font "verdana" rem "WESTMINSTER"

Set text size 16

SET TEXT OPAQUE

ink RGB(255,255,255),RGB(1,1,1)

color backdrop RGB(0,0,120)

GLOBAL AN$

sync off

sync rate 2000

rem global N as integer

rem global L as  Integer

cls

randomize timer()

set cursor 10,10

input "Enter Array Size to Sort : ", N

set cursor 10,30

input "Graphics Y/N: ", AN$

AN$ = upper$(AN$)

dim A(N) as integer

for L = 1 to N

A(L) = rnd(1024)

next L

set cursor 10,50

print "Sorting ",N," numbers..."

sync on

sync rate 0

if AN$ = "Y" then DrawArray()

StartTime = timer()

QuickSort(1,N)

sync off

EndTime = Timer()-StartTime

if AN$ = "Y" then DrawArray()

Set Cursor 10,70

Print "Time Taken ",Endtime, " Miliseconds"

wait key

loop

Function QuickSort(L,R)

I as integer

J as integer

X as integer

W as integer

I = L

J = R

X = A((L+R)/2)

repeat

while A(I) < X

inc I

endwhile

while X < A(J)

dec J

endwhile

if I <= J

W = A(I)

A(I) = A(J)

A(J) = W

rem remark out or delete  the next 2 line to disable graphics

rem 500 items take approx 5 seconds with graphic 1 or 2 miliseconds without

if An$ = "Y"

DrawLine(I)

Drawline(J)

endif

I = I + 1

J = J - 1

endif

until I >= J

if L < J then QuickSort(L,J)

if I < R then QuickSort(I,R)

EndFunction

Function DrawLine(i)

ink Rgb(125,0,0),Rgb(0,0,0)

line 1,100+i,A(i),100+i

ink Rgb(0,0,0),Rgb(255,255,255)

line A(i),100+i,1024,100+i

sync

endfunction

Function DrawArray()

box 0,100,1000,100+N,0,0,0,0

for i = 1 to N

DrawLine(i)

next i

sync

endfunction

Download

Please login to download

Comments

No comments yet.

CodeBase - Quick Sort