!
!  Quantile mean
!
!  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/>.
!
!
!
! * qmean - estimate on base of quantiles (constructs CDF), usefull for initials
!           or as a general (slow) estimator of mean

module qmeans

  implicit none

  ! print debug informations ?
  logical, parameter, private :: debug = .false.

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

  ! 50% quantil of N(0,1)
  real(dbl), parameter, private :: q50 = 0.6745

  private :: pulky

contains

  subroutine qmean(x,t,s)

    ! this function computes mean by using of quantiles

    real(dbl), dimension(:), intent(in) :: x
    real(dbl), intent(out) :: t,s
    real(dbl), dimension(:), allocatable :: xcdf,ycdf
    real(dbl), dimension(3), parameter :: xq = (/0.25_dbl, 0.5_dbl, 0.75_dbl/)
    real(dbl), dimension(size(xq)) :: q
    integer :: i,n

    n = size(x)
    allocate(xcdf(n),ycdf(n))

    ! cummulative distribution function of data
    call cdf(x,xcdf,ycdf)

    ! quantiles
    do i = 1, size(q)
       call quantile(xq(i),xcdf,ycdf,q(i))
    end do

    ! mean is for q = 1/2, it is fully equivalent to median
    t = q(2)

    ! standard deviation is estimated from quantile deviation
    s = (q(3) - q(1))/(2*q50)

    if( debug ) write(*,*) 'q1/4,q1/2,q3/4:',q

!    open(1,file='quantile')
!    do i = 1,n
!       call quantile(ycdf(i),xcdf,ycdf,q(1))
       !       write(1,*) ycdf(i),q(1)
!       write(1,*) xcdf(i),ycdf(i)
!    end do
!    close(1)

    deallocate(xcdf,ycdf)

  end subroutine qmean



  subroutine cdf(x,u,v)

    ! cumulative distribution function constructed from data

    use quicksort

    real(dbl),dimension(:),intent(in) :: x
    real(dbl),dimension(:),intent(out) :: u,v
    integer :: i,n
    real(dbl) :: h

    n = size(x)
    h = 1.0_dbl / (n + 1.0_dbl)

    u = x
    call qsort(u)
    forall( i = 1:n ) v(i) = i*h

!    open(1,file='cdf')
!    do i = 1,n
!       write(1,*) u(i),v(i)
!    end do
!    close(1)

  end subroutine cdf


  function pulky(x,q) result(k)

    ! performs bi-section on pre-sorted array x, more than two values are required
    ! returns index k of the element of x for which x(k) <= q .and. q <= x(k+1)

    integer :: k
    real(dbl), intent(in) :: q
    real(dbl), dimension(:),intent(in) :: x
    integer :: n,i,ka,kb,maxit

    n = size(x)
    maxit = int(log(real(n)) / 0.69315 + 1)  ! ~ log2(n) + 1
    ka = 1
    kb = n - 1
    do i = 1, maxit
       k = (ka + kb) / 2
       if( x(k) <= q .and. q <= x(k+1) ) return
       if( x(ka) <= q .and. q < x(k) ) then
          kb = k
       else if( x(k) <= q .and. q < x(kb+1) ) then
          ka = k
       else if ( debug ) then
          write(*,*) 'Pulky warning:',ka,k,kb,q,x
       end if
    end do

    ! this point is reached only when no convergence is occured
    k = -1

  end function pulky


  subroutine quantile(q,x,y,t)

    ! estimates q-quantile, this is inverse of CDF from data

    real(dbl), intent(in) :: q
    real(dbl), dimension(:),intent(in) :: x,y
    real(dbl), intent(out) :: t
    integer :: i,n,low,high

    n = size(x)

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

    if( q <= y(1) ) then
       t = x(1)
    else if( q >= y(n) ) then
       t = x(n)
    else

       ! we are looking for proper interval of q in y
       low = pulky(y,q)
       high = low + 1

       ! check reliability of binary search, or try (slow) linear search
       if( low < 0 ) then
          if( debug ) write(*,*) 'Warning: Binary search failed. q:',q
          low = 1
          high = n
          do i = 1,n-1
             if( y(i) <= q .and. q <= y(i+1) ) then
                low = i
                high = i+1
                exit
             end if
          end do
       end if

       ! the result is linearly interpolated
       t = (x(high) - x(low))/(y(high) - y(low))*(q - y(low)) + x(low)
    end if
!    write(*,*) high,low,x(high),x(low),y(high),y(low)

  end subroutine quantile



end module qmeans
