在 Fortran 95 中实现 qsort答案

【问题标题】：Implementing qsort in Fortran 95在 Fortran 95 中实现 qsort
【发布时间】：2021-05-22 10:33:38
【问题描述】：

我正在尝试在 Fortran 中实现 qsort 算法。

实现的 qsort 旨在对包含另一个派生类型的派生类型的数组进行操作。

派生类型在单独的模块中定义为：

MODULE DATA_MODEL
        
        ! -------------------
        ! CONSTANTS
        ! -------------------
        integer,parameter               :: max_records = 100000000

        type :: timestamp
                integer                 :: year
                integer                 :: month
                integer                 :: day
                integer                 :: hour
                integer                 :: minute
                integer                 :: second
        end type
        type :: tape
                type(timestamp)         :: ts
                integer                 :: value1
                integer                 :: value2
        end type

END MODULE

这是我尝试实现的快速排序算法。

! DESCRIPTION:
!       THIS MODULE IMPLEMENTS QSORT ALGORITH USING LOMUTO PARTITION SCHEME
! PSEUDOCODE:
!       ALGORITHM QUICKSORT(A, LO, HI) IS
!           IF LO < HI THEN
!               P := PARTITION(A, LO, HI)
!               QUICKSORT(A, LO, P - 1)
!               QUICKSORT(A, P + 1, HI)
! 
!       ALGORITHM PARTITION(A, LO, HI) IS
!           PIVOT := A[HI]
!           I := LO
!           FOR J := LO TO HI DO
!               IF A[J] < PIVOT THEN
!                   SWAP A[I] WITH A[J]
!                   I := I + 1
!           SWAP A[I] WITH A[HI]
!           RETURN I
! 
! SORTING THE ENTIRE ARRAY IS ACCOMPLOMISHED BY QUICKSORT(A, 0, LENGTH(A) - 1).

module qsort

        use data_model

contains

        subroutine quicksort(a, lo, hi)

                implicit none

                ! SUBROUTINE PARAMETERS
                type(tape),allocatable,intent(in out)   :: a
                integer,intent(in)                      :: lo, hi

                ! ALGORITHM INTERNAL VARIABLES
                integer                                 :: p

                if (lo < hi) then
                        call partition(a, lo, hi, p)
                        call quicksort(a, lo, p - 1)
                        call quicksort(a, p + 1, hi)
                end if

        end subroutine

        subroutine  partition(a, lo, hi, p)
                
                implicit none

                ! SUBROUTINE PARAMETERS
                type(tape),allocatable,intent(inout)    :: a
                integer,intent(in)                      :: lo
                integer,intent(in)                      :: hi
                integer,intent(out)                     :: p

                ! ALGORITHM INTERNAL VARIABLES
                type(tape)                      :: pivot
                type(tape)                      :: swap
                integer                         :: i,j

                pivot = a(hi)
                i = lo
                do j = lo, hi
                        if (compare(a(j), pivot)) then
                               swap = a(i)
                               a(i) = a(j)
                               a(j) = swap
                               i = i + 1
                        endif
                end do
                swap = a(i)
                a(i) = a(hi)
                a(hi) = swap

                p = i

        end subroutine

        function compare(a,b)

                implicit none

                ! FUNCTION PARAMETERS
                type(tape)              :: a
                type(tape)              :: b
                logical                 :: compare

                if (a%ts%year < b%ts%year) then
                        compare = .true.
                else if (a%ts%year > a%ts%year) then
                        compare = .false.
                else if (a%ts%month < b%ts%month) then
                        compare = .true.
                else if (a%ts%month > b%ts%month) then
                        compare = .false.
                else if (a%ts%day < b%ts%day) then
                        compare = .true.
                else if (a%ts%day > b%ts%day) then
                        compare = .false.
                else if (a%ts%hour < b%ts%hour) then
                        compare = .true.
                else if (a%ts%hour > b%ts%hour) then
                        compare = .false.
                else if (a%ts%minute < b%ts%minute) then
                        compare = .true.
                else if (a%ts%minute > b%ts%minute) then
                        compare = .false.
                else if (a%ts%second < b%ts%second) then
                        compare = .true.
                else if (a%ts%second > b%ts%second) then
                        compare = .false.
                else
                        compare = .false.
                end if

        end function

end module

这是我在尝试编译时遇到的错误：

$ flang -c data_model.f95 
$ flang -c qsort.f95 
F90-S-0072-Assignment operation illegal to external procedure a (qsort.f95: 79)
F90-S-0076-Subscripts specified for non-array variable a (qsort.f95: 80)
F90-S-0076-Subscripts specified for non-array variable a (qsort.f95: 84)
F90-S-0076-Subscripts specified for non-array variable a (qsort.f95: 85)
F90-S-0076-Subscripts specified for non-array variable a (qsort.f95: 85)
F90-S-0076-Subscripts specified for non-array variable a (qsort.f95: 86)
  0 inform,   0 warnings,   6 severes, 0 fatal for partition
