Fortran Coder

查看: 26644|回复: 24
打印 上一主题 下一主题

[通用算法] [第一讲] 快速排序算法

[复制链接]

136

帖子

3

主题

0

精华

版主

F 币
1964 元
贡献
1677 点

帅哥勋章管理勋章爱心勋章新人勋章热心勋章元老勋章

跳转到指定楼层
楼主
发表于 2014-3-2 09:56:45 | 只看该作者 |只看大图 回帖奖励 |倒序浏览 |阅读模式
在数值计算中,不可避免的需要用到排序,对于快速排序算法,数值分析的书里面介绍非常详细,这里我们不讨论具体算法,只讨论程序的标准性、通用性、可扩展性

大家可以从以下方面来讨论:

1、程序的错误地方,需改进的地方
2、跟常用算法库的程序进行对比,贴出相应的效率对比分析,并注明编译器、系统、版本等信息
3、数组大小与时间的效率图
4、针对自己的问题,贴出相关的效率图
5、网络上存在的快速排序算法都有哪些,效率、通用性等

当然,欢迎灌水

抛砖引玉:
[Fortran] 纯文本查看 复制代码
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 

主程序:
[Fortran] 纯文本查看 复制代码
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

分享到:  微信微信
收藏收藏 点赞点赞 点踩点踩

736

帖子

4

主题

0

精华

大师

农村外出务工人员

F 币
700 元
贡献
359 点

新人勋章爱心勋章水王勋章元老勋章热心勋章

沙发
发表于 2014-3-2 20:17:20 | 只看该作者
我这里找了三个快速排序算法。

楼主这个,我称为 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。用堆排序效率很高。

136

帖子

3

主题

0

精华

版主

F 币
1964 元
贡献
1677 点

帅哥勋章管理勋章爱心勋章新人勋章热心勋章元老勋章

板凳
 楼主| 发表于 2014-3-2 20:51:15 | 只看该作者
chuxf 发表于 2014-3-2 20:17
我这里找了三个快速排序算法。

楼主这个,我称为 QuickSortMod,Intel Fortran 扩展的 Qsort,以及 Juli R ...

若楼上仔细看下我的算法,其实我的算法就是冒泡排序算法,只是我的程序做了太多的IF用于判断后面跟随的扩展数组

736

帖子

4

主题

0

精华

大师

农村外出务工人员

F 币
700 元
贡献
359 点

新人勋章爱心勋章水王勋章元老勋章热心勋章

地板
发表于 2014-3-2 21:50:24 | 只看该作者
aliouying 发表于 2014-3-2 20:51
若楼上仔细看下我的算法,其实我的算法就是冒泡排序算法,只是我的程序做了太多的IF用于判断后面跟随的扩 ...

呵呵,确实没有仔细看。
只大致看了接口处。快速排序就是根据冒泡算法修改的,所以有相似之处。

136

帖子

3

主题

0

精华

版主

F 币
1964 元
贡献
1677 点

帅哥勋章管理勋章爱心勋章新人勋章热心勋章元老勋章

5#
 楼主| 发表于 2014-3-3 08:51:07 | 只看该作者
chuxf 发表于 2014-3-2 21:50
呵呵,确实没有仔细看。
只大致看了接口处。快速排序就是根据冒泡算法修改的,所以有相似之处。 ...

不是相似,是算法就是一样的,只是我的partition部分直接在程序里面

2033

帖子

12

主题

5

精华

论坛跑堂

臭石头雪球

F 币
1641 元
贡献
709 点

美女勋章热心勋章星光勋章新人勋章贡献勋章管理勋章帅哥勋章爱心勋章规矩勋章元老勋章水王勋章

6#
发表于 2014-3-3 09:35:23 | 只看该作者
我理解的冒泡法是不进行 partition 的,相邻两个点对比,调换,走完整个数组,然后循环大约N次。
而先调换一半,就是改进后的快速排序。

136

帖子

3

主题

0

精华

版主

F 币
1964 元
贡献
1677 点

帅哥勋章管理勋章爱心勋章新人勋章热心勋章元老勋章

7#
 楼主| 发表于 2014-3-3 23:26:36 | 只看该作者
fcode 发表于 2014-3-3 09:35
我理解的冒泡法是不进行 partition 的,相邻两个点对比,调换,走完整个数组,然后循环大约N次。
而先调换 ...

嗯,是的

在比较小的时候没必要partition,我设的是6,其实这个没有多大必要,所以直接用改进的快速排序算法即可,可以精简程序

136

帖子

3

主题

0

精华

版主

F 币
1964 元
贡献
1677 点

帅哥勋章管理勋章爱心勋章新人勋章热心勋章元老勋章

8#
 楼主| 发表于 2014-3-3 23:27:21 | 只看该作者
fcode 发表于 2014-3-3 09:35
我理解的冒泡法是不进行 partition 的,相邻两个点对比,调换,走完整个数组,然后循环大约N次。
而先调换 ...

石头,你的F币刷得这么高了!!!

2033

帖子

12

主题

5

精华

论坛跑堂

臭石头雪球

F 币
1641 元
贡献
709 点

美女勋章热心勋章星光勋章新人勋章贡献勋章管理勋章帅哥勋章爱心勋章规矩勋章元老勋章水王勋章

9#
发表于 2014-3-3 23:29:17 | 只看该作者
aliouying 发表于 2014-3-3 23:27
石头,你的F币刷得这么高了!!!

嘘,这个可以作弊的

136

帖子

3

主题

0

精华

版主

F 币
1964 元
贡献
1677 点

帅哥勋章管理勋章爱心勋章新人勋章热心勋章元老勋章

10#
 楼主| 发表于 2014-3-4 12:22:42 | 只看该作者
fcode 发表于 2014-3-3 23:29
嘘,这个可以作弊的

您需要登录后才可以回帖 登录 | 极速注册

本版积分规则

捐赠本站|Archiver|关于我们 About Us|小黑屋|Fcode ( 京ICP备18005632-2号 )

GMT+8, 2024-12-22 12:53

Powered by Tencent X3.4

© 2013-2024 Tencent

快速回复 返回顶部 返回列表