sort/quicksort.f90 at main · grofz/sort · GitHub

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
!  =================================================================
! | ©2020 Z. Grof (grofz@vscht.cz)                                  |
! | Licensed under MIT licence. Provided "as is", without warranty. |
!  =================================================================
!
!
! Example of an use of a recursion in sorting algorithm
! Advanced Programming Course
!
  module quicksort_module
    implicit none
    private
    public quicksort
    integer, parameter, public :: MODE_HOARE = 1, MODE_LOMUTO = 2
    integer, parameter :: DEFAULT_MODE = MODE_HOARE

  contains

    pure subroutine quicksort(A, mode)
      integer, intent(inout) :: A(:)
      integer, intent(in), optional :: mode ! (1=Hoare, 2=Lomuto)
!
! Quick-sort algorithm implementation.
! mode = 1 - Hoare partition scheme (default)
!        2 - Lomuto partition scheme
!
      integer :: mode_use

      mode_use = DEFAULT_MODE
      if (present(mode)) mode_use = mode

      select case (mode_use)
      case(MODE_HOARE)
        call quicksort_hoare(A, 1, size(A))
      case(MODE_LOMUTO)
        call quicksort_lomuto(A, 1, size(A))
      case default
        error stop 'Quicksort wrong mode'
      end select
    end subroutine quicksort


    pure recursive subroutine quicksort_hoare(A, lo, hi)
      integer, intent(inout) :: A(:)
      integer, intent(in)    :: lo, hi
      integer  :: piv

      ! -

      if (lo < hi) then
        call hoare_partition(A, lo, hi, piv)
        call quicksort_hoare(A, lo, piv)
        call quicksort_hoare(A, piv+1, hi)
      endif
    end subroutine quicksort_hoare


    pure subroutine hoare_partition(A, lo, hi, partition)
      integer, intent(inout) :: A(:)
      integer, intent(in)    :: lo, hi
      integer, intent(out)   :: partition

      integer :: itmp, Apiv, i, j

      ! -

      Apiv = A(lo+((hi-lo)/2)) ! this is safer than "(hi+lo)/2" which can overflow
                              ! for very large arrays
      i = lo - 1
      j = hi + 1

      do
        ! Move "i" and "j" indices and skip correctly placed positions
        do
          i = i + 1
          if (A(i) < Apiv) cycle
          exit
        enddo

        do
          j = j - 1
          if (A(j) > Apiv) cycle
          exit
        enddo

        if (i >= j) then ! If indices meet, exit the loop
          partition = j
          exit
        end if

        ! Now A(i) >= Apiv and A(j) <= Apiv
        ! Swap A(i) and A(j) to make them correctly placed
        itmp = A(i)
        A(i) = A(j)
        A(j) = itmp
      enddo
    end subroutine hoare_partition


    pure recursive subroutine quicksort_lomuto(A, lo, hi)
      integer, intent(inout) :: A(:)
      integer, intent(in)    :: lo, hi
      integer  :: piv

      if (lo < hi) then
        call lomuto_partition(A, lo, hi, piv)
        call quicksort_lomuto(A, lo, piv-1)
        call quicksort_lomuto(A, piv+1, hi)
      endif
    end subroutine quicksort_lomuto


    pure subroutine lomuto_partition(A, lo, hi, partition)
      integer, intent(inout) :: A(:)
      integer, intent(in)    :: lo, hi
      integer, intent(out)   :: partition

      integer :: i, j, Apiv, mi

      ! Median from A(low), A(middle) and A(high) selected as pivot and moved
      ! to the rightmost position
      mi = lo + ((hi-lo)/2)
      if (A(mi) < A(lo)) call swap(A(mi),A(lo))
      if (A(hi) < A(lo)) call swap(A(hi),A(lo))
      if (A(mi) < A(hi)) call swap(A(mi),A(hi))

      Apiv = A(hi) ! select last element as a pivot
      i = lo
      do j = lo, hi
        if (A(j) < Apiv) then
          if (i /= j) call swap(A(i),A(j))
          i = i + 1
        endif
      enddo
      if (i /= hi) call swap(A(i),A(hi))
      partition = i

    contains
      pure subroutine swap(c, d)
        integer, intent(inout) :: c, d
        integer :: t
        t = c
        c = d
        d = t
      end subroutine swap

    end subroutine lomuto_partition

  end module quicksort_module

!EOF: quicksort.f90