$

编辑 1：我已经使用基于 subroutine 的代码修改了源代码，这更有意义，因为我们想要修改参数。

编辑 2：在 quicksort 和 partition 子例程中将 a 的定义修改为 type(tape),intent(in out) :: a(:)，使模块编译时不会出错 - 请参阅 cmets。

【问题讨论】：

您的quicksort 过程应该是subroutine 而不是function，因为您对副作用感兴趣，而不是返回值。在这种情况下，你可以这样称呼它：call quicksort(a, lo, hi)
参数总是通过引用传递。在该语言的更新版本中（为什么你还是在 1995 年？？），有一个参数修饰符 value 那个......猜猜看，也是通过引用传递，但是引用 o 变量的副本，在按值传递的效果
“参数总是通过引用传递”。不正确，标准也没有做出这样的保证。但是，虚拟参数的任何变化都会反映在实际参数的相应变化上，而这通常不是通过引用传递来实现的。
请说明您如何调用quicksort，但很明显您需要将参数a 声明为数组。（并决定为什么它需要是可分配的。）
您可以将可分配数组传递给过程，而无需在过程中将参数声明为allocatable，它将作为普通数组处理。如果您计划在过程中分配/取消分配，则仅将参数声明为 allocatable 才有意义。

标签： algorithm fortran

【解决方案1】：

我看到您在 cmets 的帮助下解决了您的问题，但让我给您一些建议，以使您的实现更加模块化、易于使用和现代。

免责声明：我的一些建议可能需要比 95 更新的 Fortran 版本。

您可以通过为关系运算符提供重载来改进您的 timestamp 类型定义。

type :: timestamp
    integer :: year, month, day, hour = 0, minute = 0, second = 0
contains
    procedure, private :: eq, ne, gt, ge, lt, le
    generic :: operator(==) => eq
    generic :: operator(/=) => ne
    generic :: operator(>) => gt
    generic :: operator(>=) => ge
    generic :: operator(<) => lt
    generic :: operator(<=) => le
end type

（一个微妙的变化是我有hour、minute和second的默认值。所以你可以像这样实例化：timestamp(2021,5,22)）

要使其工作，您只需要在您定义类型的模块中提供函数eq、ne、gt、ge、lt、le 的实现。请注意，在编写泛型类型绑定过程时，您必须将绑定参数声明为 class(timestamp) 而不是 type(timestamp)。

elemental function lt(left, right) result(result)
    class(timestamp), intent(in) :: left, right
    logical :: result
    result = compare(left, right) < 0
end function

elemental function compare(this, other) result(result)
    class(timestamp), intent(in) :: this, other
    integer :: result
    if (this%year /= other%year) then
        result = sign(1, this%year - other%year)
    else if (this%month /= other%month) then
        result = sign(1, this%month - other%month)
    else if (this%day /= other%day) then
        result = sign(1, this%day - other%day)
    else if (this%hour /= other%hour) then
        result = sign(1, this%hour - other%hour)
    else if (this%minute /= other%minute) then
        result = sign(1, this%minute - other%minute)
    else if (this%second /= other%second) then
        result = sign(1, this%second - other%second)
    else 
        result = 0
    end if
end function

您可以实施的另一个好的做法是使用public 和private 控制对模块元素的访问。

module data_model
    implicit none
    public :: timestamp, tape
    private
    type :: timestamp
        ! (...)
    end type
    type :: tape
        type(timestamp) :: ts
        integer :: value1, value2
    end type
contains
    ! (...) implementations of eq, ne, gt, ge, lt, le
end

然后，当您从另一个程序单元使用此模块时，只有公共名称可用。您还可以在 use only 子句中仅使用特定名称：

module qsort
    use data_model, only: tape
    implicit none
    public :: quicksort
    private
contains
    ! (...) your quicksort implementation
end

最后，让我建议对您的 quicksort 实现进行一些调整。

首先，我建议您不需要与数组一起绕过边界lo 和hi。 Fortran 最显着的特点之一是对数组段进行操作非常容易。您可以在数组的连续部分上调用quicksort 过程，如果您使用假定形状的数组，该过程可以以与边界无关的方式对其进行处理，如下所示：type(tape) :: a(:)。在过程内部，无论调用站点的边界是什么，数组段都会重新从索引 1 开始。

除此之外，正如我在 cmets 中提到的，在这种情况下，您不需要将数组参数声明为 allocatable。即使您传递的原始数组最初是可分配的，您也可以将可分配数组传递给过程，而无需在过程中声明参数为可分配的，它将作为普通数组处理。仅当您计划在过程中分配/解除分配时，才将参数声明为可分配的。

