From: Arjen Markus on
Hello,

the other day I realised that Fortran 90/95 offers a lot of features
that are commonly
referred to as "functional programming". While it is by no means a
functional programming
language - like for instance Haskell or ML - you can program in a more
or less functional
prgramming style. The code below shows an example:

! An implementation of QuickSort in functional programming style
!
program sortdata
real, dimension(1000) :: data

call random_number( data )

write(*,*) 'First 20: '
write(*,'(5f10.4)') data(1:20)
write(*,*) 'Last 20: '
write(*,'(5f10.4)') data(1000-21:1000)

data = qsort_reals( data )
write(*,*) 'Sorted:'
write(*,*) 'First 20: '
write(*,'(5f10.4)') data(1:20)
write(*,*) 'Last 20: '
write(*,'(5f10.4)') data(1000-21:1000)

contains
recursive function qsort_reals( data ) result( sorted )
real, dimension(:), intent(in) :: data
real, dimension(1:size(data)) :: sorted

if ( size(data) > 1 ) then
sorted = (/ qsort_reals( pack( data(2:), data(2:) > data(1) )
), &
data(1),
&
qsort_reals( pack( data(2:), data(2:) <= data(1) )
) /)
else
sorted = data
endif
end function
end program

I have not measured the performance in comparison to a more traditional
implementation using explicit do-loop and reusing the array "data".
Like
I say in the title: this is just for fun.

Regards,

Arjen

From: Joost on
very elegant, could also become a text book example for the pack
intrinsic.

Joost

From: Salvatore on
Arjen Markus wrote:
> Hello,
>

Shouldn't it be

if ( size(data) > 1 ) then
sorted = (/ qsort_reals( pack( data(2:), data(2:) < data(1) )
), &
& data(1), &
& qsort_reals( pack( data(2:), data(2:) >= data(1)
) ) /)
else
sorted = data
endif


Otherwise brilliant.
Salvatore

From: Arjen Markus on
Thanks for the kind adjective. Your code will sort in ascending order -
just another
possibility. Mind you: the second check must be the exact negation of
the first -
not > and < ! Otherwise double entries will cause the temporary array
to become too
small.

I discovered the usefulness of pack() only a few months ago. When you
can apply
it, it is wonderful.

Regards,

Arjen

From: James Giles on
Arjen Markus wrote:
> recursive function qsort_reals( data ) result( sorted )
> real, dimension(:), intent(in) :: data
> real, dimension(1:size(data)) :: sorted
>
> if ( size(data) > 1 ) then
> sorted = (/ qsort_reals( pack( data(2:), data(2:) > data(1) )
> ), &
> data(1),
> &
> qsort_reals( pack( data(2:), data(2:) <= data(1) )
> ) /)
> else
> sorted = data
> endif
> end function

This is very much like the haskell version of quicksort.

qsort :: (Ord t) => [t] -> [t]
qsort [] = []
qsort[x:xs] = qsort [y | y <- xs, y<x] ++ [x] ++ qsort[y | y <- xs, y>=x]

The first line declares qsort: for any ordered type t, qsort takes
a list of t's and returns a list of t's (haskell is a very generic oriented
language). The second line says that the sort of the empty list is
the empty list. And the third line recursively applies the rule to sort
everything less than the first element, followed by the first element
followed by the sort of everything greater than the first element.
The form [y | y <- xs, y<x] is similar to the mathematical definitions
of sets and is read: "the list of y's such that y is drawn from xs and
y is less than x."

Usual caveat applies: unless your hardware really has a parallel
pack operation, this kind of definition will have trouble competing
with a simple scalar version of the algorithm - unless the compiler
is clever enough to discover the scalar version from the above!

--
J. Giles

"I conclude that there are two ways of constructing a software
design: One way is to make it so simple that there are obviously
no deficiencies and the other way is to make it so complicated
that there are no obvious deficiencies." -- C. A. R. Hoare