[第一讲] 快速排序算法
在数值计算中，不可避免的需要用到排序，对于快速排序算法，数值分析的书里面介绍非常详细，这里我们不讨论具体算法，只讨论程序的标准性、通用性、可扩展性大家可以从以下方面来讨论：
1、程序的错误地方，需改进的地方
2、跟常用算法库的程序进行对比，贴出相应的效率对比分析，并注明编译器、系统、版本等信息
3、数组大小与时间的效率图
4、针对自己的问题，贴出相关的效率图
5、网络上存在的快速排序算法都有哪些，效率、通用性等
当然，欢迎灌水
抛砖引玉：
Module QuickSortMod
!
! quick sort algorithm
!
Integer, Parameter :: RealPrec = kind(0.0d0)
!
! InterFace
!
Interface QuickSort
Module Procedure quick_sort_i
Module Procedure quick_sort_d
End InterFace QuickSort
Contains
!****************************************************************!******************************************************************************!
Recursive Subroutine quick_sort_i(ilist1,ilist2,dlist1,zlist1)
Integer, dimension(:), intent(in out) :: ilist1
Integer, dimension(:), intent(in out), optional :: ilist2
Real(RealPrec), dimension(:), intent(in out), optional :: dlist1
Complex(RealPrec), dimension(:), intent(in out), optional :: zlist1
Integer :: i, j, n
Integer :: chosen, temp
complex(RealPrec) :: ztemp
Integer, parameter :: max_simple_sort_size = 6
n = size(ilist1)
If (n <= max_simple_sort_size) Then
! Use interchange sort for small lists
If ( (Present(ilist2)) .and. (Present(dlist1)) .and. (Present(zlist1)) ) Then
call interchange_sort(ilist1,ilist2=ilist2,dlist1=dlist1,zlist1=zlist1)
ElseIf ( (Present(dlist1)) .and. (Present(zlist1)) ) Then
call interchange_sort(ilist1,dlist1=dlist1,zlist1=zlist1)
ElseIf ( (Present(ilist2)) .and. (Present(dlist1)) ) Then
call interchange_sort(ilist1,ilist2=ilist2,dlist1=dlist1)
ElseIf ( (Present(ilist2)) .and. (Present(zlist1)) ) Then
call interchange_sort(ilist1,ilist2=ilist2,zlist1=zlist1)
ElseIf ( (Present(dlist1)) ) Then
call interchange_sort(ilist1,dlist1=dlist1)
ElseIf ( (Present(ilist2)) ) Then
call interchange_sort(ilist1,ilist2=ilist2)
ElseIf ( (Present(zlist1)) ) Then
call interchange_sort(ilist1,zlist1=zlist1)
Else
call interchange_sort(ilist1)
endif
Else
! Use partition (“quick”) sort
chosen = ilist1(n/2)
i = 0
j = n + 1
Do
! Scan list from left End
! until element >= chosen is found
Do
i = i + 1
If (ilist1(i) >= chosen) exit
End Do
! Scan list from right End
! until element <= chosen is found
Do
j = j - 1
If (ilist1(j) <= chosen) exit
End Do
If (i < j) Then
! Swap two out of place elements
temp = ilist1(i)
ilist1(i) = ilist1(j)
ilist1(j) = temp
If (Present(ilist2)) Then
temp = ilist2(i)
ilist2(i) = ilist2(j)
ilist2(j) = temp
endif
If(Present(dlist1)) Then
ztemp = dlist1(i)
dlist1(i) = dlist1(j)
dlist1(j) = ztemp
endif
If(Present(zlist1)) Then
ztemp = zlist1(i)
zlist1(i) = zlist1(j)
zlist1(j) = ztemp
endif
Else If (i == j) Then
i = i + 1
exit
Else
exit
End If
End Do
If ( (Present(ilist2)) .and. (Present(dlist1)) .and. (Present(zlist1)) ) Then
If (1 < j) call quick_sort_i(ilist1(:j),ilist2=ilist2(:j),dlist1=dlist1(:j),zlist1=zlist1(:j))
If (i < n) call quick_sort_i(ilist1(i:),ilist2=ilist2(i:),dlist1=dlist1(i:),zlist1=zlist1(i:))
ElseIf ( (Present(dlist1)) .and. (Present(zlist1)) ) Then
If (1 < j) call quick_sort_i(ilist1(:j),dlist1=dlist1(:j),zlist1=zlist1(:j))
If (i < n) call quick_sort_i(ilist1(i:),dlist1=dlist1(i:),zlist1=zlist1(i:))
ElseIf ( (Present(ilist2)) .and. (Present(dlist1)) ) Then
If (1 < j) call quick_sort_i(ilist1(:j),ilist2=ilist2(:j),dlist1=dlist1(:j))
If (i < n) call quick_sort_i(ilist1(i:),ilist2=ilist2(i:),dlist1=dlist1(i:))
ElseIf ( (Present(ilist2)) .and. (Present(zlist1)) ) Then
If (1 < j) call quick_sort_i(ilist1(:j),ilist2=ilist2(:j),zlist1=zlist1(:j))
If (i < n) call quick_sort_i(ilist1(i:),ilist2=ilist2(i:),zlist1=zlist1(i:))
ElseIf ( (Present(dlist1)) ) Then
If (1 < j) call quick_sort_i(ilist1(:j),dlist1=dlist1(:j))
If (i < n) call quick_sort_i(ilist1(i:),dlist1=dlist1(i:))
ElseIf ( (Present(ilist2)) ) Then
If (1 < j) call quick_sort_i(ilist1(:j),ilist2=ilist2(:j))
If (i < n) call quick_sort_i(ilist1(i:),ilist2=ilist2(i:))
ElseIf ( (Present(zlist1)) ) Then
If (1 < j) call quick_sort_i(ilist1(:j),zlist1=zlist1(:j))
If (i < n) call quick_sort_i(ilist1(i:),zlist1=zlist1(i:))
Else
If (1 < j) call quick_sort_i(ilist1(:j))
If (i < n) call quick_sort_i(ilist1(i:))
endif
End If! test for small array
End Subroutine quick_sort_i
!****************************************************************!******************************************************************************!
Subroutine interchange_sort(ilist1,ilist2,dlist1,zlist1)
Integer, dimension(:), intent(in out) :: ilist1
Integer, dimension(:), intent(in out), optional :: ilist2
Real(RealPrec), dimension(:), intent(in out), optional :: dlist1
Complex(RealPrec), dimension(:), intent(in out), optional :: zlist1
Integer :: i, j
Integer :: temp
complex(RealPrec) :: ztemp
Do i = 1, size(ilist1) - 1
Do j = i + 1, size(ilist1)
If (ilist1(i) >ilist1(j)) Then
temp = ilist1(i)
ilist1(i) = ilist1(j)
ilist1(j) = temp
If (Present(ilist2)) Then
temp = ilist2(i)
ilist2(i) = ilist2(j)
ilist2(j) = temp
endif
If(Present(dlist1)) Then
ztemp = dlist1(i)
dlist1(i) = dlist1(j)
dlist1(j) = ztemp
endif
If(Present(zlist1)) Then
ztemp = zlist1(i)
zlist1(i) = zlist1(j)
zlist1(j) = ztemp
endif
End If
End Do
End Do
End Subroutine interchange_sort
!****************************************************************!******************************************************************************!
Recursive Subroutine quick_sort_d(dlist1,dlist2,ilist1,zlist1)
Real(RealPrec), dimension(:), intent(in out) :: dlist1
Real(RealPrec), dimension(:), intent(in out), optional :: dlist2
Integer, dimension(:), intent(in out), optional :: ilist1
Complex(RealPrec), dimension(:), intent(in out), optional :: zlist1
Integer :: i, j, n
Integer :: temp
real(RealPrec) :: dtemp, chosen
Complex(RealPrec) :: ztemp
Integer, parameter :: max_simple_sort_size = 6
n = size(dlist1)
If (n <= max_simple_sort_size) Then
! Use interchange sort for small lists
If ( (Present(ilist1)).and.(Present(dlist2)) .and. (Present(zlist1)) ) Then
call interchange_sort_d(dlist1,dlist2=dlist2,ilist1=ilist1,zlist1=zlist1)
ElseIf( (Present(ilist1)) .and. (Present(zlist1)) ) Then
call interchange_sort_d(dlist1,ilist1=ilist1,zlist1=zlist1)
ElseIf ( (Present(dlist2)) .and. (Present(zlist1)) ) Then
call interchange_sort_d(dlist1,dlist2=dlist2,zlist1=zlist1)
ElseIf ( (Present(dlist2)) .and. (Present(ilist1)) ) Then
call interchange_sort_d(dlist1,dlist2=dlist2,ilist1=ilist1)
ElseIf ( (Present(ilist1)) ) Then
call interchange_sort_d(dlist1,ilist1=ilist1)
ElseIf ( (Present(zlist1)) ) Then
call interchange_sort_d(dlist1,zlist1=zlist1)
ElseIf ( (Present(dlist2)) ) Then
call interchange_sort_d(dlist1,dlist2=dlist2)
Else
call interchange_sort_d(dlist1)
endif
Else
! Use partition (“quick”) sort
chosen = dlist1(n/2)
i = 0
j = n + 1
Do
! Scan list from left End
! until element >= chosen is found
Do
i = i + 1
If (dlist1(i) >= chosen) exit
End Do
! Scan list from right End
! until element <= chosen is found
Do
j = j - 1
If (dlist1(j) <= chosen) exit
End Do
If (i < j) Then
! Swap two out of place elements
dtemp = dlist1(i)
dlist1(i) = dlist1(j)
dlist1(j) = dtemp
If (Present(ilist1)) Then
temp = ilist1(i)
ilist1(i) = ilist1(j)
ilist1(j) = temp
endif
If (Present(dlist2)) Then
dtemp = dlist2(i)
dlist2(i) = dlist2(j)
dlist2(j) = dtemp
endif
If(Present(zlist1)) Then
ztemp = zlist1(i)
zlist1(i) = zlist1(j)
zlist1(j) = ztemp
endif
Else If (i == j) Then
i = i + 1
exit
Else
exit
End If
End Do
If ( (Present(ilist1)).and.(Present(dlist2)) .and. (Present(zlist1)) ) Then
If (1 < j) call quick_sort_d(dlist1(:j),dlist2=dlist2(:j),ilist1=ilist1(:j),zlist1=zlist1(:j))
If (i < n) call quick_sort_d(dlist1(i:),dlist2=dlist2(i:),ilist1=ilist1(i:),zlist1=zlist1(i:))
ElseIf( (Present(ilist1)) .and. (Present(zlist1)) ) Then
If (1 < j) call quick_sort_d(dlist1(:j),ilist1=ilist1(:j),zlist1=zlist1(:j))
If (i < n) call quick_sort_d(dlist1(i:),ilist1=ilist1(i:),zlist1=zlist1(i:))
ElseIf ( (Present(dlist2)) .and. (Present(zlist1)) ) Then
If (1 < j) call quick_sort_d(dlist1(:j),dlist2=dlist2(:j),zlist1=zlist1(:j))
If (i < n) call quick_sort_d(dlist1(i:),dlist2=dlist2(i:),zlist1=zlist1(i:))
ElseIf ( (Present(dlist2)) .and. (Present(ilist1)) ) Then
If (1 < j) call quick_sort_d(dlist1(:j),dlist2=dlist2(:j),ilist1=ilist1(:j))
If (i < n) call quick_sort_d(dlist1(i:),dlist2=dlist2(i:),ilist1=ilist1(i:))
ElseIf ( (Present(ilist1)) ) Then
If (1 < j) call quick_sort_d(dlist1(:j),ilist1=ilist1(:j))
If (i < n) call quick_sort_d(dlist1(i:),ilist1=ilist1(i:))
ElseIf ( (Present(zlist1)) ) Then
If (1 < j) call quick_sort_d(dlist1(:j),zlist1=zlist1(:j))
If (i < n) call quick_sort_d(dlist1(i:),zlist1=zlist1(i:))
ElseIf ( (Present(dlist2)) ) Then
If (1 < j) call quick_sort_d(dlist1(:j),dlist2=dlist2(:j))
If (i < n) call quick_sort_d(dlist1(i:),dlist2=dlist2(i:))
Else
If (1 < j) call quick_sort_d(dlist1(:j))
If (i < n) call quick_sort_d(dlist1(i:))
endif
End If! test for small array
End Subroutine quick_sort_d
!****************************************************************!******************************************************************************!
Subroutine interchange_sort_d(dlist1,dlist2,ilist1,zlist1)
Real(RealPrec), dimension(:), intent(in out) :: dlist1
Real(RealPrec), dimension(:), intent(in out), optional :: dlist2
Integer, dimension(:), intent(in out), optional :: ilist1
Complex(RealPrec), dimension(:), intent(in out), optional :: zlist1
Integer :: i, j
Integer :: temp
real(RealPrec) :: dtemp
complex(RealPrec) :: ztemp
Do i = 1, size(dlist1) - 1
Do j = i + 1, size(dlist1)
If (dlist1(i) >dlist1(j)) Then
dtemp = dlist1(i)
dlist1(i) = dlist1(j)
dlist1(j) = dtemp
If (Present(dlist2)) Then
dtemp = dlist2(i)
dlist2(i) = dlist2(j)
dlist2(j) = dtemp
endif
If (Present(ilist1)) Then
temp = ilist1(i)
ilist1(i) = ilist1(j)
ilist1(j) = temp
endif
If(Present(zlist1)) Then
ztemp = zlist1(i)
zlist1(i) = zlist1(j)
zlist1(j) = ztemp
endif
End If
End Do
End Do
Return
End Subroutine interchange_sort_d
!****************************************************************!******************************************************************************!
End Module
主程序：
Program QuickSortMain
Use QuickSortMod
Implicit None
Integer :: N
Integer, allocatable :: IntDat(:)
Real(8), allocatable :: RealDat(:)
Complex(8), allocatable :: ComplexDat(:)
real, allocatable :: Dat(:)
N = 10
allocate( IntDat(N), RealDat(N), ComplexDat(N), Dat(N) )
Call Random_Seed()
! set integer data
Call Random_number(Dat)
IntDat = Int( (2*Dat-1)*100 )
! set real data
Call Random_number(Dat)
RealDat = (2*Dat-1)*100
! set complx data
Call Random_number(Dat)
ComplexDat = (2*Dat-1)*100
Call QuickSort(IntDat,dlist1=RealDat,zlist1=ComplexDat)
Call QuickSort(RealDat,ilist1=IntDat,zlist1=ComplexDat)
Stop
End Program QuickSortMain
我这里找了三个快速排序算法。
楼主这个，我称为 QuickSortMod，Intel Fortran 扩展的 Qsort，以及 Juli Rew（Fortran.com）写的（http://www.fcode.cn/code_prof-38-1.html）
用的 IVF for windows XE2013 SP1 编译，win7sp1 运行。
一些N长度与耗时的曲线如图（X轴为N数据量，Y轴为耗时 mSec ）：
我很奇怪Intel Fortran 的 Qsort 为啥后面斜率变低了，实验了多次。很是奇怪。数据量稍低时，JuliRew的算法效率高，数据量大时，IVF所带的QSort表现不错。
但是这三者又各有优点：
QuickSortMod，允许有其他数组随之而排序，而其他两者只允许一个数组排序。这可能是影响它效率发挥的原因。
IVF扩展的QSort，支持各种数据类型，包括用户自己的 type 类型。（需指定数据单个所占的字节数，需书写外部比较函数）自己书写外部比较函数，可以实现类似时间日期的排序。但通用性不好，只能在 VF 上使用。
JuliRew 算法，简单，高效，代码精炼。
最后，提个题外话，如果数据中已有一定的顺序，比如：1，2，3，7，4，5，6，8，9。用堆排序效率很高。
chuxf 发表于 2014-3-2 20:17
我这里找了三个快速排序算法。
楼主这个，我称为 QuickSortMod，Intel Fortran 扩展的 Qsort，以及 Juli R ...
若楼上仔细看下我的算法，其实我的算法就是冒泡排序算法，只是我的程序做了太多的IF用于判断后面跟随的扩展数组 aliouying 发表于 2014-3-2 20:51
若楼上仔细看下我的算法，其实我的算法就是冒泡排序算法，只是我的程序做了太多的IF用于判断后面跟随的扩 ...
呵呵，确实没有仔细看。
只大致看了接口处。快速排序就是根据冒泡算法修改的，所以有相似之处。 chuxf 发表于 2014-3-2 21:50
呵呵，确实没有仔细看。
只大致看了接口处。快速排序就是根据冒泡算法修改的，所以有相似之处。 ...
不是相似，是算法就是一样的，只是我的partition部分直接在程序里面 我理解的冒泡法是不进行 partition 的，相邻两个点对比，调换，走完整个数组，然后循环大约N次。
而先调换一半，就是改进后的快速排序。 fcode 发表于 2014-3-3 09:35
我理解的冒泡法是不进行 partition 的，相邻两个点对比，调换，走完整个数组，然后循环大约N次。
而先调换 ...
嗯，是的
在比较小的时候没必要partition，我设的是6，其实这个没有多大必要，所以直接用改进的快速排序算法即可，可以精简程序 fcode 发表于 2014-3-3 09:35
我理解的冒泡法是不进行 partition 的，相邻两个点对比，调换，走完整个数组，然后循环大约N次。
而先调换 ...
石头，你的F币刷得这么高了！！！ aliouying 发表于 2014-3-3 23:27
石头，你的F币刷得这么高了！！！
嘘，这个可以作弊的{:2_27:} fcode 发表于 2014-3-3 23:29
嘘，这个可以作弊的
:-handshake