algorithm - 在 Fortran 95 中实现 qsort

Question

我正在尝试在 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:我已经使用基于子例程 的代码修改了源代码，这在我们想要修改参数时更有意义。

编辑 2:在 中将 a 的定义修改为 type(tape),intent(in out)::a(:) quicksort 和 partition 子例程使模块可以无错误地编译 – 请参阅评论。

Answer 1

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

免责声明:我的一些建议可能需要比 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在您定义类型的模块中可用。请注意，在编写泛型类型绑定(bind)过程时，必须将绑定(bind)参数声明为 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

然后，当您从另一个程序单元使用此模块时，只有公共(public)名称可用。您也可以仅将特定名称与 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 开始。

除此之外，正如我在评论中提到的，您不需要将数组参数声明为 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)参数，如参数 out在 partition , 返回枢轴位置。

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

像魅力一样工作!