Sorting Algorithms/Circle Sort: Difference between revisions

Line 272:
=={{header|Fortran}}==
<lang fortran>
! circle sort compilation and run on linux
!
module circlesort
! -*- mode: compilation; default-directory: "/tmp/" -*-
! I have commented the code that was here and also 'tightened up' various pieces such as how swap detection was done as well
! Compilation started at Thu Mar 9 00:39:39
! as fixing an error where the code would exceed array bounds for odd number sized arrays.
! Also, giving some some attribution to the author. - Pete
! This code is a Fortran adaptation of a Forth algorithm laid out by "thebeez" at this URL;
! https://sourceforge.net/p/forth-4th/wiki/Circle%20sort/
!
! a=./circle_sort && make $a && $a
! gfortran -std=f2008 -Wall -g -fPIC -fopenmp -ffree-form -fall-intrinsics -fimplicit-none circle_sort.f08 -o circle_sort
! 1 2 3 4 5 6 7 8 9
! Compilation finished at Thu Mar 9 00:39:39
 
module circlesort
 
implicit none
logical, private :: csr
public :: circle_sort
 
contains
 
recursive subroutinelogical function csr(a, left, right, n,) swapsresult(swapped)
implicit none
integer, intent(in) :: n, left, right,n
integer, intent(inout) :: a(n), swaps
integer :: lo, hi, mid
integer :: temp
logical :: lefthalf,righthalf
swapped = .FALSE.
if (right <= left) return
lo = left !Store the upper and lower bounds of list for
hi = right !Recursion later
!
mid = (lo + hi) / 2
do while (lo < hi)
! Swap the pair of elements if hi < lo
if (a(hi) < a(lo)) then
swapsswapped = swaps + 1.TRUE.
temp = a(lo)
a(lo) = a(hi)
a(hi) = temp
end ifendif
lo = lo + 1
hi = hi - 1
end do
! Special case if ((loarray ==is hi)an .and.odd size (a(lo+1)not .lt. a(loeven))) then
if swaps(lo == swaps + 1hi)then
tempif(a(hi+1) =.lt. a(lo+1))then
a(lo+1) swapped = a(lo).TRUE.
a(lo) = temp = a(hi+1)
hi = lo - a(hi+1) = a(lo)
swaps a(lo) = 0temp
endif
endif
callmid csr(a,= (left, mid,+ n, swapsright) / 2 ! Bisection point
calllefthalf = csr(a, mid + 1left, rightmid, n, swaps)
righthalf = csr(a, mid + 1, right,n)
end subroutine csr
swapped = swapped .or. lefthalf .or. righthalf
 
end subroutinefunction csr
!
subroutine circle_sort(a, n)
use iso_c_binding, only: c_ptr, c_loc
implicit none
integer, intent(in) :: n
integer, target,intent(inout) :: a(n)
 
integer :: swaps
swapsdo =while ( csr(a, 1, n,n))
! This is the canonical algorithm. However, if you want to
do while (0 < swaps)
! speed it up, count the iterations and when you have approached
swaps = 0
! log(n) iterations, perform a binary insertion sort then exit the loop.
call csr(a, 1, size(a), size(a), swaps)
! For smaller sized arrays ~ 2million elements, 0.5*log(n) iterations works better, for larger
! arrays, take the former suggested number.
end do
end subroutine circle_sort
 
end module circlesort
 
program sort
use circlesort