Sorting algorithms/Quicksort: Difference between revisions

Content added Content deleted
(→‎{{header|zig}}: new version based on Rust, with generic comparator function, annotate versions)
Line 4,676: Line 4,676:
=={{header|Fortran}}==
=={{header|Fortran}}==
{{Works with|Fortran|90 and later}}
{{Works with|Fortran|90 and later}}
recursive subroutine fsort(a)

use inserts, only:insertion_sort !Not included in this posting
'''WARNING: The implementation of QuickSort in Fortran below is flawed:'''
implicit none
# If the largest element is in the last slot, the call to QSort(A(marker:),nA-marker+1) goes beyond the end of the array. This can cause exceptions and bad results.
!
# The use of a random number causes non reproducible performance.
! PARAMETER definitions

!
'''Instead of this algorithm rather use https://gist.github.com/t-nissie/479f0f16966925fa29ea'''
integer, parameter :: changesize = 64

!
<syntaxhighlight lang="fortran">MODULE qsort_mod
! Dummy arguments

!
IMPLICIT NONE
real, dimension(:) ,contiguous :: a

intent (inout) a
TYPE group
!
INTEGER :: order ! original order of unsorted data
! Local variables
REAL :: VALUE ! values to be sorted by
!
END TYPE group
integer :: first = 1

integer :: i
CONTAINS
integer :: j

integer :: last
RECURSIVE SUBROUTINE QSort(a,na)
logical :: stay

! DUMMY ARGUMENTS
real :: t
INTEGER, INTENT(in) :: nA
real :: x
!
TYPE (group), DIMENSION(nA), INTENT(in out) :: A
!*Code

!
! LOCAL VARIABLES
INTEGER :: left, right
last = size(a, 1)
if( (last - first)<changesize )then
REAL :: random
call insertion_sort(a(first:last))
REAL :: pivot
TYPE (group) :: temp
return
INTEGER :: marker
end if
j = shiftr((first + last), 1) + 1

!
IF (nA > 1) THEN
x = a(j)

CALL random_NUMBER(random)
i = first
j = last
pivot = A(INT(random*REAL(nA-1))+1)%VALUE ! Choice a random pivot (not best performance, but avoids worst-case)
left = 1
stay = .true.
right = nA
do while ( stay )
! Partition loop
do while ( a(i)<x )
DO
i = i + 1
IF (left >= right) EXIT
end do
DO
do while ( x<a(j) )
IF (A(right)%VALUE <= pivot) EXIT
j = j - 1
right = right - 1
end do
END DO
if( j<i )then
DO
stay = .false.
IF (A(left)%VALUE >= pivot) EXIT
else
left = left + 1
t = a(i) ! Swap the values
END DO
a(i) = a(j)
IF (left < right) THEN
a(j) = t
temp = A(left)
i = i + 1 ! Adjust the pointers (PIVOT POINTS)
A(left) = A(right)
j = j - 1
A(right) = temp
end if
END IF
end do
if( first<i - 1 )call fsort(a(first:i - 1)) ! We still have some left to do on the lower
END DO
if( j + 1<last )call fsort(a(j + 1:last)) ! We still have some left to do on the upper

return
IF (left == right) THEN
end subroutine fsort
marker = left + 1
ELSE
marker = left
END IF

CALL QSort(A(:marker-1),marker-1)
CALL QSort(A(marker:),nA-marker+1) WARNING CAN GO BEYOND END OF ARRAY DO NOT USE THIS IMPLEMENTATION

END IF

END SUBROUTINE QSort

END MODULE qsort_mod
! Test Qsort Module
PROGRAM qsort_test
USE qsort_mod
IMPLICIT NONE

INTEGER, PARAMETER :: nl = 10, nc = 5, l = nc*nl, ns=33
TYPE (group), DIMENSION(l) :: A
INTEGER, DIMENSION(ns) :: seed
INTEGER :: i
REAL :: random
CHARACTER(LEN=80) :: fmt1, fmt2
! Using the Fibonacci sequence to initialize seed:
seed(1) = 1 ; seed(2) = 1
DO i = 3,ns
seed(i) = seed(i-1)+seed(i-2)
END DO
! Formats of the outputs
WRITE(fmt1,'(A,I2,A)') '(', nc, '(I5,2X,F6.2))'
WRITE(fmt2,'(A,I2,A)') '(3x', nc, '("Ord. Num.",3x))'
PRINT *, "Unsorted Values:"
PRINT fmt2,
CALL random_SEED(put = seed)
DO i = 1, l
CALL random_NUMBER(random)
A(i)%VALUE = NINT(1000*random)/10.0
A(i)%order = i
IF (MOD(i,nc) == 0) WRITE (*,fmt1) A(i-nc+1:i)
END DO
PRINT *
CALL QSort(A,l)
PRINT *, "Sorted Values:"
PRINT fmt2,
DO i = nc, l, nc
IF (MOD(i,nc) == 0) WRITE (*,fmt1) A(i-nc+1:i)
END DO
STOP
END PROGRAM qsort_test</syntaxhighlight>
{{out}}
<pre>
Compiled with GNU Fortran 9.3.0
Unsorted Values:
Ord. Num. Ord. Num. Ord. Num. Ord. Num. Ord. Num.
1 47.10 2 11.70 3 35.80 4 35.20 5 55.30
6 74.60 7 28.40 8 30.10 9 70.60 10 66.90
11 15.90 12 71.70 13 49.80 14 2.60 15 12.80
16 93.00 17 45.20 18 21.50 19 20.70 20 39.50
21 9.20 22 21.60 23 18.60 24 22.80 25 98.50
26 97.50 27 43.90 28 8.30 29 84.10 30 88.80
31 10.30 32 30.50 33 79.30 34 24.40 35 45.00
36 48.30 37 69.80 38 86.00 39 68.40 40 22.90
41 7.50 42 18.50 43 80.40 44 29.60 45 43.60
46 11.20 47 36.20 48 23.20 49 45.30 50 12.30

Sorted Values:
Ord. Num. Ord. Num. Ord. Num. Ord. Num. Ord. Num.
14 2.60 41 7.50 28 8.30 21 9.20 31 10.30
46 11.20 2 11.70 50 12.30 15 12.80 11 15.90
42 18.50 23 18.60 19 20.70 18 21.50 22 21.60
24 22.80 40 22.90 48 23.20 34 24.40 7 28.40
44 29.60 8 30.10 32 30.50 4 35.20 3 35.80
47 36.20 20 39.50 45 43.60 27 43.90 35 45.00
17 45.20 49 45.30 1 47.10 36 48.30 13 49.80
5 55.30 10 66.90 39 68.40 37 69.80 9 70.60
12 71.70 6 74.60 33 79.30 43 80.40 29 84.10
38 86.00 30 88.80 16 93.00 26 97.50 25 98.50
</pre>
</pre>
A discussion about Quicksort pivot options, free source code for an optimized quicksort using insertion sort as a finisher, and an OpenMP multi-threaded quicksort is found at [http://balfortran.org balfortran.org]


=={{header|FreeBASIC}}==
=={{header|FreeBASIC}}==
Retrieved from "https://rosettacode.org/wiki/Sorting_algorithms/Quicksort"