sort.f90 Source File


Source Code

! This file is part of toml-f.
! SPDX-Identifier: Apache-2.0 OR MIT
!
! Licensed under either of Apache License, Version 2.0 or MIT license
! at your option; you may not use this file except in compliance with
! the License.
!
! Unless required by applicable law or agreed to in writing, software
! distributed under the License is distributed on an "AS IS" BASIS,
! WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
! See the License for the specific language governing permissions and
! limitations under the License.

!> Sorting algorithms to work with hash maps
module tomlf_utils_sort
   use tomlf_type_value, only : toml_key
   implicit none
   private

   public :: sort, compare_less


   !> Create overloaded interface for export
   interface sort
      module procedure :: sort_keys
   end interface


   abstract interface
      !> Define order relation between two TOML keys
      pure function compare_less(lhs, rhs) result(less)
         import :: toml_key
         !> Left hand side TOML key in comparison
         type(toml_key), intent (in) :: lhs
         !> Right hand side TOML key in comparison
         type(toml_key), intent (in) :: rhs
         !> Comparison result
         logical :: less
      end function compare_less
   end interface


contains


   !> Entry point for sorting algorithm
   pure subroutine sort_keys(list, idx, compare)

      !> List of TOML keys to be sorted
      type(toml_key), intent(inout) :: list(:)

      !> Optionally, mapping from unsorted list to sorted list
      integer, intent(out), optional :: idx(:)

      !> Function implementing the order relation between two TOML keys
      procedure(compare_less), optional :: compare

      integer  :: low, high, i
      type(toml_key), allocatable  :: sorted(:)
      integer, allocatable :: indexarray(:)

      low = 1
      high = size(list)

      allocate(sorted, source=list)

      allocate(indexarray(high), source=[(i, i=low, high)])

      if (present(compare)) then
         call quicksort(sorted, indexarray, low, high, compare)
      else
         call quicksort(sorted, indexarray, low, high, compare_keys_less)
      end if

      do i = low, high
         list(i) = sorted(indexarray(i))
      end do

      if (present(idx)) then
         idx = indexarray
      end if

   end subroutine sort_keys


   !> Actual quick sort implementation
   pure recursive subroutine quicksort(list, idx, low, high, less)
      type(toml_key), intent(inout) :: list(:)
      integer, intent(inout) :: idx(:)
      integer, intent(in) :: low, high
      procedure(compare_less) :: less

      integer :: i, last
      integer :: pivot

      if (low < high) then

         call swap(idx(low), idx((low + high)/2))
         last = low
         do i = low + 1, high
            if (less(list(idx(i)), list(idx(low)))) then
               last = last + 1
               call swap(idx(last), idx(i))
            end if
         end do
         call swap(idx(low), idx(last))
         pivot = last

         call quicksort(list, idx, low, pivot - 1, less)
         call quicksort(list, idx, pivot + 1, high, less)
      end if

   end subroutine quicksort


   !> Swap two integer values
   pure subroutine swap(lhs, rhs)
      integer, intent(inout) :: lhs
      integer, intent(inout) :: rhs

      integer :: tmp

      tmp = lhs
      lhs = rhs
      rhs = tmp

   end subroutine swap


   !> Default comparison between two TOML keys
   pure function compare_keys_less(lhs, rhs) result(less)
      type(toml_key), intent (in) :: lhs
      type(toml_key), intent (in) :: rhs
      logical :: less

      less = lhs%key < rhs%key

   end function compare_keys_less


end module tomlf_utils_sort