!
!  Medians - common methods
!
!  Copyright © 2016-7 F.Hroch (hroch@physics.muni.cz)
!
!  This file is part of Munipack.
!
!  Munipack is free software: you can redistribute it and/or modify
!  it under the terms of the GNU General Public License as published by
!  the Free Software Foundation, either version 3 of the License, or
!  (at your option) any later version.
!
!  Munipack is distributed in the hope that it will be useful,
!  but WITHOUT ANY WARRANTY; without even the implied warranty of
!  MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
!  GNU General Public License for more details.
!
!  You should have received a copy of the GNU General Public License
!  along with Munipack.  If not, see <http://www.gnu.org/licenses/>.
!
!

! Medians:
! * qmed - quick-median
! * xmed - median of sorted array on base of select sort (slow ~n**2)
! * median -  general median on base of quicksort (fast ~n*log(n))

module medians

  implicit none

  ! numerical precision of real numbers
  integer, parameter, private :: dbl = selected_real_kind(15)

  interface median
     module procedure median_double, median_single
  end interface median

contains

  function qmedian(b)

    real(dbl) :: qmedian
    real(dbl),dimension(:),intent(in) :: b
    integer :: n, nmed

    n = size(b)
    nmed = min(n/2+1,n)

    ! this is right just only for odd-th elements of the sequence,
    ! we're ignore the right way, having huge dataset, n > 50

    qmedian = qmed(b,nmed)

  end function qmedian


  ! Quick median by Wirth: Algorith + data structures = programs
  ! fastest known median algorithm ~2*n

  function qmed(b,k) result(x)

    integer, intent(in) :: k
    real(dbl),dimension(:),intent(in) :: b
    real(dbl),dimension(:),allocatable :: a
    real(dbl) :: w,x
    integer :: n,l,r,i,j

    n = size(b)
    allocate(a(n))
    a = b

    l = 1
    r = n
    do while( l < r )
       x = a(k)
       i = l
       j = r
       do
          do while( a(i) < x )
             i = i + 1
          enddo
          do while( x < a(j) )
             j = j - 1
          enddo
          if( i <= j ) then
             w = a(i)
             a(i) = a(j)
             a(j) = w
             i = i + 1
             j = j - 1
          endif
          if( i > j ) exit
       enddo
       if( j < k ) l = i
       if( k < i ) r = j
    enddo
    deallocate(a)

  end function qmed


  ! computes median from pre-sorted array
  ! prefered for a few elements ~n*log(n)

  function xmed(b)

    use selectsort

    real(dbl),dimension(:),intent(in) :: b
    real(dbl) :: xmed
    real(dbl),dimension(:),allocatable :: a
    integer :: n

    n = size(b)

    if( n == 0 ) then
       xmed = 0.0_dbl
       return
    end if

    if( n == 1 ) then
       xmed = b(1)
       return
    end if

    allocate(a(n))
    a = b
    call ssort(a)

    xmed = (a((n+1)/2) + a(n/2)) / 2.0_dbl

    deallocate(a)

  end function xmed


  ! General medians on base of quicksort

  function median_double(x) result(median)

    use quicksort

    real(dbl), dimension(:), intent(in) :: x
    real(dbl) :: median
    integer :: n, n2
    real(dbl), dimension(:), allocatable :: y

    n = size(x)
    allocate(y(n))
    y = x
    call qsort(y)

    n2 = n / 2
    if( mod(n,2) == 0 ) then
       ! even
       median = (y(n2+1) + y(n2))/2.0_dbl
    else
       ! odd
       median = y(n2)
    end if

    deallocate(y)

  end function median_double


  function median_single(x) result(median)

    use quicksort

    real, dimension(:), intent(in) :: x
    real :: median
    integer :: n, n2
    real(dbl), dimension(:), allocatable :: y

    n = size(x)
    allocate(y(n))
    y = x
    call qsort(y)

    n2 = n / 2
    if( mod(n,2) == 0 ) then
       ! even
       median = real((y(n2+1) + y(n2))/2.0)
    else
       ! odd
       median = real(y(n2))
    end if

    deallocate(y)

  end function median_single


end module medians