pure recursive subroutine quicksort(a)
    type(tape), intent(inout) :: a(:)
    integer :: p
    if (size(a) == 0) return
    call partition(a, p)
    call quicksort(a(:p-1))
    call quicksort(a(p+1:))
end

在这种情况下，我将此过程声明为pure，但这取决于您的具体用例。使其纯粹有助于我提醒正确声明意图并拥有完善的程序（并且在某些情况下会提高性能），但这会带来许多限制（例如无法在程序内print）。您可以搜索纯程序了解更多信息。

quicksort 和 partition 都在这里实现为子例程。我总是喜欢这样做，因为该过程会执行重要的副作用，例如对传递的参数进行更新。如果我需要一个返回值，我可以有一个intent(out) 参数，就像partition 中的参数out，它返回枢轴位置。

pure subroutine partition(a, out)
    type(tape), intent(inout) :: a(:)
    integer, intent(out) :: out
    integer :: i, j
    i = 1
    do j = 1, size(a)
        if (a(j)%ts < a(size(a))%ts) then
            call swap(a(i), a(j))
            i = i + 1
        end if
    end do
    call swap(a(i), a(size(a)))
    out = i
end

elemental subroutine swap(a, b)
    type(tape), intent(inout) :: a, b
    type(tape) :: temp
    temp = a
    a = b
    b = temp
end

您可能会注意到a(j)%ts < a(size(a))%ts 我正在使用重载运算符< 来比较两个timestamp。这样比较逻辑和类型定义属于同一个模块。

最后，您可以使用这些模块并对您的快速排序实现进行一些测试！

program main
    use data_model, only: tape, timestamp
    use qsort, only: quicksort
    implicit none

    type(tape) :: a(8) = [ &
        tape(timestamp(2020, 01, 08), 0, 0), &
        tape(timestamp(2021, 01, 30), 0, 0), &
        tape(timestamp(2020, 01, 06), 0, 0), &
        tape(timestamp(2019, 12, 14), 0, 0), & 
        tape(timestamp(2020, 01, 08), 0, 0), &
        tape(timestamp(2020, 05, 05), 0, 0), &
        tape(timestamp(2021, 04, 30), 0, 0), &
        tape(timestamp(2020, 10, 22), 0, 0) &
    ]

    call quicksort(a(3:7)) ! will sort in place, only from index 3 to 7
    call quicksort(a) ! will sort whole array
end

像魅力一样工作！

【讨论】：

不错的答案！我可能会删除我的（它只是关于类型绑定运算符）。 lt 和 compare 的虚拟参数的命名和类型对我来说有点不清楚。为什么没有使用class(..) this 和type(..) other 选择lt(this, other)。使用 type(..) left, right 与 compare(left, right) 相同。
没有必要将lt, compare, swap 声明为elemental，是吗？还是只是某种最佳实践？
@jack，只是我的一个练习。如果某些东西可以是基本的，我就这样声明。但我同意，但与 OP 的问题无关。
关于虚拟类型：在函数compare 和lt 中，将绑定参数和其他参数都声明为class(tape) 可以比较从tape 派生的任何两种类型.是否需要/正确，取决于类型的业务逻辑。
但是，在quicksort 和partition 中将它们声明为class(tape) 是明显的错误（我刚刚修复了它，感谢您的提示），因为@ 987654376@ 没有以类通用的方式实现（有可能，在这里完全超出范围）。

【解决方案2】：

这不是与快速排序算法直接相关的答案，而是关于如何实现类型绑定运算符的答案。

您可以在data_model 模块中移动compare 函数。这进一步解耦了模块。快速排序模块只包含快速排序算法。

compare 函数可以由类型绑定运算符operator(<) 实现。下面显示了一个快速实现（仅适用于年/月/日），它应该可以帮助您相应地编辑自己的代码。

module timestamp_m
  implicit none

  private
  public timestamp

  type timestamp
    integer :: y, m, d
  contains
    generic            :: operator(<) => timestamp_lt
    procedure, private :: timestamp_lt
  end type

contains

  logical function timestamp_lt(this, rhs) result(tf)
    !! result of:     this < rhs
    class(timestamp), intent(in) :: this
    type(timestamp),  intent(in) :: rhs

    ! compare year
    if      (this%y < rhs%y) then
      tf = .true.
    else if (this%y > rhs%y) then
      tf = .false.
    else

      ! compare month
      if      (this%m < rhs%m) then
        tf = .true.
      else if (this%m > rhs%m) then
        tf = .false.
      else

        ! compare day
        if (this%d < rhs%d) then
          tf = .true.
        else
          tf = .false.
        end if
      end if
    end if
  end function

end module

您需要在快速排序模块中调整一行：

module qsort
..
  subroutine quicksort(a, lo, hi)
    ..
    ! if (compare(a(j), pivot)) then      ! OLD. replace by:
    if (a(j)%ts < pivot%ts) then
    ..

【讨论】：