NewsForumsCodeLogsGallerySpecsSearch

Code archives/Algorithms/Sorting Array BASIC

This code has been declared by its author to be Public Domain code.

Download source code

Sorting Array BASIC by Neochrome2005
Basically this is a run of the mill basic sorting method for an array, i needed it, didn't take to long to write. so im sharing it 
Dim Words$(1001)

words(0) = "CAT"
words(1) = "DOG"
words(2) = "MAN"
words(3) = "WOMAN"
words(4) = "TREE"
words(5) = "GRASS"
words(6) = "FOAM"
words(7) = "NEOMANCER"


; 5, 0, 3, 2, 1, 4

; Demo Sort Array

Print "NON SORTED :" 
Print ""
For i=0 To 1000
	If words(i)<>""	Print words(i)
Next

tmp$ = ""

For o=0 To 1000
For i=0 To 1000
	
	t1$ = words(i)
	t2$ = words(o+1)
	
	If t2$<>""
		res% = t1$ > t2$
	
		If res=1
			tmp$ = t1$
			words(i)=t2$
			words(o+1) = tmp$

		EndIf
	EndIf
Next	
If t2$="" Then o=1000
Next

Print "------------"
Print "SORTED : "
Print ""
For i=0 To 10
	If words(i)<>""	Print words(i)
Next

Comments

Rook Zimbabwe2006
Commented source code would be a good thing...


n8r2k2006
*agrees*


bytecode772006
hey, cool stuff...very good for noobs!


DareDevil2006
i have changed the your software for order fast bye


Dim Words$(1001)
cntorder=0
For a=0 To 2
words(0+a*10) = "CAT"
words(1+a*10) = "DOG"
words(2+a*10) = "MAN"
words(3+a*10) = "WOMAN"
words(4+a*10) = "TREE"
words(5+a*10) = "GRASS"
words(6+a*10) = "FOAM"
words(7+a*10) = "NEOMANCER"
words(8+a*10) = "VINCENTX"
words(9+a*10) = "DEVIL CHILD"
Next
cntorder=a*10


; 5, 0, 3, 2, 1, 4

; Demo Sort Array

Print "NON SORTED :"
Print ""
For i=0 To 1000
If words(i)<>"" Print words(i)
Next

tmp$ = ""
IsSwap=True
While IsSwap=True
;===>
IsSwap=False
;Stop
For i=0 To cntorder
;===>
t1$ = words(i)
t2$ = words(i+1)
;===>
If t1$ > t2$
words(i)=t2$
words(i+1) = t1$
IsSwap=True
EndIf
;===>
Next
If t2$="" Then o=1000
;===>
Wend

Print "------------"
Print "SORTED : "
Print ""
For i=0 To cntorder
If words(i)<>"" Print words(i)
Next
WaitKey()


n8r2k2006
*still agrees with rook*


Neochrome2010
not been on the forums for a long time...
sorry for the none comment, i just whipped up the code and shared it :(

Thanks for the input though


Jason W.2010
Don't worry about it. If anyone has done arrays before should be able to read it.

I think DD's code needs comments though ;)

Jason


Who was John Galt?2010
Not good performing a million loops when you only need 49. You should count the number of words in the array and only loop those you need.


DareDevil2010
this code is optimized for "bouble sort" the very problem is a compare string!!
if you change compare with integer value the speed increment 100


Print "Create array string "
Wait()

Const MaxArray = 10000
Dim Words$(MaxArray)
Local a% 
For a=0 To (MaxArray/10)-1
	Words(0+a*10) = "CAT"
	Words(1+a*10) = "DOG"
	Words(2+a*10) = "MAN"
	Words(3+a*10) = "WOMAN"
	Words(4+a*10) = "TREE"
	Words(5+a*10) = "GRASS"
	Words(6+a*10) = "FOAM"
	Words(7+a*10) = "NEOMANCER"
	Words(8+a*10) = "VINCENTX"
	Words(9+a*10) = "DEVIL CHILD"
Next

; Demo Sort Array

Print "SORTING : "
Wait()
;===>
Local l_time = MilliSecs()
;===>
Global tmp$,t1$,t2$
Global i%
Global IsSwap% = True
;===>
While (IsSwap = True)
	;===>
	IsSwap = False
	;===>
	For i=0 To MaxArray
		;===>
		t1$ = Words(i)
		t2$ = Words(i+1)
		;===>
		If t1$ > t2$ Then 
			;===>
			Words(i)   = t2$
			Words(i+1) = t1$
			IsSwap = True
			;===>
		EndIf
		;===>
	Next
	;===>
Wend

Print "------------"
Print "Time SORTED : "+(MilliSecs()-l_time)
Print ""
WaitKey() 

For i=0 To MaxArray
	Print Words(i)
Next

WaitKey()

End 

Function Wait(ms%=1)
	Local TimeNew%=MilliSecs()+ms
	While (MilliSecs()>=TimeNew) 
		Local a=0
	Wend
End Function


Code integer


Print "Create array string "
Wait()

Const MaxArray = 10000
Dim Words%(MaxArray)
Local a% 
For a=0 To MaxArray
	Words(a) = Rand(0,500)
Next

; Demo Sort Array

Print "SORTING : "
Wait()
;===>
Local l_time = MilliSecs()
;===>
Global tmp%,t1%,t2%
Global i%
Global IsSwap% = True
;===>
While (IsSwap = True)
	;===>
	IsSwap = False
	;===>
	For i=0 To MaxArray
		;===>
		t1 = Words(i)
		t2 = Words(i+1)
		;===>
		If t1 > t2 Then 
			;===>
			Words(i)   = t2
			Words(i+1) = t1
			IsSwap = True
			;===>
		EndIf
		;===>
	Next
	;===>
Wend

Print "------------"
Print "Time SORTED : "+(MilliSecs()-l_time)
Print ""
WaitKey() 

For i=0 To MaxArray
	Print Words(i)
Next

WaitKey()

End 

Function Wait(ms%=1)
	Local TimeNew%=MilliSecs()+ms
	While (MilliSecs()>=TimeNew) 
		Local a=0
	Wend
End Function



Code Archives Forum