***vbs各种排序********
option explicit
'接收输入：
dim s,r,n,i
s=inputbox(vbcrlf&vbcrlf&"以空格隔开：","请输入一组数：","2007 10 18 21 15")
if s="" then wscript.quit
r=split(s," ")
n=ubound(r)
'把字符串转换为Double 子类型：
for i=0 to n
r(i)=cdbl(r(i))
next
'快速排序方法调用：
quicksort r,0,n
'其它排序方法的调用：
'insertsort r
'shellsort r
'bubblesort r
'selectsort r
'heapsort r
'输出结果：
inputbox vbcrlf&vbcrlf&"按升序排列是：","结果",join(r," ")
'各种排序子过程自定义：
'直接插入排序：
sub insertsort(r)
dim i,n,t,j
n=ubound(r)
for i=1 to n'依次插入r(1),r(2),...,r(n)
t=r(i)
j=i-1
do while t<r(j)'查找r(i)的插入位置
r(j+1)=r(j)'将大于r(i)的数后移
j=j-1
if j=-1 then exit do
loop
r(j+1)=t'插入r(i)
next
end sub
'希尔排序：
sub shellsort(r)
'设置增量序列：
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
'排序：
k=0
do
h=d(k)'取本趟增量
for i=h to n'r(h)到r(n)插入当前有序区
t=r(i)'保存待插入数
j=i-h
do while t<r(j)'查找正确的插入位置
r(j+h)=r(j)'后移
j=j-h'得到前一数的位置
if j<0 then exit do
loop
r(j+h)=t'插入r(i)
next'本趟排序完成
k=k+1
loop while h<>1
end sub
'冒泡排序：
sub bubblesort(r)
dim i,n,noswap,j,t
n=ubound(r)
for i=0 to n-1'做n趟排序
noswap=True'置未交换标志
for j=n-1 to i step -1'从下往上扫描
if r(j+1)<r(j) then'交换
t=r(j)
r(j)=r(j+1)
r(j+1)=t
noswap=False
end if
next
if noswap then exit for'本趟排序中未发生交换则终止算法
next
end sub
'快速排序：
'划分：
function partition(r,l,h)
dim i,j,t
i=l
j=h
t=r(i)'初始化，t为基准
do
while r(j)>=t and i<j
j=j-1'从右向左扫描，查找第1个小于t的数
wend
if i<j then
r(i)=r(j)'交换r(i)和r(j)
i=i+1
end if
while r(i)<=t and i<j
i=i+1'从左向右扫描，查找第1个大于t的数
wend
if i<j then
r(j)=r(i)'交换r(i)和r(j)
j=j-1
end if
loop while i<>j
r(i)=t'基准t已被最后定位
partition=i
end function
'排序：
sub quicksort(r,s1,t1)
dim i
if s1<t1 then'只有一个数或无数时无须排序
i=partition(r,s1,t1)'对r(s1)到r(t1)做划分
quicksort r,s1,i-1'递归处理左区间
quicksort r,i+1,t1'递归处理右区间
end if
end sub
'直接选择排序：
sub selectsort(r)
dim i,n,k,j,t
n=ubound(r)
for i=0 to n-1'做n趟排序
k=i
for j=i+1 to n'在当前无序区选最小的数r(k)
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
'堆排序：
'筛选：
sub sift(r,i,m)'以r(i)为根的完全二叉树构成堆
dim t,j
t=r(i)
j=2*i
do while j<=m'j<=m,r(2*i)是r(i)的左孩子
if j<m then
if r(j)<r(j+1) then j=j+1'j指向r(i)的右孩子
end if
if t<r(j) then'孩子节点的数较大
r(i)=r(j)'将r(j)换到双亲位置上
i=j'修改当前被调整节点
j=2*i
else
exit do'调整完毕，退出循环
end if
loop
r(i)=t'最初被调整节点放入正确位置
end sub
'排序：
sub heapsort(r)
dim i,n,t
n=ubound(r)
for i=fix(n/2) to 0 step -1'建初始堆
sift r,i,n
next
for i=n to 0 step -1'进行n+1趟排序
t=r(0)'当前堆顶数和最后一个数交换
r(0)=r(i)
r(i)=t
sift r,0,i-1'r(0)到r(i-1)重建成堆
next
'接收输入：
dim s,r,n,i
s=inputbox(vbcrlf&vbcrlf&"以空格隔开：","请输入一组数：","2007 10 18 21 15")
if s="" then wscript.quit
r=split(s," ")
n=ubound(r)
'把字符串转换为Double 子类型：
for i=0 to n
r(i)=cdbl(r(i))
next
'快速排序方法调用：
quicksort r,0,n
'其它排序方法的调用：
'insertsort r
'shellsort r
'bubblesort r
'selectsort r
'heapsort r
'输出结果：
inputbox vbcrlf&vbcrlf&"按升序排列是：","结果",join(r," ")
'各种排序子过程自定义：
'直接插入排序：
sub insertsort(r)
dim i,n,t,j
n=ubound(r)
for i=1 to n'依次插入r(1),r(2),...,r(n)
t=r(i)
j=i-1
do while t<r(j)'查找r(i)的插入位置
r(j+1)=r(j)'将大于r(i)的数后移
j=j-1
if j=-1 then exit do
loop
r(j+1)=t'插入r(i)
next
end sub
'希尔排序：
sub shellsort(r)
'设置增量序列：
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
'排序：
k=0
do
h=d(k)'取本趟增量
for i=h to n'r(h)到r(n)插入当前有序区
t=r(i)'保存待插入数
j=i-h
do while t<r(j)'查找正确的插入位置
r(j+h)=r(j)'后移
j=j-h'得到前一数的位置
if j<0 then exit do
loop
r(j+h)=t'插入r(i)
next'本趟排序完成
k=k+1
loop while h<>1
end sub
'冒泡排序：
sub bubblesort(r)
dim i,n,noswap,j,t
n=ubound(r)
for i=0 to n-1'做n趟排序
noswap=True'置未交换标志
for j=n-1 to i step -1'从下往上扫描
if r(j+1)<r(j) then'交换
t=r(j)
r(j)=r(j+1)
r(j+1)=t
noswap=False
end if
next
if noswap then exit for'本趟排序中未发生交换则终止算法
next
end sub
'快速排序：
'划分：
function partition(r,l,h)
dim i,j,t
i=l
j=h
t=r(i)'初始化，t为基准
do
while r(j)>=t and i<j
j=j-1'从右向左扫描，查找第1个小于t的数
wend
if i<j then
r(i)=r(j)'交换r(i)和r(j)
i=i+1
end if
while r(i)<=t and i<j
i=i+1'从左向右扫描，查找第1个大于t的数
wend
if i<j then
r(j)=r(i)'交换r(i)和r(j)
j=j-1
end if
loop while i<>j
r(i)=t'基准t已被最后定位
partition=i
end function
'排序：
sub quicksort(r,s1,t1)
dim i
if s1<t1 then'只有一个数或无数时无须排序
i=partition(r,s1,t1)'对r(s1)到r(t1)做划分
quicksort r,s1,i-1'递归处理左区间
quicksort r,i+1,t1'递归处理右区间
end if
end sub
'直接选择排序：
sub selectsort(r)
dim i,n,k,j,t
n=ubound(r)
for i=0 to n-1'做n趟排序
k=i
for j=i+1 to n'在当前无序区选最小的数r(k)
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
'堆排序：
'筛选：
sub sift(r,i,m)'以r(i)为根的完全二叉树构成堆
dim t,j
t=r(i)
j=2*i
do while j<=m'j<=m,r(2*i)是r(i)的左孩子
if j<m then
if r(j)<r(j+1) then j=j+1'j指向r(i)的右孩子
end if
if t<r(j) then'孩子节点的数较大
r(i)=r(j)'将r(j)换到双亲位置上
i=j'修改当前被调整节点
j=2*i
else
exit do'调整完毕，退出循环
end if
loop
r(i)=t'最初被调整节点放入正确位置
end sub
'排序：
sub heapsort(r)
dim i,n,t
n=ubound(r)
for i=fix(n/2) to 0 step -1'建初始堆
sift r,i,n
next
for i=n to 0 step -1'进行n+1趟排序
t=r(0)'当前堆顶数和最后一个数交换
r(0)=r(i)
r(i)=t
sift r,0,i-1'r(0)到r(i-1)重建成堆
next
end sub