function alpha = wpghi_findalpha(name,varargin)
%-*- texinfo -*-
%@deftypefn {Function} wpghi_findalpha
%@verbatim
%WPGHI_FINDALPHA  Approximates a matching Cauchy wavelet order alpha to given Wavelet
%   Usage: H=wpghi_findalpha(name)
%
%   Input parameters: 
%         name  : Name of the wavelet (optionally with parameters)
%         bwthr : Reference threshold for bandwidth comparison (default:
%         0.5012); should be ]0 1[
%   Output parameters:
%         alpha : Matching Cauchy wavelet order
%
%   For a wavelet type available in FREQWAVELET, WPGHI_FINDALPHA returns
%   the Cauchy wavelet order alpha with matching bandwidth. Here, 
%   bandwidth is the area in which the peak-normalized wavelet is larger 
%   than or equal to 1/2.
%   
%   For a list of supported wavelets, please see the help of FREQWAVELET.
%
%   This function is also compatible with filters generated by cqtfilters.
%   When such filters are used, the additional key-value pair
%
%     'bins',bins           Number of frequency bins per octave
%                           (Default: bins = 12) 
%
%   is required for correctly determining alpha. Additionally, the 
%   following optional parameters can be given for CQT-type filters: 
%
%     'Qvar',Qvar           Bandwidth variation factor. Multiplies the
%                           calculated bandwidth (divides Q). 
%                           Default value is 1.
%
%   For a list of supported CQT-type filters, please see the help of 
%   FIRWIN and FREQWIN. 
%@end verbatim
%@strong{Url}: @url{http://ltfat.github.io/doc/comp/wpghi_findalpha.html}
%@end deftypefn

% Copyright (C) 2005-2023 Peter L. Soendergaard <peter@sonderport.dk> and others.
% This file is part of LTFAT version 2.6.0
%
% This program 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.
%
% This program 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 this program.  If not, see <http://www.gnu.org/licenses/>.

% AUTHORS: Zdenek Prusa, Nicki Holighaus, Guenther Koliander, Clara
% Hollomey

complainif_notenoughargs(nargin,1,upper(mfilename));

if ~iscell(name), name = {name}; end

freqwavelettypes = getfield(arg_freqwavelet(),'flags','wavelettype');
firwintypes = getfield(arg_firwin(),'flags','wintype');
freqwintypes = getfield(arg_freqwin(),'flags','wintype');

if ~ischar(name{1}) || ~any(strcmpi(name{1},[freqwavelettypes,firwintypes,freqwintypes]))
    error('%s: First input argument must the name of a supported window.',...
        upper(mfilename));
end

basefc = 0.1;

if nargin == 1
    bwthr = 10^(-3/10);
elseif isscalar(varargin{1})
    bwthr = varargin{1};
    varargin = varargin(2:end);
else 
    bwthr = varargin{1};
    if bwthr <= 0
       error('%s: Reference bandwidth threshold bwthr must be a positive scalar.',...
                    upper(mfilename));
    end
end

% Preprocess wavelet parameters
winArgs = name(2:end);
winName = lower(name{1});

% Consider Cauchy and Morse as special cases of generalized Morse
switch winName
    case 'cauchy'
        definputcauchy.keyvals.alpha=100;
        definputcauchy.keyvals.beta=0;
        [~,~,alpha,beta]=ltfatarghelper({'alpha','beta'},definputcauchy,winArgs);
        winName = 'genmorse';
        winArgs = {'alpha',alpha,'beta',beta,'gamma',1};
    case 'morse'
        definputmorse.keyvals.alpha=100;
        definputmorse.keyvals.gamma=3;
        [~,~,alpha,gamma]=ltfatarghelper({'alpha','gamma'},definputmorse,winArgs);
        winName = 'genmorse';
        winArgs = {'alpha',alpha,'beta',0,'gamma',gamma};
end

% Determine bandwidth at basefc=0.1

if any(strcmpi(name{1},freqwavelettypes))
    switch winName
        case 'genmorse' % For generalized Morse 
            definputgenmorse.keyvals.alpha=100;
            definputgenmorse.keyvals.beta=0;
            definputgenmorse.keyvals.gamma=3;
            [~,~,alpha,beta,gamma]=ltfatarghelper({'alpha','beta','gamma'},definputgenmorse,winArgs);
            
            if alpha <= 1
                error('%s: Alpha must be larger than 1 (passed alpha=%.2f).',...
                    upper(mfilename),alpha);
            end
            
            if gamma <= 0
                error('%s: Gamma must be larger than 0 (passed gamma=%.2f).',...
                    upper(mfilename),gamma);
            end
            
            order = (alpha-1)/(2*gamma);
            peakpos = ( order/(2*pi*gamma) )^(1/(gamma));
            basedil = peakpos/basefc;
            
            freqatheightasc = @(thr) real( (-order/(2*pi*gamma)...
                *octave_lambertw( 0, ...
                -thr^(gamma/order)/exp(1)))^(1/(gamma)) )...
                /basedil;
            freqatheightdesc= @(thr) real( (-order/(2*pi*gamma)...
                *octave_lambertw(-1, ...
                -thr^(gamma/order)/exp(1)))^(1/gamma) )...
                /basedil;
            %here, the lambert function is symmetric...
            bwatthr = freqatheightdesc(bwthr)-(-freqatheightasc(bwthr));
            
        case 'morlet' % For Morlet
            definputmorlet.keyvals.sigma=4;
            [~,~,sigma]=ltfatarghelper({'sigma'},definputmorlet,winArgs);
            
            if sigma <= 1
                error('%s: Sigma must be larger than 1 (passed sigma=%.2f).',...
                    upper(mfilename),sigma);
            end
            
            % Fixed point iteration to find the maximum of the Morlet
            % wavelet
            peakpos = sigma;
            peakpos_tmp = 0;
            while abs(peakpos-peakpos_tmp) > 1e-6
                peakpos_tmp = peakpos;
                peakpos = sigma./(1-exp(-sigma*peakpos));
            end
            basedil = peakpos/basefc;
            
            morletfun = @(y) ( exp(-0.5*(sigma-y).^2) - exp(-0.5*( sigma.^2+y.^2 )) )...
                ./ ( exp(-0.5*(sigma-peakpos).^2) - exp(-0.5*( sigma.^2+peakpos.^2 )) );
            
            freqatheightasc = @(thr) determine_freqatheight(morletfun,peakpos,thr,1)./basedil;
            freqatheightdesc= @(thr) determine_freqatheight(morletfun,peakpos,thr,0)./basedil;
            
            bwatthr = -(freqatheightdesc(bwthr)-freqatheightasc(bwthr));
            
        case 'fbsp' % For frequency B-Spline
            
            definputfbsp.keyvals.order=4;
            definputfbsp.keyvals.fb=2;
            [~,~,order,fb]=ltfatarghelper({'order','fb'},definputfbsp,winArgs);
            
            if order < 1 || order > 5 || round(order) ~= order
                error('%s: order must be integer and between 2 and 5 (passed order=%.2f).',...
                    upper(mfilename),order);
            end
            
            if fb < 2
                error('%s: fb must be at least 2 (passed fb=%.2f).',...
                    upper(mfilename),fb);
            end
            
            peakpos = 1;
            basedil = peakpos/basefc;
            
            switch order
                case 1
                    prefun = @(x) ( x >= 0 ).*( x < 1 ) .* 1;
                case 2
                    prefun = @(x) ( x >= 0 ).*( x < 1 ) .* ...
                        (x) ...
                        + ( x >= 1 ).*( x < 2 ) .* ...
                        (2-x);
                case 3
                    prefun = @(x)  ( x >= 0 ).*( x < 1 ) .* ...
                        (.5*x.^2) ...
                        + ( x >= 1 ).*( x < 2 ) .* ...
                        (-x.^2 + 3.*x -1.5) ...
                        + ( x >= 2 ).*( x < 3 ) .* ...
                        (.5*x.^2 - 3.*x + 4.5);
                case 4
                    prefun = @(x)  ( x >= 0 ).*( x < 1 ) .* ...
                        (x.^3./6) ...
                        + ( x >= 1 ).*( x < 2 ) .* ...
                        (-x.^3./2 + 2.*x.^2 - 2.*x + 2/3) ...
                        + ( x >= 2 ).*( x < 3 ) .* ...
                        (x.^3./2 - 4.*x.^2 + 10.*x - 22/3) ...
                        + ( x >= 3 ).*( x < 4 ) .* ...
                        (-x.^3./6 + 2.*x.^2 - 8.*x + 32/3);
                case 5
                    prefun = @(x) ( x >= 0 ).*( x < 1 ) .* ...
                        (x.^4./24) ...
                        + ( x >= 1 ).*( x < 2 ) .* ...
                        (-x.^4./6 + 5.*x.^3./6 - 5.*x.^2./4 + 5.*x./6 - 5/24) ...
                        + ( x >= 2 ).*( x < 3 ) .* ...
                        (x.^4./4 - 5.*x.^3./2 + 35.*x.^2./4 - 25.*x./2 + 155/24) ...
                        + ( x >= 3 ).*( x < 4 ) .* ...
                        (-x.^4./6 + 5.*x.^3./2 - 55.*x.^2./4 + 65.*x./2 - 655/24) ...
                        + ( x >= 4 ).*( x < 5 ) .* ...
                        (x.^4./24 -5.*x.^3./6 + 25.*x.^2./4 - 125.*x./6 + 625/24);
            end
            fbspfun = @(y) prefun((y-1).*fb.*order./2+order/2)./prefun(order/2);
            
            freqatheightasc = @(thr) determine_freqatheight(fbspfun,peakpos,thr,1)./basedil;
            freqatheightdesc= @(thr) determine_freqatheight(fbspfun,peakpos,thr,0)./basedil;
            
            bwatthr = -(freqatheightdesc(bwthr)-freqatheightasc(bwthr));
        case 'analyticsp' % For positive frequency part of cosine-modulated B-Spline
            
            definputanalyticsp.keyvals.order=3;
            definputanalyticsp.keyvals.fb=2;
            [~,~,order,fb]=ltfatarghelper({'order','fb'},definputanalyticsp,winArgs);
            
            if order < 1 || round(order) ~= order
                error('%s: order must be integer and at least 1 (passed order=%.2f).',...
                    upper(mfilename),order);
            end
            
            if fb < 1 || round(fb) ~= fb
                error('%s: fb must be integer and at least 1 (passed fb=%.2f).',...
                    upper(mfilename),fb);
            end
            
            peakpos = 1;
            basedil = peakpos/basefc;
            
            heightfun = @(y) min(1,(y>0).* ( 1./abs(fb.*(pi.*y - pi)).^order + 1./abs(fb.*( pi.*y + pi )).^order ));
            freqatheightasc = @(thr) determine_freqatheight(heightfun,peakpos,thr,1)./basedil;
            freqatheightdesc= @(thr) determine_freqatheight(heightfun,peakpos,thr,0)./basedil;
            
            bwatthr = -(freqatheightdesc(bwthr)-freqatheightasc(bwthr));
            
        case 'cplxsp' % For complex-modulated B-spline
            
            definputcplxsp.keyvals.order=3;
            definputcplxsp.keyvals.fb=2;
            [~,~,order,fb]=ltfatarghelper({'order','fb'},definputcplxsp,winArgs);
            
            if order < 1 || round(order) ~= order
                error('%s: order must be integer and at least 1 (passed order=%.2f).',...
                    upper(mfilename),order);
            end
            
            if fb < 1 || round(fb) ~= fb
                error('%s: fb must be integer and at least 1 (passed fb=%.2f).',...
                    upper(mfilename),fb);
            end
            
            peakpos = 1;
            basedil = peakpos/basefc;
            
            heightfun = @(y) min(1,1./abs(fb.*(pi*y - pi)).^order);
            freqatheightasc = @(thr) determine_freqatheight(heightfun,peakpos,thr,1)./basedil;
            freqatheightdesc= @(thr) determine_freqatheight(heightfun,peakpos,thr,0)./basedil;
            
            bwatthr = -(freqatheightdesc(bwthr)-freqatheightasc(bwthr));
            
        otherwise
            error('%s: SENTINEL. Unknown window.',upper(mfilename));
    end
else
    definput.flags.wintype = [ firwintypes, freqwintypes ];
    definput.keyvals.L=50000;
    definput.keyvals.bins=12;
    definput.keyvals.Qvar = 1;    
    definput.keyvals.min_win = 4;
    definput.keyvals.trunc_at= min(10^(-5),bwthr/2);
    definput.flags.subprec  = {'subprec','nosubprec'};
    definput.flags.warp     = {'symmetric','warped'};

    [varargin,winCell] = arghelper_filterswinparser(definput.flags.wintype,[{name},varargin]);
    [flags,kv]=ltfatarghelper({},definput,varargin);
    if isempty(winCell), winCell = {flags.wintype}; end
    
    freqscale = [];
    if flags.do_warped
        freqtoscale = @(x) log2(x./2^(-2/kv.bins));
        scaletofreq = @(x) 2^(-2/kv.bins).*2.^x;
        freqscale = {freqtoscale,scaletofreq};
    end
    [filterfunc,winbw] = helper_filtergeneratorfunc(...
        flags.wintype,winCell,2,1,kv.min_win,kv.trunc_at,...
        freqscale,flags.do_subprec,flags.do_symmetric,flags.do_warped);
                          
    if any(strcmp(flags.wintype,freqwintypes))
       % Adjusting Qvar such that the filters have the same erb as the
       % Hann window
       winbw_hann = 0.3750;
       winbw = winbw/winbw_hann;
       kv.Qvar = kv.Qvar/(winbw);
    end
    
    fc = basefc.*2.^((-1:1).'/kv.bins);
    fsupp = kv.Qvar*(fc(3)-fc(1));
    
    cqtfilt = filterfunc(fsupp,basefc,1);    
    probelen = kv.L;
    
    H = abs(comp_transferfunction(cqtfilt,probelen));
    freqatheightdesc = 2*find((H>= bwthr),1,'first')./probelen;
    freqatheightasc = 2*find((H>= bwthr),1,'last')./probelen;
            
    bwatthr = -(freqatheightdesc-freqatheightasc);
end

if numel(name) > 1
    name = name{1};
end

if ( strcmp('cauchy', name) && bwthr == 1 ) %do not run lambert, because bw always 0 and loop won't terminate
    alpha = 1;
else
    alpha = determine_alpha_from_bandwidth(bwatthr,bwthr,basefc,15);
end

end

function alpha = determine_alpha_from_bandwidth(bwatthr,bwthr,basefc,steps)
% This function computes alpha from a bandwidth `bwatthr` at a reference height `bwthr`, together with
% a given base center frequency `basefc`.
   
cauchybwatthr = @(alph) basefc * ...
                          ( octave_lambertw(0, -bwthr^(2/(alph-1))/exp(1))...
                           -octave_lambertw(-1,-bwthr^(2/(alph-1))/exp(1)) );


alpha_current = 10;
cauchybw_current = real(cauchybwatthr(alpha_current));

% Find initial guess
if cauchybw_current > bwatthr
    while cauchybw_current > bwatthr
        alpha_left = alpha_current;
        alpha_current = 10*alpha_current;
        cauchybw_current = real(cauchybwatthr(alpha_current));
    end
elseif cauchybw_current < bwatthr
    while cauchybw_current < bwatthr
        alpha_current = 0.1*alpha_current;
        alpha_left = alpha_current;
        cauchybw_current = real(cauchybwatthr(alpha_current));
    end
else 
    alpha = alpha_current;
    return
end

for kk = 1:steps
   exponent = 2^(-kk); 
   alpha_current = alpha_left*10^exponent;
   cauchybw_current = real(cauchybwatthr(alpha_current));
   if cauchybw_current > bwatthr
       alpha_left = alpha_current;
   end
end

alpha = alpha_current;

end

function w = octave_lambertw(b,z)
% Copyright (C) 1998 by Nicol N. Schraudolph <schraudo@inf.ethz.ch>
%
% @deftypefn {Function File} {@var{x} = } lambertw (@var{z})
% @deftypefnx {Function File} {@var{x} = } lambertw (@var{n}, @var{z})
% Compute the Lambert W function of @var{z}.
%
% This function satisfies W(z).*exp(W(z)) = z, and can thus be used to express
% solutions of transcendental equations involving exponentials or logarithms.
%
% @var{n} must be integer, and specifies the branch of W to be computed;
% W(z) is a shorthand for W(0,z), the principal branch.  Branches
% 0 and -1 are the only ones that can take on non-complex values.
%
% If either @var{n} or @var{z} are non-scalar, the function is mapped to each
% element; both may be non-scalar provided their dimensions agree.
%
% This implementation should return values within 2.5*eps of its
% counterpart in Maple V, release 3 or later.  Please report any
% discrepancies to the author, Nici Schraudolph <schraudo@@inf.ethz.ch>.

if (nargin == 1)
    z = b;
    b = 0;
else
    %% some error checking
    if (nargin ~= 2)
        print_usage;
    else
        if (any(round(real(b)) ~= b))
            usage('branch number for lambertw must be integer')
        end
    end
end

%% series expansion about -1/e
%
% p = (1 - 2*abs(b)).*sqrt(2*e*z + 2);
% w = (11/72)*p;
% w = (w - 1/3).*p;
% w = (w + 1).*p - 1
%
% first-order version suffices:
%
w = (1 - 2*abs(b)).*sqrt(2*exp(1)*z + 2) - 1;

%% asymptotic expansion at 0 and Inf
%
v = log(z + double(~(z | b))) + 2*pi*1i*b;
v = v - log(v + double(v==0));

%% choose strategy for initial guess
%
c = abs(z + 1/exp(1));
c = (c > 1.45 - 1.1*abs(b));
c = c | (b.*imag(z) > 0) | (~imag(z) & (b == 1));
w = (1 - c).*w + c.*v;

%% Halley iteration
%
for n = 1:10
    p = exp(w);
    t = w.*p - z;
    f = (w ~= -1);
    t = f.*t./(p.*(w + f) - 0.5*(w + 2.0).*t./(w + f));
    w = w - t;
    if (abs(real(t)) < (2.48*eps)*(1.0 + abs(real(w))) ...
        && abs(imag(t)) < (2.48*eps)*(1.0 + abs(imag(w))))
        return
    end
end

end

