!
!  Scale by entropy
!
!  Copyright © 2017 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/>.
!
!

module entropyscale

  ! This module provides escale subroutine for estimation of scale.
  !
  ! escale should be called as:
  !
  !  call escale(r,s,reliable)
  !
  ! on input:
  !   r - array of residuals
  !   s - initial estimate of scale
  !
  ! on output are estimated:
  !   s - estimation of scale
  !   reliable (optional) - indicates reliability of result

  implicit none

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

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

  ! relative precision of result
  real(dbl), parameter :: etol = 1e-3

  ! data buffers
  real(dbl), dimension(:), allocatable, private :: res, rho

  private :: negentropy, graph

contains

  subroutine escale(r,s,reliable)

    ! An estimator of scale parameter as maximum of entropy
    ! (implemented as minimum of negative entropy).
    ! The routine fmin is very reliable for this purpose.
    ! The extrem can be localised with relative small precision
    ! (3-digits guarantees everything). The scale parameter corrects
    ! oddly estimated statistical errors of passed data (dx).
    ! Normally, the value is expected near number one: escale ~= 1.

    use fmm
    use medians

    real(dbl), dimension(:), intent(in) :: r
    real(dbl), intent(in out) :: s
    logical, intent(out), optional :: reliable

    ! golden ratio
    real(dbl), parameter :: gold = 1.618 !=(1 + sqrt(5))/2

    real(dbl) :: stol, smin, smax, e, valmin, valmax
    integer :: n, iter
    logical :: abovemin, undermax

    if( s <= 0 ) then
       reliable = .false.
       return
    end if

    n = size(r)
    allocate(res(n),rho(n))

    res = r
    valmin = max(minval(abs(res)),epsilon(res))
    valmax = maxval(abs(res))

    if( n > 13 ) then

       ! we belives that the initial estimate of s is very good,
       ! and it falls inside the interval gived by golden ratio.
       smin = max(s / gold, valmin)
       smax = min(s * gold, valmax)
       stol = max(etol*s,100*epsilon(s))
       ! The maximum will be located with the precision
       ! giving approx ln((smax - smin)/stol) calls to negentropy.

       abovemin = abs(valmin - smin) > epsilon(smin)
       undermax = abs(valmax - smax) > epsilon(smax)

    else
       ! A case of a few elements only .. there is many local extremes...
       ! we are selecting one from those, randomly...
       smin = valmin
       smax = valmax
       stol = max(etol*valmin,100*epsilon(s))
       abovemin = .false.
       undermax = .false.

    end if

    do iter = 1, 3

       if( smax > smin ) then
          s = fmin(smin,smax,negentropy,stol)
       else ! if( smin == smax) then
          s = smin

          ! yes, it is possible for two sets of identical values
       end if

!       write(*,*) smin, smax, abovemin, undermax, iter

       ! update initial range if needed, or accept result
       e = 2*stol
       if( abs(s - smin) < e .and. abovemin ) then
          smin = max(smin / gold, valmin)
          abovemin = abs(valmin - smin) > epsilon(smin)
!          write(*,*) 'smin=',smin,smax,iter,abovemin, undermax
       else if( abs(smax - s) < e .and. undermax ) then
          smax = min(smax * gold, valmax)
          undermax = abs(valmax - smax) > epsilon(smax)
!          write(*,*) 'smax=',smax,smin,iter,abovemin, undermax
       else
          exit
       end if

    end do

    if( present(reliable) ) then
       e = 2*stol
       reliable = abs(s - smin) > e .and. abs(smax - s) > e
    end if

    if( debug ) call graph(s/10,5*s)

    deallocate(res,rho)

  end subroutine escale

  function negentropy(s)

    use rfun

    real(dbl) :: negentropy
    real(dbl), intent(in) :: s
    real(dbl), parameter :: rhomax = log(huge(1.0_dbl)/2.1)

    call itukeys(res/s,rho)
!    call iandrews(res/s,rho)
!    rho = (res/s)**2/2

    negentropy = - sum(rho*exp(-2.12*rho), rho < rhomax) / count(rho < rhomax)
!    negentropy = - sum(rho*exp(-2*rho)) / size(rho)

    ! The sum includes only values inside range acceptable for exp() function.
    ! Otherwise, FPE flag due to an underflow will be raised, although
    ! validity of results is untouched.

  end function negentropy


  subroutine graph(smin,smax)

    use rfun

    real(dbl), intent(in) :: smin, smax

    integer, parameter :: n = 66
    integer :: i
    real(dbl) :: s,ds

    ds = (smax - smin) / n

    open(1,file='/tmp/e')
    do i = 0,n
       s = smin + i * ds
       call ihubers(res/s,rho)
       write(1,*) s,negentropy(s) !,sum(rho**2)/size(rho)-0.8
    end do
    close(1)

  end subroutine graph


end module entropyscale
