!
!  Quantile mean
!
!  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/>.
!

module quantilmean

  ! Subroutine qmean() determines statistical parameters by quantiles.
  !
  ! qmean should be called as:
  !
  !  call qmean(data,mean,stderr,stdsig,flag)
  !
  ! on input:
  !   data - array of data values to be estimated
  !
  ! on output are estimated:
  !   mean - robust mean
  !   stderr (optional) - standard error
  !   stdsig (optional) - standard deviation
  !   reliable (optional) - realiable results?
  !   flag (optional) - indicates reliability of results:
  !          0 == success, results are both reliable
  !          2 == basic estimates, few datapoints available
  !          5 == failed to allocate memory, results are undefined
  !
  ! The results gives the robust estimate of the true value X
  ! of the sample x, with 68% probability, into the interval
  !
  !         mean - stderr  <  X  <  mean + stderr
  !
  ! Data distribution is approximated as Normal distribution
  !
  !          N(mean,stdsig).
  !
  ! Robust estimators has been prepared on base of
  !  * Hogg in Launer, Wilkinson: Robustness in Statistics
  !  * Hubber: Robust Statistics
  !  * my experiences

  use iso_fortran_env

  implicit none
  private

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

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

  public :: qmean, ecdf, quantile, qbracket, quantilefun

contains

  subroutine qmean(data,mean,stderr,stdsig,reliable,flag)

    ! this function computes mean, etc. by using of quantiles

    real(kind), dimension(:), intent(in) :: data
    real(kind), intent(out) :: mean
    real(kind), intent(out), optional :: stderr,stdsig
    logical, intent(out), optional :: reliable
    integer, intent(out), optional :: flag

    real(kind), dimension(3), parameter :: q = [0.25, 0.5, 0.75]
    real(kind), dimension(size(q)) :: x
    real(kind) :: sig
    integer :: n,iflag

    if( present(flag) ) flag = 6
    n = size(data)

    if( n == 0 ) then
       mean = 0
       if( present(stderr) )   stderr = 0
       if( present(stdsig) )  stdsig = 0
       if( present(reliable) ) reliable = .false.
       if( present(flag) ) flag = 2
       return

    else if( n == 1 ) then

       ! dispersion and std.err. are undefined
       mean = data(1)
       if( present(stderr) )   stderr = 0
       if( present(stdsig) )   stdsig = 0
       if( present(reliable) ) reliable = .false.
       if( present(flag) )     flag = 2
       return
    end if

    call quantilefun(data,q,x,iflag)

    if( iflag == 0 ) then

       ! mean is estimated as mean of median Q(1/2) and Q(1/4) and Q(3/4)
       mean = (x(2) + (x(1) + x(3))/2)/2

       ! standard deviation is being quantile deviation
       sig = (x(3) - x(1)) / (2*Q50)

       if( present(stdsig) ) stdsig = sig
       if( present(stderr) ) stderr = sig / sqrt(real(n))
    end if

    if( present(flag) ) flag = iflag
    if( present(reliable) ) reliable = iflag == 0 .or. iflag == 2

  end subroutine qmean


  subroutine ecdf(data,x,p)

    ! cumulative distribution function constructed from data

    use quicksorter

    real(kind),dimension(:),intent(in) :: data
    real(kind),dimension(:),intent(out) :: x,p
    integer :: i,n
    real(kind) :: h

    n = size(data)
    h = real(1,kind) / real(n + 1,kind)

    x = data
    call qsort(x)
    p = [ (i*h, i=1,n) ]

  end subroutine ecdf

  function quantile(q,x,y) result(t)

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

    real(kind), intent(in) :: q
    real(kind), dimension(:), intent(in) :: x,y
    real(kind) :: t,dy,h,r
    integer :: n,m,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're assuming, the input CDF has equidistant steps in y-axis
       h = real(1,kind) / real(n + 1,kind)
       r = q / h
       m = nint(r)
       if( abs(m - r) < 10*epsilon(r) ) then
          t = x(m)
       else
          low = int(r)
          high = low + 1

          dy = y(high) - y(low)
          if( abs(dy) > 10*epsilon(dy) ) then
             ! inverse by linear interpolation
             t = (x(high) - x(low))/dy*(q - y(low)) + x(low)
          else
             ! nearly singular
             t = (x(high) + x(low)) / 2
          end if
       end if
    end if
!    write(*,*) high,low,x(high),x(low),y(high),y(low)

  end function quantile

  subroutine quantilefun(data,q,x,flag)

    real(kind), dimension(:), intent(in) :: data, q
    real(kind), dimension(:), intent(out) :: x
    integer, intent(out) :: flag

    real(kind), dimension(:), allocatable :: xcdf,ycdf
    integer :: i,n,stat
    character(len=80) :: errmsg

    n = size(data)

    allocate(xcdf(n),ycdf(n),stat=stat,errmsg=errmsg)
    if( stat /= 0 ) then
       write(error_unit,*) 'quantilefun: ',trim(errmsg)
       flag = 5
       return
    end if

    ! empirical cummulative distribution function of data
    call ecdf(data,xcdf,ycdf)

    ! quantiles as inverse of ecdf
    do i = 1, size(q)
       x(i) = quantile(q(i),xcdf,ycdf)
    end do

    deallocate(xcdf,ycdf)
    flag = 0

  end subroutine quantilefun

  subroutine qbracket(data,xmin,xmax,flag)

    real(kind), dimension(:), intent(in) :: data
    real(kind), intent(out) :: xmin, xmax
    integer, intent(out), optional :: flag

    real(kind), dimension(2), parameter :: q = [0.25, 0.75]
    real(kind), dimension(size(q)) :: x
    integer :: iflag

    call quantilefun(data,q,x,iflag)
    xmin = x(1)
    xmax = x(2)
    if( present(flag) ) flag = iflag

  end subroutine qbracket

end module quantilmean
