I wonder if brother s11ss's sorting algorithm can meet the building owner's needs
'''''''' Sorting ''''''''
''''''''s11ss 2007-10-18''''''''
option explicit
'receive input:
dim s,r,n,i
s=inputbox(vbcrlf&vbcrlf&"Separate with spaces:","Please enter a group of numbers:","2007 10 18 21 15")
if s="" then wscript.quit
r=split(s," ")
n=ubound(r)
'Convert string to Double subtype:
for i=0 to n
r(i)=cdbl(r(i))
next
'Call quick sort method:
quicksort r,0,n
'Call other sorting methods:
'insertsort r
'shellsort r
'bubblesort r
'selectsort r
'heapsort r
'Output result:
inputbox vbcrlf&vbcrlf&"In ascending order is:","Result",join(r," ")
'Customize various sorting subroutines:
'Direct insertion sort:
sub insertsort(r)
dim i,n,t,j
n=ubound(r)
for i=1 to n'Insert r(1), r(2),..., r(n) in turn
t=r(i)
j=i-1
do while t<r(j)'Find the insertion position of r(i)
r(j+1)=r(j)'Shift numbers larger than r(i) backward
j=j-1
if j=-1 then exit do
loop
r(j+1)=t'Insert r(i)
next
end sub
'Shell sort:
sub shellsort(r)
'Set increment sequence:
dim i,d(),n,t,k,h,j
n=ubound(r)
i=0
redim d(n)
d(i)=fix(n/2)
do until d(i)=1
t=d(i)
i=i+1
d(i)=fix(t/2)
loop
'Sort:
k=0
do
h=d(k)'Take the increment of this pass
for i=h to n'r(h) to r(n) insert into the current ordered area
t=r(i)'Save the number to be inserted
j=i-h
do while t<r(j)'Find the correct insertion position
r(j+h)=r(j)'Shift backward
j=j-h'Get the position of the previous number
if j<0 then exit do
loop
r(j+h)=t'Insert r(i)
next'Complete this pass of sorting
k=k+1
loop while h<>1
end sub
'Bubble sort:
sub bubblesort(r)
dim i,n,noswap,j,t
n=ubound(r)
for i=0 to n-1'do n passes of sorting
noswap=True'set unswapped flag
for j=n-1 to i step -1'scan from bottom up
if r(j+1)<r(j) then'exchange
t=r(j)
r(j)=r(j+1)
r(j+1)=t
noswap=False
end if
next
if noswap then exit for'terminate the algorithm if no swap occurs in this pass of sorting
next
end sub
'Quick sort:
'Partition:
function partition(r,l,h)
dim i,j,t
i=l
j=h
t=r(i)'Initialize, t is the pivot
do
while r(j)>=t and i<j
j=j-1'scan from right to left, find the first number less than t
wend
if i<j then
r(i)=r(j)'exchange r(i) and r(j)
i=i+1
end if
while r(i)<=t and i<j
i=i+1'scan from left to right, find the first number greater than t
wend
if i<j then
r(j)=r(i)'exchange r(i) and r(j)
j=j-1
end if
loop while i<>j
r(i)=t'the pivot t has been finally positioned
partition=i
end function
'Sort:
sub quicksort(r,s1,t1)
dim i
if s1<t1 then'no need to sort if there is one number or no number
i=partition(r,s1,t1)'partition r(s1) to r(t1)
quicksort r,s1,i-1'recursively process the left interval
quicksort r,i+1,t1'recursively process the right interval
end if
end sub
'Direct selection sort:
sub selectsort(r)
dim i,n,k,j,t
n=ubound(r)
for i=0 to n-1'do n passes of sorting
k=i
for j=i+1 to n'select the smallest number r(k) in the current unsorted area
if r(j)<r(k) then k=j
next
if k<>i then
t=r(i)
r(i)=r(k)
r(k)=t
end if
next
end sub
'Heap sort:
'Sift:
sub sift(r,i,m)'the complete binary tree with r(i) as the root forms a heap
dim t,j
t=r(i)
j=2*i
do while j<=m'j<=m, r(2*i) is the left child of r(i)
if j<m then
if r(j)<r(j+1) then j=j+1'j points to the right child of r(i)
end if
if t<r(j) then'child node has a larger number
r(i)=r(j)'move r(j) to the parent position
i=j'revise the current adjusted node
j=2*i
else
exit do'adjustment completed, exit loop
end if
loop
r(i)=t'the initially adjusted node is placed in the correct position
end sub
'Sort:
sub heapsort(r)
dim i,n,t
n=ubound(r)
for i=fix(n/2) to 0 step -1'build initial heap
sift r,i,n
next
for i=n to 0 step -1'do n+1 passes of sorting
t=r(0)'swap the current heap top number with the last number
r(0)=r(i)
r(i)=t
sift r,0,i-1'rebuild the heap from r(0) to r(i-1)
next
end sub
DigestI
