adapting a quicksort

I recently bumped into fortran.com as a resource and continue to be
impressed with its content. I found a quicksort for reals there and wanted
to adapt it:

http://www.fortran.com/qsort_c.f95

For starters, I want it to sort integers instead. Is that change as simple
as replacing 'real' with 'integer' in the following:

! Recursive Fortran 95 quicksort routine
! sorts real numbers into ascending numerical order
! Author: Juli Rew, SCD Consulting (juliana@ucar.edu), 9/03
! Based on algorithm from Cormen et al., Introduction to Algorithms,
! 1997 printing

! Made F conformant by Walt Brainerd

module qsort_c_module

implicit none
public :: QsortC
private :: Partition

contains

recursive subroutine QsortC(A)
real, intent(in out), dimension( :: A
integer :: iq

if(size(A) > 1) then
call Partition(A, iq)
call QsortC(A(:iq-1))
call QsortC(A(iq)
endif
end subroutine QsortC

subroutine Partition(A, marker)
real, intent(in out), dimension( :: A
integer, intent(out) :: marker
integer :: i, j
real :: temp
real :: x ! pivot point
x = A(1)
i= 0
j= size(A) + 1

do
j = j-1
do
if (A(j) <= x) exit
j = j-1
end do
i = i+1
do
if (A(i) >= x) exit
i = i+1
end do
if (i < j) then
! exchange A(i) and A(j)
temp = A(i)
A(i) = A(j)
A(j) = temp
elseif (i == j) then
marker = i+1
return
else
marker = i
return
endif
end do

end subroutine Partition

end module qsort_c_module

program sortdriver
use qsort_c_module
implicit none
integer, parameter :: r = 10
real, dimension(1:r) :: myarray = & ! (1:r)
(/0, 50, 20, 25, 90, 10, 5, 1, 99, 75/)
print *, "myarray is ", myarray
call QsortC(myarray)
print *, "sorted array is ", myarray
end program sortdriver

What is the role of pivot?
--
Wealth - any income that is at least one hundred dollars more a year than
the income of one's wife's sister's husband. 6
H. L. Mencken

On Sat, 23 Aug 2008 19:51:44 -0600, Ron Ford posted:

> I recently bumped into fortran.com as a resource and continue to be
> impressed with its content. I found a quicksort for reals there and wanted
> to adapt it:
>
> http://www.fortran.com/qsort_c.f95
>
> For starters, I want it to sort integers instead. Is that change as simple
> as replacing 'real' with 'integer' in the following:

Apparently, it is:

! tja

module sort3
implicit none
private
public :: selection_sort
! type definition includes only an integer
type, public :: address
integer :: zip_code
end type address
contains
recursive subroutine selection_sort (array_arg)
type (address), dimension(, intent (inout) &
:: array_arg
integer :: current_size
integer :: big
current_size = size (array_arg)
if (current_size > 0) then
big = maxloc(array_arg(%zip_code, dim=1)
call swap (big, current_size)
call selection_sort (array_arg(1: current_size -1))
end if
contains
subroutine swap(i,j)
integer, intent (in) :: i,j
type (address) :: temp
temp = array_arg(i)
array_arg(i) = array_arg(j)
array_arg(j) = temp
end subroutine swap
end subroutine selection_sort
end module sort3

! Recursive Fortran 95 quicksort routine
! sorts [integer] numbers into ascending numerical order
! Author: Juli Rew, SCD Consulting (juliana@ucar.edu), 9/03
! Based on algorithm from Cormen et al., Introduction to Algorithms,
! 1997 printing

! Made F conformant by Walt Brainerd

module qsort_c_module

implicit none
public :: QsortC
private :: Partition

contains

recursive subroutine QsortC(A)
integer, intent(in out), dimension( :: A
integer :: iq

if(size(A) > 1) then
call Partition(A, iq)
call QsortC(A(:iq-1))
call QsortC(A(iq)
endif
end subroutine QsortC

subroutine Partition(A, marker)
integer, intent(in out), dimension( :: A
integer, intent(out) :: marker
integer :: i, j
integer :: temp
integer :: x ! pivot point
x = A(1)
i= 0
j= size(A) + 1

do
j = j-1
do
if (A(j) <= x) exit
j = j-1
end do
i = i+1
do
if (A(i) >= x) exit
i = i+1
end do
if (i < j) then
! exchange A(i) and A(j)
temp = A(i)
A(i) = A(j)
A(j) = temp
elseif (i == j) then
marker = i+1
return
else
marker = i
return
endif
end do

end subroutine Partition

end module qsort_c_module


use qsort_c_module
use sort3
implicit none

integer, parameter:: sides = 8
integer, parameter:: trials = 50
integer, parameter :: array_size = trials

integer, parameter:: bins = 50
integer, parameter:: percentile = 95


integer, dimension(sides)::A
integer, dimension(trials)::C
integer, dimension(bins):
!! from qsort
integer, dimension(bins)::F

type (address), dimension (array_size) :: data_array

integer:: b, ii, i, counter, &
tab, maxput
real:: harvest, tot

! seed random num generator

CALL init_random_seed

! prime the pump
call random_number(harvest)
b = 3 + nint(10*harvest)
do i=1,b
call random_number(harvest)
print *, i, harvest
end do


! main control

! outer loop is the number of trials
C = 0
do ii=1,trials
tab = 0
A = 0
! inner loop rolls die till all values attained
do
call random_number(harvest)
b = ceiling(harvest*real(sides))
A(b) = A(b) + 1
! count until all outcomes non-zero
counter = 0
do i = 1, sides
if (real(A(i)) > .5) then
counter = counter + 1
end if
end do
tab = tab + 1
if (counter == sides) then
C(ii) = tab
exit
end if
end do !inner
end do !outer

! end main control
print *, "C is", C

! sort into bins
D=0
maxput = bins
do ii =1, trials
if (C(ii) > maxput) then
C(ii) = maxput
end if
D(C(ii))=D(C(ii)) + 1
end do
tot= sum(D)
print *, "total trials=",tot

! determine 95th percentile
tot = 0.01 *trials*real(percentile)
print *, "95th % is", tot

counter = 0
do ii = 1, bins
counter = counter + D(ii)

if (real(counter).ge. tot) then
exit
end if
end do
print *, "95th percentile was in bin number", ii

! equate C with data_array

do i=1,array_size
data_array(i)%zip_code=C(i)
end do

call selection_sort (data_array(1:array_size))
!! paste in qsort

F=C
call QsortC(F)

! output

print *, "quicksorted", F
print *, "selection sorted", data_array

b = nint(tot)
print *, "b=", b
print *, data_array(b)

! end output
contains
SUBROUTINE init_random_seed()
INTEGER :: i, n, clock
INTEGER, DIMENSION(, ALLOCATABLE :: seed

CALL RANDOM_SEED(size = n)
print *, "n=", n
ALLOCATE(seed(n))

CALL SYSTEM_CLOCK(COUNT=clock)
print *, "clock=", clock

seed = clock + 37 * (/ (i - 1, i = 1, n) /)
CALL RANDOM_SEED(PUT = seed)
print *, "seed= ", seed

DEALLOCATE(seed)
END SUBROUTINE
end program

n= 1
clock= 114586663
seed= 114586663
1 3.715616E-02
2 0.220503
3 0.998302
4 0.563285
5 0.490850
6 0.659474
7 0.634746
C is 18 13 27 20 47
17
24 17 14
12 10 15 10 13 24
21 23 26
45 30 29 14 20 15
19 26 15
30 16 32 12 22 13
13 12 22
13 14 15 21 34 16
17 23 35
17 15 19 13 23
total trials= 50.0000
95th % is 47.5000
95th percentile was in bin number 35
quicksorted 10 10 12 12 12
13 13 13
13 13 13 14 14 14
15 15 15
15 15 16 16 17 17
17 17 18
19 19 20 20 21 21
22 22 23
23 23 24 24 26 26
27 29 30
30 32 34 35 45 47
selection sorted 10 10 12 12
12
13 13 13
13 13 13 14 14 14
15 15 15
15 15 16 16 17 17
17 17 18
19 19 20 20 21 21
22 22 23
23 23 24 24 26 26
27 29 30
30 32 34 35 45 47
b= 48
35

Press RETURN to close window . . .


> What is the role of pivot?

Still haven't figured out what pivot does.

--
We are here and it is now. Further than that, all human knowledge is
moonshine. 3
H. L. Mencken

The pivot is the split point. Items larger go into one set of lists
and smaller go into the other. Kunth describes in his volume on
sorting and searching.

Note that the above code is correct unless arithmetic bounds get
exceeded. This depends on the compiler and hardware. It's possible
that A-B.LT.0 does not imply that A.LT.B, even for integers.

On Sat, 23 Aug 2008 20:47:51 -0700 (PDT), ttw6687@att.net posted:

> The pivot is the split point. Items larger go into one set of lists
> and smaller go into the other. Kunth describes in his volume on
> sorting and searching.

Thanks for the tip. I've got other reasons to bike to campus, so I'll run
down Knuth there too.
>
> Note that the above code is correct unless arithmetic bounds get
> exceeded. This depends on the compiler and hardware. It's possible
> that A-B.LT.0 does not imply that A.LT.B, even for integers.

It seems to work right out of the can for me. With a sort size of ten
thousand, the quicksort is three orders of magnitude faster.

Is qsort an intrinsic for C?
--
Wealth - any income that is at least one hundred dollars more a year than
the income of one's wife's sister's husband. 6
H. L. Mencken

Ron Ford wrote:
(snip)

> It seems to work right out of the can for me. With a sort size of ten
> thousand, the quicksort is three orders of magnitude faster.

> Is qsort an intrinsic for C?

Yes, but despite the name it isn't guaranteed to
implement quicksort.

The advantage is that it can sort an array of any kind
of data structure given a pointer to the array (usual
for C), the length, the length of each array element
(which must be in contiguous storage), and a comparison
function. The comparison function is given pointers to
two elements and returns a positive, zero, or negative
value if the first is greater then, equal to, or less
than the second. With the appropriate compare function
the array can be an array of pointers, or structures
containing pointers.

To do that in Fortran 2003 might also require a routine
to copy such array elements.

-- glen

On Mon, 25 Aug 2008 15:53:04 -0600, Ron Ford <ron@example.invalid>
wrote:
<snip>
> It seems to work right out of the can for me. With a sort size of ten
> thousand, the quicksort is three orders of magnitude faster.
>
> Is qsort an intrinsic for C?

Well, a sort routine named qsort() is part of the standard library in
C. (They don't use the term 'intrinsic' but it's the same idea.)

But it isn't required to be quicksort; the algorithm is up to the
choice of the implementor -- as long as it does indeed sort, given a
sane comparison routine. A good implementor will document what that
algorithm is, and a great one might even give you a choice.

- formerly david.thompson1 || achar(64) || worldnet.att.net

One does need to know the type of sort being used. Primarily whether
it's stable and the speed. For general use, I like a list merge sort;
it's of order N*Log(N)and stable. For things too big for memory, there
are polyphase merge.

For my own non-stable use, I just use heapsort as it only requires a
short program.