!
!  Medians - common methods
!
!  Copyright © 2016-8 F.Hroch (hroch@physics.muni.cz)
!
!  This file is part of OakLeaf.
!
!  OakLeaf is free software: you can redistribute it and/or modify
!  it under the terms of the GNU Lesser General Public License as published by
!  the Free Software Foundation, either version 3 of the License, or
!  (at your option) any later version.
!
!  OakLeaf 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 Lesser General Public License for more details.
!
!  You should have received a copy of the GNU Lesser General Public License
!  along with OakLeaf.  If not, see <http://www.gnu.org/licenses/>.
!
!

! Medians:
! * qmed - quick-median (very fast ~2n)
! * median -  general median on base of quicksort (fast ~n*log(n))

module medians

  implicit none
  private

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

  interface median
     module procedure median_double, median_single
  end interface median

  interface qmedian
     module procedure qmedian_double, qmedian_single
  end interface qmedian

!  private :: qmed
  public :: median, qmedian

contains

  function qmedian_double(b,q)

    real(dbl) :: qmedian_double
    real(dbl),dimension(:),intent(in) :: b
    real(dbl), intent(in), optional :: q
    integer :: n, nmed

    n = size(b)

    if( n == 0 ) then
       qmedian_double = 0
       return
    else if( n == 1 ) then
       qmedian_double = b(1)
       return
    end if

    if( present(q) ) then
       nmed = nint(q*n)
    else ! q = 0.5 (median)
       nmed = n/2 + 1
    end if

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

    qmedian_double = qmed(b,nmed)

  end function qmedian_double


  function qmedian_single(b,q)

    real :: qmedian_single
    real,dimension(:),intent(in) :: b
    real, intent(in), optional :: q
    integer :: n, nmed

    n = size(b)

    if( n == 0 ) then
       qmedian_single = 0
       return
    else if( n == 1 ) then
       qmedian_single = b(1)
       return
    end if

    if( present(q) ) then
       nmed = nint(q*n)
    else ! q = 0.5 (median)
       nmed = n/2 + 1
    end if

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

    qmedian_single = real(qmed(real(b,dbl),nmed))

  end function qmedian_single


  ! 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 :: l,r,i,j

    allocate(a,source=b)

    l = 1
    r = size(a)
    x = a((l+r)/2+1)
    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


  ! General medians on base of quicksort

  function median_double(x) result(median)

    use quicksorter

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

    n = size(x)

    if( n == 0 ) then
       median = 0
       return
    else if( n == 1 ) then
       median = x(1)
       return
    end if

    allocate(y,source=x)
    call qsort(y)

    n2 = n / 2
!    write(*,*) n,n2,mod(n,2)
    if( mod(n,2) == 0 ) then
       ! even
       median = (y(n2+1) + y(n2)) / 2.0_dbl
    else
       ! odd
       median = y(n2+1)
    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
    median = real(median_double(y))

!!$    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+1))
!!$    end if
!!$
!!$    deallocate(y)

  end function median_single


end module medians
