Sorting algorithms/Quicksort: Difference between revisions
Content added Content deleted
| Line 1,099: | Line 1,099: | ||
implicit none |
implicit none |
||
type group |
|||
integer :: order ! original order of unsorted data |
|||
real :: value ! values to be sorted by |
|||
end type group |
|||
contains |
contains |
||
recursive subroutine |
recursive subroutine QSort(a,na) |
||
! DUMMY ARGUMENTS |
! DUMMY ARGUMENTS |
||
integer, intent(in) :: nA |
integer, intent(in) :: nA |
||
type (group), dimension(nA), intent(in out) :: A |
|||
! LOCAL VARIABLES |
! LOCAL VARIABLES |
||
integer :: left, right |
integer :: left, right |
||
real :: random |
|||
integer :: pivot, temp |
|||
real :: pivot |
|||
type (group) :: temp |
|||
integer :: marker |
integer :: marker |
||
if (nA > 1) then |
if (nA > 1) then |
||
call random_number(random) |
|||
pivot = A(1) ! simple 1st point pivot can cause very long execution times for some data sets (i.e. already sorted data) |
|||
pivot = A(int(random*real(nA-1))+1)%value ! random pivot (not best performance, but avoids worst-case) |
|||
left = 0 |
left = 0 |
||
right = nA + 1 |
right = nA + 1 |
||
| Line 1,121: | Line 1,129: | ||
do while (left < right) |
do while (left < right) |
||
right = right - 1 |
right = right - 1 |
||
do while (A(right) > pivot) |
do while (A(right)%value > pivot) |
||
right = right - 1 |
right = right - 1 |
||
end do |
end do |
||
left = left + 1 |
left = left + 1 |
||
do while (A(left) < pivot) |
do while (A(left)%value < pivot) |
||
left = left + 1 |
left = left + 1 |
||
end do |
end do |
||
| Line 1,141: | Line 1,149: | ||
end if |
end if |
||
call |
call QSort(A(:marker-1),marker-1) |
||
call |
call QSort(A(marker:),nA-marker+1) |
||
end if |
end if |
||
end subroutine |
end subroutine QSort |
||
! About 20% faster sorting random data and thousands of times faster when sorting sorted data over QSort_simple. |
|||
recursive subroutine QSort_optimized(a,na) |
|||
! DUMMY ARGUMENTS |
|||
integer, intent(in) :: nA |
|||
integer, dimension(nA), intent(in out) :: A |
|||
! LOCAL VARIABLES |
|||
integer :: left, right, mid |
|||
integer :: pivot, temp |
|||
integer :: marker |
|||
if (nA > 1) then |
|||
! insertion sort limit of 47 seems best for sorting 10 million integers on Intel i7-980X CPU. Derived data types that use |
|||
! more memory are optimized with smaller values - around 20 for a 16-byte type. |
|||
if (nA > 47) then |
|||
! Do quicksort for large groups |
|||
! Get median of 1st, mid, & last points for pivot (helps reduce long execution time on some data sets, such as already |
|||
! sorted data, over simple 1st point pivot) |
|||
mid = (nA+1)/2 |
|||
if (a(mid) >= a(1)) then |
|||
if (a(mid) <= a(nA)) then |
|||
pivot = a(mid) |
|||
else if (a(nA) > a(1)) then |
|||
pivot = a(nA) |
|||
else |
|||
pivot = a(1) |
|||
end if |
|||
else if (a(1) <= a(nA)) then |
|||
pivot = a(1) |
|||
else if (a(nA) > a(mid)) then |
|||
pivot = a(nA) |
|||
else |
|||
pivot = a(mid) |
|||
end if |
|||
left = 0 |
|||
right = nA + 1 |
|||
do while (left < right) |
|||
right = right - 1 |
|||
do while (A(right) > pivot) |
|||
right = right - 1 |
|||
end do |
|||
left = left + 1 |
|||
do while (A(left) < pivot) |
|||
left = left + 1 |
|||
end do |
|||
if (left < right) then |
|||
temp = A(left) |
|||
A(left) = A(right) |
|||
A(right) = temp |
|||
end if |
|||
end do |
|||
if (left == right) then |
|||
marker = left + 1 |
|||
else |
|||
marker = left |
|||
end if |
|||
call QSort_optimized(A(:marker-1),marker-1) |
|||
call QSort_optimized(A(marker:),nA-marker+1) |
|||
else |
|||
call InsertionSort(A,nA) ! Insertion sort for small groups is faster than Quicksort |
|||
end if |
|||
end if |
|||
end subroutine QSort_optimized |
|||
subroutine InsertionSort(A,nA) |
|||
! DUMMY ARGUMENTS |
|||
integer, intent(in) :: nA |
|||
integer, dimension(nA), intent(in out) :: A |
|||
! LOCAL VARIABLES |
|||
integer :: temp |
|||
integer :: i, j |
|||
do i = 2, nA |
|||
j = i - 1 |
|||
temp = A(i) |
|||
do |
|||
if (j == 0) exit |
|||
if (a(j) <= temp) exit |
|||
A(j+1) = A(j) |
|||
j = j - 1 |
|||
end do |
|||
a(j+1) = temp |
|||
end do |
|||
end subroutine InsertionSort |
|||
end module qsort_mod |
end module qsort_mod |
||
! Test Qsort Module |
! Test Qsort Module |
||
program |
program qsort_test |
||
use qsort_mod |
use qsort_mod |
||
implicit none |
implicit none |
||
integer, parameter :: l = |
integer, parameter :: l = 8 |
||
type (group), dimension(l) :: A |
|||
integer, dimension(3) :: seed = [1, 2, 3] |
integer, dimension(3) :: seed = [1, 2, 3] |
||
integer :: count1, count2, rate |
|||
integer :: i |
integer :: i |
||
real :: random |
real :: random |
||
write (*,*) "Unsorted Values:" |
|||
call random_seed(put = seed) |
call random_seed(put = seed) |
||
do i = 1, l |
do i = 1, l |
||
call random_number(random) |
call random_number(random) |
||
A(i) = |
A(i)%value = random |
||
A(i)%order = i |
|||
if (mod(i,4) == 0) write (*,"(4(I5,1X,F8.6))") A(i-3:i) |
|||
end do |
end do |
||
Acopy = A |
|||
call |
call QSort(A,l) |
||
write (*,*) "Sorted Values:" |
|||
call QSort_simple(A,l) |
|||
do i = 4, l, 4 |
|||
call system_clock(count2) |
|||
write (*,"( |
if (mod(i,4) == 0) write (*,"(4(I5,1X,F8.6))") A(i-3:i) |
||
end do |
|||
call system_clock(count1,rate) |
|||
call QSort_optimized(Acopy,l) |
|||
call system_clock(count2) |
|||
write (*,"(A,F8.5,A)") "Optimized Quicksort time = ", real(count2-count1)/real(rate), " seconds." |
|||
end program |
end program qsort_test</lang> |
||
Output: |
|||
Unsorted Values: |
|||
1 0.999981 2 0.203459 3 0.668007 4 0.461334 |
|||
5 0.732909 6 0.332698 7 0.415352 8 0.839989 |
|||
Sorted Values: |
|||
2 0.203459 6 0.332698 7 0.415352 4 0.461334 |
|||
3 0.668007 5 0.732909 8 0.839989 1 0.999981 |
|||
=={{header|FPr}}== |
=={{header|FPr}}== |
||